DVBAADRP ;ALB/GTS-557/THM-AMIE COMPLETE ADMISSION RPT ; 1/22/91  1:19 PM
 ;;2.7;AMIE;**17,42,53,108,149,185**;Apr 10, 1995;Build 18
 ;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 
DVBGUI
 
DVBGUI=0
 
^TMP($JTERM
 
Q
 
;
ENBROKER(Y) ;
 ; Returns some info for the CAPRI GUI to display prior
 ; to the user running this report
 
DVBGUI
 
DVBGUI=1
 
^TMP($J)
 
HOME^%ZIS NOASK,QUIT1
 
NOPARM^DVBAUTL2 G:$D(DVBAQUITKILL^DVBAUTIL
 
;
 
Y(1)="VARO COMPLETE ADMISSION REPORT" DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
 
HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
 
Y(2)=HEAD1,Y(3)=""
 
Y(4)="Please enter dates for search, oldest date first, most recent date last."
 
Y=$P(DTAR,U,3) ^DD("DD")
 
Y(5)=""
 
Y(6)="Last report was run on "_Y
 
Q
 
;
 ;Input: DVBADLMTR - Indicates if report should be delimited (Optional)
ENBROKE2(MSG,BDATE,EDATE,RO,RONUM,DVBADLMTR) ;
 ; This is the entry point to run the actual report from
 ; the CAPRI GUI.
 
DVBHFS,DVBERR,DVBGUI,I,DVBADHDR
 
^TMP("DVBA",$J)
 
DVBADLMTR=$S('+$G(DVBADLMTR):"",1:","),DVBADHDR=0
 
DVBGUI=1,DVBERR=0,DVBHFS=$$HFS^DVBAB82()
 
X=BDATE,Y=EDATE
 
; DVBA*2.7*108 - Correct next line.  CAPRI GUI already adds 1 to EDATE
 ; S BDATE=BDATE-.5,EDATE=EDATE+.5
 
BDATE=BDATE-.5,EDATE=EDATE-.5
 
^TMP($J)
 
HOME^%ZIS NOASK,QUIT1
 
NOPARM^DVBAUTL2 G:$D(DVBAQUITKILL^DVBAUTIL
 
;
 
HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
 
I $D(XD
 
G:X=""!(Y<0) KILL %ZIS="AEQ" ^%ZIS %ZIS
 
HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W"DVBERR END^DVBAB82 Q
 I 
POP DVBAON2,DCHPTR,M,Y,KILL^DVBAUTIL
 
IO
 
DEQUE
 
END^DVBAB82
 
Q
SET Q:'$D(^DPT(DA,0))  DFN=DA RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
 
^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
 
Q
 
;
PRINTB MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),DFN=DA,QUIT1=1 ADM^DVBAVDPT
 
S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
 
S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
 
D:($G(DVBADLMTR)'=""PRINTD
 
D:($G(DVBADLMTR)=""PRINTND
 
Q
 
;
PRINTND ;print non-delimited admission inq report
 
W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
 
DVBGUI=0 !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
 
DVBGUI=1 !!
 
?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!,?8,"Admission Date:",?26,ADMDT,!,?3,"Admitting Diagnosis:",?26,DIAG,!
 
?8,"Discharge Date:",?26,DCHGDT,!,?11,"Bed Service:",?26,BEDSEC,!,?13,"Recv A&A?:",?26,$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),!
 
?14,"Pension?:",?26,$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),! ELIG^DVBAVDPT IOST'?1"C-".DVBAON2=""
 
IOST?1"C-".DO
 
.($O(^TMP($J,XCN))'=""!($O(^TMP($J,XCN,CFLOC))'=""!($O(^TMP($J,XCN,CFLOC,ADM))'=""!($O(^TMP($J,XCN,CFLOC,ADM,DA))'="")))) DO
 
..DVBGUI=0 D
 
...*7,!,"Press RETURN to continue or ""^"" to stop    "
 
...ANS:DTIME
 
...S:ANS=U!('$TQUIT=1
 ...
'$T S DVBAQUIT=1
 .
($O(^TMP($J,XCN))=""&($O(^TMP($J,XCN,CFLOC))=""&($O(^TMP($J,XCN,CFLOC,ADM))=""&($O(^TMP($J,XCN,CFLOC,ADM,DA))="")))) DO
 
..DVBGUI=0 D
 
...*7,!,"Press RETURN to continue  "
 
...ANS:DTIME
 
Q
 
;
PRINTD ;print delimited admission inq report
 ;eligibility logic copied from ELIG^DVBAVDPT
 
ELIG,INCMP
 
ELIG=DVBAELIG,INCMP=""
 
ELIG]"" ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
 
I $D(^DPT(DA,.29)) INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
 
INCMP]"",ELIG]"" ELIG=ELIG_", "_INCMP
 
DEM^VADPT I $G(SSN)'="" SSN=$P($G(VADM(2)),U,2)
 
D:('DVBADHDRCOLHDR
 
!,""""_PNAM_""""_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_""""_DIAG_""""_DVBADLMTR
 
DCHGDT_DVBADLMTR_""""_BEDSEC_""""_DVBADLMTR_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR
 
W $S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR_""""_ELIG_""""
 
Q
 
;
PRINT IO QUIT="" MA,MB
 
XCN="" M=0:0 XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  CFLOC="" J=0:0 CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  PRINT1
 
Q
PRINT1 ADM="" K=0:0 ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  DA="" L=0:0 DA=$O(^TMP($J,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  DATA=^(DAPRINTB
 
Q
 
;
TERM HOME^%ZIS NOASK,QUIT1
 
NOPARM^DVBAUTL2 G:$D(DVBAQUITKILL^DVBAUTIL
 
;
SETUP @IOF,!,"VARO COMPLETE ADMISSION REPORT" DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
 
HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
 
!,HEAD1
EN1 !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " Y=$P(DTAR,U,3) ^DD("DD"Y,!!
 
DATE^DVBAUTIL
 
G:X=""!(Y<0) KILL %ZIS="AEQ" ^%ZIS %ZIS
 
POP DVBAON2,DCHPTR,M,Y,KILL^DVBAUTIL
 
;
QUEUE I $D(IO("Q")) ZTRTN="DEQUE^DVBAADRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE ADMISSION REPORT" I="BDATE","EDATE","HEAD","HEAD1","RO","RONUM","FDT(0)","NOASK" ZTSAVE(I)=""
 
I $D(IO("Q")) ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! KILL
 
;
GO MA=BDATE J=0:0 MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="")  W:(('$D(NOASK))&($G(DVBADLMTR)="")) "." DA=0:0 DA=$O(^DGPM("AMV1",MA,DA)) Q:DA=""  MB=0:0 MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB=""  MA'>EDATE SET
 
'$D(^TMP($J)) D  H KILL
 
.IO
 
.W:($G(DVBADLMTR)="") !!,*7
 .
"No data found for parameters entered.",!!
 
W:(($G(DVBGUI)=1)&($G(DVBADLMTR)="")) !,HEAD,!,HEAD1,!
 
I $D(^TMP($J)) PRINT I $D(DVBAQUITDVBAON2,DCHPTR,M,Y,KILL^DVBAUTIL
 
;
KILL ;
 
^%ZISC X=3 DVBAON2,DCHPTR,M,Y,D:$D(ZTQUEUEDKILL^%ZTLOAD FINAL^DVBAUTIL
 
;
DEQUE ^TMP($JGO
 
;
COLHDR ;Column header for delimited report
 
"Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
 
"Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR_"Admitting Diagnosis"_DVBADLMTR
 
"Discharge Date"_DVBADLMTR_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR
 
"Pension?"_DVBADLMTR_"Eligibility Data"
 
DVBADHDR=1  ;set so header info only printed once
 
Q