DVBADSNT ;ALB/GTS-557/THM-GENERATE AMIE NOTICE OF DISCHARGE ; 1/16/91  7:37 AM
 ;;2.7;AMIE;**1,14,17,42**;Apr 10, 1995
 
DVBGUI
 
DVBGUI=0
 
^TMP($JTERM
 
;
SET Q:'$D(^DPT(DFN,0))  RCV^DVBAVDPT ^TMP($J,XCN,CFLOC,MB,DFN)=XDA_U_XDA2_U_ADMDT_U_RCVAA_U_RCVPEN_U_CNUM
 
Q
 
;
ENBROKER(Y) ;
 
DVBGUI,DVBHFS,DVBERR
 
DVBGUI=1,DVBERR=0,DVBHFS=$$HFS^DVBAB82()
 
^TMP($JTERM
 
Q
PRINTB XDA=$P(DATA,U),XDA2=$P(DATA,U,2),ADMDT=$P(DATA,U,3),RCVAA=$P(DATA,U,4),RCVPEN=$P(DATA,U,5),CNUM=$P(DATA,U,6),QUIT1=1 ADM^DVBAVDPT
 
LADM=ADM
 
'$D(^DGPM(LADM,0)) FND=1
 
I $D(^DGPM(LADM,0)) HPAT HPAT=$P(^DGPM(LADM,0),"^",3) I $D(^DPT(HPAT,0)) HPAT=$P(^DPT(HPAT,0),"^"(HPAT'=PNAM)!(ADMDT'=$P(^DGPM(LADM,0),"^")) FND=1
 
I $D(FNDY=ADMDT DD^%DT !!,"Admission entry in Patient Movement File has been deleted for: ",!,?5,PNAM,?25,SSN,?35," at ",Y,!,"Contact VAMC for further information.",! Y,FND FUPD Q
 S 
DCHPTR=$P(^DGPM(LADM,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:""TDIS="" TDIS="Unknown discharge type"
 
S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
 
DCHGDT="" DCHGDT=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U),1:"")
 
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,! DA=DFN ELIG^DVBAVDPT
FUPD DA XDA2]"",$P(^DVB(396,XDA2,0),U,9)="P" DA=XDA2,DIE="^DVB(396,",DR="4.5////C;4.8////"_DT_";4.9////"_"Notice of Discharge" ^DIE DA
 
I $D(DVBAD2DVBAD2=CFLOC!(CFLOC=376) DIE="^DVB(396.2,",DA=XDA,DR="3///P;4///"_DT_";5////"_DUZ ^DIE
 
DVBGUI=0 D
 
IOST?1"C-".*7,!,"Press RETURN to continue or ""^"" to stop    " ANS:DTIME S:ANS=U!('$TQUIT=1 '$T S 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
 
DVBGUI=1 END^DVBAB82
 
Q
PRINT1 ADM="" K=0:0 ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""  DFN="" L=0:0 DFN=$O(^TMP($J,XCN,CFLOC,ADM,DFN)) Q:DFN=""!(QUIT=1)  DATA=^(DFNPRINTB
 
Q
 
;
TERM HOME^%ZIS NOASK
 
DUZ2^DVBAUTIL I $D(DVBAQUITDVBAQUIT KILL
 
;
SETUP @IOF,!,"NOTICE OF DISCHARGE REPORT" NOPARM^DVBAUTL2 G:$D(DVBAQUITKILL^DVBAUTIL DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
 
HEAD="NOTICE OF DISCHARGE",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
 
!,HEAD1
EN1 DVBGUI=0 
 
!!,"This program will print out any new NOTICES OF DISCHARGE,",!,"based on the hospital's discharges.",!!,"Do you want to continue" %=2 YN^DICN
 . 
I $D(%Y%Y["?" !!,"Enter Y to print out the notice, N if you want to exit the program.",! EN1
 
G:%'=1 KILL %ZIS="Q" ^%ZIS %ZIS POP KILL
 
DVBGUI=1 HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W"DVBERR END^DVBAB82 Q
 
;
QUEUE I $D(IO("Q")) ZTRTN="DEQUE^DVBADSNT",ZTIO=ION,NOASK=1,ZTDESC="AMIE NOTICE OF DISCHARGE REPORT" I="FDT(0)","HEAD","HEAD1","NOASK","DVBAD2" ZTSAVE(I)=""
 
I $D(IO("Q")) ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! ZTSK KILL
 
;
GO XDA=0:0 XDA=$O(^DVB(396.2,"C",DVBAD2,"R",XDA)) Q:XDA=""  I $D(^DVB(396.2,XDA,0)) MB=^(0),DFN=$P(MB,U),ADMDT=$P(MB,U,2),MB=$P(MB,U,3) CHK,SET '$D(NOASK"."
 
'$D(^TMP($J)) IO !!,*7,"No data found.",!! KILL
 
PRINT
KILL 
D:$D(ZTQUEUEDKILL^%ZTLOAD DVBAON2 KILL^DVBAUTIL
 
;
DEQUE ^TMP($JGO
 
;
CHK ;pull 7131 pointer
 
XDA2=0:0 XDA2=$O(^DVB(396,"G",ADMDT,XDA2)) Q:XDA2=""  I $D(^DVB(396,XDA2,2))&($D(^DVB(396,XDA2,0))) Q:($P(^DVB(396,XDA2,0),U,1)=DFN&($P(^DVB(396,XDA2,2),"^",10)="A"))
 
Q
 
;
REPRINT CHK,SET,PRINT KILL