Routine: LR517

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

SETMSG(MIDX,MTXT) ; set global entry for mailman message

 S ^TMP($J,"LR517",MIDX)=MTXT

 W !,MTXT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR517   1702     printed  Apr 09, 2024@21:25:41                                                                                                                                                                                                       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

LR517.m