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 Dec 13, 2024@02:00:30 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."
