- DGJBGJ1 ;ALB/MAF - IRT BACKGROUND JOB (CONT.) - MAY 3 1993
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- MSG N DGJCNT,DGJDV,DGJDT,DGJCA
- S (DGJCNT,DGJDV,DGJDT,DGJCA)=0
- F S DGJDV=$O(^TMP("VAS",$J,DGJDV)) Q:DGJDV']"" F S DGJDT=$O(^TMP("VAS",$J,DGJDV,DGJDT)) Q:DGJDT']"" F S DGJCA=$O(^TMP("VAS",$J,DGJDV,DGJDT,DGJCA)) Q:DGJCA']"" S DGJCNT=DGJCNT+1 S DGJMSG(DGJCNT,0)=^TMP("VAS",$J,DGJDV,DGJDT,DGJCA,0)
- I '$D(DGJMSG(1)) G Q
- ;quit it no text in message
- S XMSUB="PATIENTS DISCHARGED LESS THAN 48 HOURS"
- S XMTEXT="DGJMSG("
- S DGJB=+$P($G(^DG(43,1,"NOT")),"^",14)
- S XMY("G."_$P($G(^XMB(3.8,DGJB,0)),"^",1))="" ; pass mailgroup
- ; makes sure it gets sent to someone
- I '$D(XMY) S XMY(.5)=""
- ; make postmaster the sender so it will show up as new to DUZ
- S XMDUZ=.5
- D ^XMD:$D(XMY)
- Q K DGSM,DGB,DGTEXT,XMR,DGII,XMY,XMTEXT,XMDUZ,XMSUB Q
- ;
- ERRMSG ; Send error message.
- Q:'$D(DGJERR)
- S Y=DGJRUN D DD^%DT S DGJRUN=Y
- K DGJMSG
- S DGJMSG(1)="The following error(s) were reported during the Incomplete Records menu run:"
- S DGJMSG(2)="IRT Update Std. Def. Background Job [DGJ IRT UPDATE (Background)"
- S DGJMSG(3)=" or"
- S DGJMSG(4)="IRT Update Std. Deficiencies [DGJ IRT UPDATE STD. DEFIC.]"
- S DGJMSG(5)=" "
- S DGJMSG(6)="Verify the following patient information. Manually run the option:"
- S DGJMSG(7)="IRT UPDATE Std. Deficiencies [DGJ IRT UPDATE STD. DEFIC.]"
- S DGJMSG(8)="for the run time listed below."
- S DGJMSG(9)=" "
- S DGJMSG(10)="Run time: "_DGJRUN
- S DGJMSG(11)="Errors encountered during menu run:"
- S DGJMSG(12)="-----------------------------------------"
- S TXT=12,I=0
- F S I=$O(DGJERR(I)) Q:I="" D
- . S DFN=0 F S DFN=$O(DGJERR(I,DFN)) Q:'DFN D
- . . S DGJMT=0 F S DGJMT=$O(DGJERR(I,DFN,DGJMT)) Q:'DGJMT D
- . . . S Y=DGJMT D DD^%DT
- . . .S DGJMSG(TXT+1)=$P(^DPT(DFN,0),"^",1)_"("_$E($P(^DPT(DFN,0),"^",9),6,9)_") Mvmt: ("_Y_") has "_$P($T(@(I)),";",3)
- ;
- S XMSUB="IRT Update Std. Defic. Error List"
- S XMTEXT="DGJMSG("
- S DGJB=+$P($G(^DG(43,1,"NOT")),"^",14)
- I DGJB S XMY("G."_$P($G(^XMB(3.8,DGJB,0)),"^",1))="" ; pass mailgroup
- I '$D(XMY) S XMY(.5)=""
- I DUZ>0 S XMY(DUZ)=""
- ; make postmaster the sender so it will show up as new to DUZ
- S XMDUZ=.5
- D ^XMD:$D(XMY)
- K XMTEXT,XMSUB,DGJB,XMY,DGJMSG,XMDUZ,I,DFN,DGJMT,Y Q
- ;
- ERRMSG1 ; Error listing
- ERR1 ;ERR1;No Ward Location found."
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJBGJ1 2369 printed Apr 23, 2025@18:14:57 Page 2
- DGJBGJ1 ;ALB/MAF - IRT BACKGROUND JOB (CONT.) - MAY 3 1993
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- MSG NEW DGJCNT,DGJDV,DGJDT,DGJCA
- +1 SET (DGJCNT,DGJDV,DGJDT,DGJCA)=0
- +2 FOR
- SET DGJDV=$ORDER(^TMP("VAS",$JOB,DGJDV))
- if DGJDV']""
- QUIT
- FOR
- SET DGJDT=$ORDER(^TMP("VAS",$JOB,DGJDV,DGJDT))
- if DGJDT']""
- QUIT
- FOR
- SET DGJCA=$ORDER(^TMP("VAS",$JOB,DGJDV,DGJDT,DGJCA))
- if DGJCA']""
- QUIT
- SET DGJCNT=DGJCNT+1
- SET DGJMSG(DGJCNT,0)=^TMP("VAS",$JOB,DGJDV,DGJDT,DGJCA,0)
- +3 IF '$DATA(DGJMSG(1))
- GOTO Q
- +4 ;quit it no text in message
- +5 SET XMSUB="PATIENTS DISCHARGED LESS THAN 48 HOURS"
- +6 SET XMTEXT="DGJMSG("
- +7 SET DGJB=+$PIECE($GET(^DG(43,1,"NOT")),"^",14)
- +8 ; pass mailgroup
- SET XMY("G."_$PIECE($GET(^XMB(3.8,DGJB,0)),"^",1))=""
- +9 ; makes sure it gets sent to someone
- +10 IF '$DATA(XMY)
- SET XMY(.5)=""
- +11 ; make postmaster the sender so it will show up as new to DUZ
- +12 SET XMDUZ=.5
- +13 if $DATA(XMY)
- DO ^XMD
- Q KILL DGSM,DGB,DGTEXT,XMR,DGII,XMY,XMTEXT,XMDUZ,XMSUB
- QUIT
- +1 ;
- ERRMSG ; Send error message.
- +1 if '$DATA(DGJERR)
- QUIT
- +2 SET Y=DGJRUN
- DO DD^%DT
- SET DGJRUN=Y
- +3 KILL DGJMSG
- +4 SET DGJMSG(1)="The following error(s) were reported during the Incomplete Records menu run:"
- +5 SET DGJMSG(2)="IRT Update Std. Def. Background Job [DGJ IRT UPDATE (Background)"
- +6 SET DGJMSG(3)=" or"
- +7 SET DGJMSG(4)="IRT Update Std. Deficiencies [DGJ IRT UPDATE STD. DEFIC.]"
- +8 SET DGJMSG(5)=" "
- +9 SET DGJMSG(6)="Verify the following patient information. Manually run the option:"
- +10 SET DGJMSG(7)="IRT UPDATE Std. Deficiencies [DGJ IRT UPDATE STD. DEFIC.]"
- +11 SET DGJMSG(8)="for the run time listed below."
- +12 SET DGJMSG(9)=" "
- +13 SET DGJMSG(10)="Run time: "_DGJRUN
- +14 SET DGJMSG(11)="Errors encountered during menu run:"
- +15 SET DGJMSG(12)="-----------------------------------------"
- +16 SET TXT=12
- SET I=0
- +17 FOR
- SET I=$ORDER(DGJERR(I))
- if I=""
- QUIT
- Begin DoDot:1
- +18 SET DFN=0
- FOR
- SET DFN=$ORDER(DGJERR(I,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +19 SET DGJMT=0
- FOR
- SET DGJMT=$ORDER(DGJERR(I,DFN,DGJMT))
- if 'DGJMT
- QUIT
- Begin DoDot:3
- +20 SET Y=DGJMT
- DO DD^%DT
- +21 SET DGJMSG(TXT+1)=$PIECE(^DPT(DFN,0),"^",1)_"("_$EXTRACT($PIECE(^DPT(DFN,0),"^",9),6,9)_") Mvmt: ("_Y_") has "_$PIECE($TEXT(@(I)),";",3)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 SET XMSUB="IRT Update Std. Defic. Error List"
- +24 SET XMTEXT="DGJMSG("
- +25 SET DGJB=+$PIECE($GET(^DG(43,1,"NOT")),"^",14)
- +26 ; pass mailgroup
- IF DGJB
- SET XMY("G."_$PIECE($GET(^XMB(3.8,DGJB,0)),"^",1))=""
- +27 IF '$DATA(XMY)
- SET XMY(.5)=""
- +28 IF DUZ>0
- SET XMY(DUZ)=""
- +29 ; make postmaster the sender so it will show up as new to DUZ
- +30 SET XMDUZ=.5
- +31 if $DATA(XMY)
- DO ^XMD
- +32 KILL XMTEXT,XMSUB,DGJB,XMY,DGJMSG,XMDUZ,I,DFN,DGJMT,Y
- QUIT
- +33 ;
- ERRMSG1 ; Error listing
- ERR1 ;ERR1;No Ward Location found."
