LR517 ;HPS/JLG - LR*5.2*517 PATCH POST INSTALL ROUTINE ;Mar 19, 2019@12:00
;;5.2;LAB SERVICE;**517**;Sep 27, 1994;Build 5
;
; $$HTFM^XLFDT supported by DBIA #10103
; $$SENDMSG^XMXAPI supported by IA #2729
;
EN ;
N LRI,LRSS,LRHDR,LRMTXT,LRCTR,LRDATA,MIDX,MTXT
S LRHDR=1,LRCTR=0
;
S LRCTR=LRCTR+1,LRMTXT="The following orphaned data was removed from the LABORATORY TEST file (#60): " D SETMSG(LRCTR,LRMTXT)
;
S LRI=0 F S LRI=$O(^LAB(60,LRI)) Q:'LRI D
.S LRSS=0 F S LRSS=$O(^LAB(60,LRI,1,LRSS)) Q:LRSS="" D
..Q:'$D(^LAB(60,LRI,1,LRSS,5)) Q:$D(^LAB(60,LRI,1,LRSS,0))
..S:LRCTR=1 ^XTMP("LR_5.2_517_POST_INSTALL",0)=$$HTFM^XLFDT($H+30,1)_"^"_$$HTFM^XLFDT($H,1)_"^Removing Data from LABORATORY TEST file (#60)"
..S LRDATA=$G(^LAB(60,LRI,1,LRSS,5)),^XTMP("LR_5.2_517_POST_INSTALL",LRI,LRSS)=LRDATA
..K ^LAB(60,LRI,1,LRSS,5)
..S LRCTR=LRCTR+1 D SETMSG(LRCTR," ")
..S LRMTXT="LAB TEST: "_$$GET1^DIQ(60,LRI_",",.01)_" (ien: "_LRI_")",LRCTR=LRCTR+1 D SETMSG(LRCTR,LRMTXT)
..S LRMTXT="SITE/SPECIMEN: "_$$GET1^DIQ(61,LRSS_",",.01)_" (ien: "_LRSS_")",LRCTR=LRCTR+1 D SETMSG(LRCTR,LRMTXT)
;
I LRCTR=1 S LRCTR=LRCTR+1 D SETMSG(LRCTR," ") S LRCTR=LRCTR+1 W ! D SETMSG(LRCTR,"NO DATA FOUND TO REMOVE")
S LRCTR=LRCTR+1 D SETMSG(LRCTR," ")
;
MMMSG ; create and send a mailman message
N XMY,XMSUB,XMTEXT,XMFROM,XMDUZ
S XMFROM("FROM")="LR*5.2*517 Post-Install"
S XMY(DUZ)=""
S XMSUB="LR*5.2*517 Data Removal",XMDUZ=.5
S XMTEXT="^TMP($J,""LR517"")"
D SENDMSG^XMXAPI(DUZ,XMSUB,XMTEXT,.XMY,.XMFROM,,"")
K ^TMP($J),XMY,XMSUB,XMTEXT,XMFROM,XMDUZ
Q
SETMSG(MIDX,MTXT) ; set global entry for mailman message
S ^TMP($J,"LR517",MIDX)=MTXT
W !,MTXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR517 1702 printed Dec 13, 2024@02:04:16 Page 2
LR517 ;HPS/JLG - LR*5.2*517 PATCH POST INSTALL ROUTINE ;Mar 19, 2019@12:00
+1 ;;5.2;LAB SERVICE;**517**;Sep 27, 1994;Build 5
+2 ;
+3 ; $$HTFM^XLFDT supported by DBIA #10103
+4 ; $$SENDMSG^XMXAPI supported by IA #2729
+5 ;
EN ;
+1 NEW LRI,LRSS,LRHDR,LRMTXT,LRCTR,LRDATA,MIDX,MTXT
+2 SET LRHDR=1
SET LRCTR=0
+3 ;
+4 SET LRCTR=LRCTR+1
SET LRMTXT="The following orphaned data was removed from the LABORATORY TEST file (#60): "
DO SETMSG(LRCTR,LRMTXT)
+5 ;
+6 SET LRI=0
FOR
SET LRI=$ORDER(^LAB(60,LRI))
if 'LRI
QUIT
Begin DoDot:1
+7 SET LRSS=0
FOR
SET LRSS=$ORDER(^LAB(60,LRI,1,LRSS))
if LRSS=""
QUIT
Begin DoDot:2
+8 if '$DATA(^LAB(60,LRI,1,LRSS,5))
QUIT
if $DATA(^LAB(60,LRI,1,LRSS,0))
QUIT
+9 if LRCTR=1
SET ^XTMP("LR_5.2_517_POST_INSTALL",0)=$$HTFM^XLFDT($HOROLOG+30,1)_"^"_$$HTFM^XLFDT($HOROLOG,1)_"^Removing Data from LABORATORY TEST file (#60)"
+10 SET LRDATA=$GET(^LAB(60,LRI,1,LRSS,5))
SET ^XTMP("LR_5.2_517_POST_INSTALL",LRI,LRSS)=LRDATA
+11 KILL ^LAB(60,LRI,1,LRSS,5)
+12 SET LRCTR=LRCTR+1
DO SETMSG(LRCTR," ")
+13 SET LRMTXT="LAB TEST: "_$$GET1^DIQ(60,LRI_",",.01)_" (ien: "_LRI_")"
SET LRCTR=LRCTR+1
DO SETMSG(LRCTR,LRMTXT)
+14 SET LRMTXT="SITE/SPECIMEN: "_$$GET1^DIQ(61,LRSS_",",.01)_" (ien: "_LRSS_")"
SET LRCTR=LRCTR+1
DO SETMSG(LRCTR,LRMTXT)
End DoDot:2
End DoDot:1
+15 ;
+16 IF LRCTR=1
SET LRCTR=LRCTR+1
DO SETMSG(LRCTR," ")
SET LRCTR=LRCTR+1
WRITE !
DO SETMSG(LRCTR,"NO DATA FOUND TO REMOVE")
+17 SET LRCTR=LRCTR+1
DO SETMSG(LRCTR," ")
+18 ;
MMMSG ; create and send a mailman message
+1 NEW XMY,XMSUB,XMTEXT,XMFROM,XMDUZ
+2 SET XMFROM("FROM")="LR*5.2*517 Post-Install"
+3 SET XMY(DUZ)=""
+4 SET XMSUB="LR*5.2*517 Data Removal"
SET XMDUZ=.5
+5 SET XMTEXT="^TMP($J,""LR517"")"
+6 DO SENDMSG^XMXAPI(DUZ,XMSUB,XMTEXT,.XMY,.XMFROM,,"")
+7 KILL ^TMP($JOB),XMY,XMSUB,XMTEXT,XMFROM,XMDUZ
+8 QUIT
SETMSG(MIDX,MTXT) ; set global entry for mailman message
+1 SET ^TMP($JOB,"LR517",MIDX)=MTXT
+2 WRITE !,MTXT
+3 QUIT
