DVBAB9 ;ALB/SPH - CAPRI DISCHARGE REPORT ;09/06/00
 ;;2.7;AMIE;**35**;Apr 10, 1995
 ;
STRT(MSG,BDATE,EDATE,RONUM,DUZ) ;
 
DVBACEPT=1  ; Force to find all d/c types
 ;
 
^TMP($JTERM
 
;
SET Q:'$D(^DPT(DA,0))  DFN=DA,DVBASC="" RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)  Q:ADTYPE="S"&(DVBASC'="Y")  Q:ADTYPE="A"&(RCVAA'=1)  Q:ADTYPE="P"&(RCVPEN'="1")
 
TDIS=$S($D(^DGPM(+MB,0)):$P(^(0),U,18),1:"")
 
I $D(^DG(405.2,+TDIS,0)) DO
 
.'$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q
 
.TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
 .
^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS
 
.Q
 Q
 
;
PRINTB MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5),DFN=DA,QUIT1=1 DCHGDT^DVBAVDPT
 
W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
 
!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
 
?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!
 
?8,"Discharge Date:",?26,$$FMTE^XLFDT(DCHGDT,"5DZ"),!,?5,"Type of Discharge:",?26,TDIS,!
 
LOS^DVBAUTIL ?8,"Length of Stay:",?26,LOS_$S(LOS="":"Discharged same day",LOS=1:" day",1:" days"),!
 
?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-".*7,!,"Press RETURN to continue or ""^"" to stop    " ANS:DTIME S:ANS=U!('$TQUIT=1 ANS=DVBAQUIT=1
 
DVBAON2=""
 
Q
 
;
PRINT IO QUIT=""
 
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
 
;
SETUP @IOF,!,"VARO DISCHARGE REPORT" NOPARM^DVBAUTL2 G:$D(DVBAQUITKILL^DVBAUTIL DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
 
DSRP=1,HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) !,HEAD1
 
;
EN1 ;W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,4) X ^DD("DD") W Y,!!
 ;D DATE^DVBAUTIL
 ;G:X=""!(Y<0) KILL
 ;
ADTYPE ;D ADTYPE^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
 
@IOF
 
;K DVBACEPT
 ;D EN^VALM("DVBA DISCHARGE TYPES")
 
'$D(DVBACEPTKILL^DVBAUTIL Q
 I 
'$O(^TMP("DVBA",$J,"DUP",0)) KILL^DVBAUTIL Q
 
;
 
!!! %ZIS="Q" ^%ZIS %ZIS G:POP KILL^DVBAUTIL
 
;
QUEUE I $D(IO("Q")) ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DISCHARGE REPORT" I="^TMP(""DVBA"",$J,""DUP""","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" ZTSAVE(I)=""
 
I $D(IO("Q")) ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",! KILL
 
;
GO MA=BDATE J=0:0 MA=$O(^DGPM("AMV3",MA)) Q:MA>EDATE!(MA="")  W:'$D(NOASK"." DA=0:0 DA=$O(^DGPM("AMV3",MA,DA)) Q:DA=""  MB=0:0 MB=$O(^DGPM("AMV3",MA,DA,MB)) Q:MB=""  SET
 
'$D(^TMP($J)) IO !!,*7,"No data found for parameters entered.",!! KILL
 
PRINT I $D(DVBAQUITDVBAON2 KILL^DVBAUTIL
 
;
KILL ^%ZISC D:$D(ZTQUEUEDKILL^%ZTLOAD X=4 DVBAON2 FINAL^DVBAUTIL
 
;
DEQUE ^TMP($JGO