LR411PST ;Post-init Routine for LR*5.2*411 ; 2/18/04 9:29am
;;5.2;LAB SERVICE;**411**;Dec 30, 1994;Build 2
;
PRE ; initiate pre-init process
Q
;
POST ; initiate post-init process
D 389262
D MAIL
;
K ^TMP($J)
Q
;
389262 ; check file 69.2 for missing global level containing last update date
;
K ^TMP($J)
;
D EN^DDIOL("Checking file # 69.2 (User defined patient/test lists...",,"!!!!")
D EN^DDIOL("",,"!")
;
N AA,DZ,DT
S AA=$O(^LRO(68,"B","CHEMISTRY",0))
I 'AA D EN^DDIOL("No entries to correct in file # 69.2.",,"!!!") Q
;
S DT=$$HTFM^XLFDT(+$H)
S DZ=0
F S DZ=$O(^LRO(69.2,AA,7,DZ)) Q:DZ="" D
. I '$D(^LRO(69.2,AA,7,DZ,1,0)) S ^LRO(69.2,AA,7,DZ,1,0)="^69.3PA^0^0"
. I '$D(^LRO(69.2,AA,7,DZ,0)) S ^LRO(69.2,AA,7,DZ,0)=DZ_"^"_DT,^TMP($J,"DUZ",DZ)=""
;
D EN^DDIOL("Review/Repair of file 69.2 complete.",,"!!!!")
;
Q
;
MAIL ;
; setup, create, and send MAILMAN message listing DFNs from the NEW PERSON file
; that were set with today's date as the last date used for the patient/test lists
; in file 69.2
;
N DIFROM,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,DZ
;
S XMDUZ="PATCH LR*5.2*411 POST-INIT"
S XMTEXT="^TMP($J,""TXT"","
S XMSUB="PATCH LR*5.2*411 POST-INIT RESULTS"
S:$G(DUZ) XMY(DUZ)=""
S I=1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)="User-defined test lists and patient lists are stored in file 69.2."
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)="The last date used is a data item in this file that allows for"
S I=I+1,^TMP($J,"TXT",I)="the deletion of lists that have not been used in a prescribed amount"
S I=I+1,^TMP($J,"TXT",I)="of time."
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)="In some cases the global level holding this date is missing for a user."
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)="This post-init routine will insert this global level into file 69.2 for"
S I=I+1,^TMP($J,"TXT",I)="those users where this level is missing. Today's date will be inserted"
S I=I+1,^TMP($J,"TXT",I)="as the last used date so that these lists may ultimately be deleted."
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)="The following users had today's date added as the last used date:"
S I=I+1,^TMP($J,"TXT",I)="(These are DFNs - IENs for the NEW PERSON file.)"
S I=I+1,^TMP($J,"TXT",I)=""
S I=I+1,^TMP($J,"TXT",I)=""
I $O(^TMP($J,"DUZ",0))="" D Q
. S I=I+1,^TMP($J,"TXT",I)="NO USERS WERE IN NEED OF UPDATES."
. D ^XMD
S DZ=0 F S DZ=$O(^TMP($J,"DUZ",DZ)) Q:DZ="" S I=I+1,^TMP($J,"TXT",I)=" "_DZ
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR411PST 2612 printed Apr 09, 2024@21:13:03 Page 2
LR411PST ;Post-init Routine for LR*5.2*411 ; 2/18/04 9:29am
+1 ;;5.2;LAB SERVICE;**411**;Dec 30, 1994;Build 2
+2 ;
PRE ; initiate pre-init process
+1 QUIT
+2 ;
POST ; initiate post-init process
+1 DO 389262
+2 DO MAIL
+3 ;
+4 KILL ^TMP($JOB)
+5 QUIT
+6 ;
389262 ; check file 69.2 for missing global level containing last update date
+1 ;
+2 KILL ^TMP($JOB)
+3 ;
+4 DO EN^DDIOL("Checking file # 69.2 (User defined patient/test lists...",,"!!!!")
+5 DO EN^DDIOL("",,"!")
+6 ;
+7 NEW AA,DZ,DT
+8 SET AA=$ORDER(^LRO(68,"B","CHEMISTRY",0))
+9 IF 'AA
DO EN^DDIOL("No entries to correct in file # 69.2.",,"!!!")
QUIT
+10 ;
+11 SET DT=$$HTFM^XLFDT(+$HOROLOG)
+12 SET DZ=0
+13 FOR
SET DZ=$ORDER(^LRO(69.2,AA,7,DZ))
if DZ=""
QUIT
Begin DoDot:1
+14 IF '$DATA(^LRO(69.2,AA,7,DZ,1,0))
SET ^LRO(69.2,AA,7,DZ,1,0)="^69.3PA^0^0"
+15 IF '$DATA(^LRO(69.2,AA,7,DZ,0))
SET ^LRO(69.2,AA,7,DZ,0)=DZ_"^"_DT
SET ^TMP($JOB,"DUZ",DZ)=""
End DoDot:1
+16 ;
+17 DO EN^DDIOL("Review/Repair of file 69.2 complete.",,"!!!!")
+18 ;
+19 QUIT
+20 ;
MAIL ;
+1 ; setup, create, and send MAILMAN message listing DFNs from the NEW PERSON file
+2 ; that were set with today's date as the last date used for the patient/test lists
+3 ; in file 69.2
+4 ;
+5 NEW DIFROM,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,DZ
+6 ;
+7 SET XMDUZ="PATCH LR*5.2*411 POST-INIT"
+8 SET XMTEXT="^TMP($J,""TXT"","
+9 SET XMSUB="PATCH LR*5.2*411 POST-INIT RESULTS"
+10 if $GET(DUZ)
SET XMY(DUZ)=""
+11 SET I=1
SET ^TMP($JOB,"TXT",I)=""
+12 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+13 SET I=I+1
SET ^TMP($JOB,"TXT",I)="User-defined test lists and patient lists are stored in file 69.2."
+14 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+15 SET I=I+1
SET ^TMP($JOB,"TXT",I)="The last date used is a data item in this file that allows for"
+16 SET I=I+1
SET ^TMP($JOB,"TXT",I)="the deletion of lists that have not been used in a prescribed amount"
+17 SET I=I+1
SET ^TMP($JOB,"TXT",I)="of time."
+18 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+19 SET I=I+1
SET ^TMP($JOB,"TXT",I)="In some cases the global level holding this date is missing for a user."
+20 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+21 SET I=I+1
SET ^TMP($JOB,"TXT",I)="This post-init routine will insert this global level into file 69.2 for"
+22 SET I=I+1
SET ^TMP($JOB,"TXT",I)="those users where this level is missing. Today's date will be inserted"
+23 SET I=I+1
SET ^TMP($JOB,"TXT",I)="as the last used date so that these lists may ultimately be deleted."
+24 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+25 SET I=I+1
SET ^TMP($JOB,"TXT",I)="The following users had today's date added as the last used date:"
+26 SET I=I+1
SET ^TMP($JOB,"TXT",I)="(These are DFNs - IENs for the NEW PERSON file.)"
+27 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+28 SET I=I+1
SET ^TMP($JOB,"TXT",I)=""
+29 IF $ORDER(^TMP($JOB,"DUZ",0))=""
Begin DoDot:1
+30 SET I=I+1
SET ^TMP($JOB,"TXT",I)="NO USERS WERE IN NEED OF UPDATES."
+31 DO ^XMD
End DoDot:1
QUIT
+32 SET DZ=0
FOR
SET DZ=$ORDER(^TMP($JOB,"DUZ",DZ))
if DZ=""
QUIT
SET I=I+1
SET ^TMP($JOB,"TXT",I)=" "_DZ
+33 DO ^XMD
+34 ;
+35 QUIT
