LR559PST ;HPS/DSK - LR*5.2*559 PATCH POST INSTALL ROUTINE ;Jun 02, 2022@16:00
;;5.2;LAB SERVICE;**559**;Sep 27, 1994;Build 3
;
Q
;
EN ;
;This routine is not deleted after install since it is tasked. A future
;patch will delete the routine.
;
N LRDUZ
S ZTRTN="START^LR559PST"
S ZTDESC="LR*5.2*559 Post-Install Routine"
S ZTIO="",ZTDTH=$H
S LRDUZ=DUZ
S ZTSAVE("LRDUZ")=""
D ^%ZTLOAD
W !!,"LR*5.2*559 Post-Install Routine has been tasked - TASK NUMBER: ",$G(ZTSK)
W !!,"You as well as members of the LMI MailMan Group will receive"
W !,"a MailMan message when the search completes.",!
Q
;
START ;
N LRWRONG,LRCORRECT,LRSEQ,LRTEXT
;Initialize ^XTMP in case patch install re-started.
K ^XTMP("LR 559 MAILMAN MESSAGE")
S ^XTMP("LR 559 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*559 POST INSTALL"
;Incorrect execute code for monthly accession areas
S LRWRONG="S %DT="""",X=""T"" D ^%DT S LRAD=$E(Y,1,5)_""00"" S LRAN=1+$S($D(^LRO(68,LRWLC,1,LRAD,1,0)):$P(^(0),""^"",4),1:0) Q"
;Correct execute code for monthly accession areas
S LRCORRECT="S %DT="""",X=""T"" D ^%DT S LRAD=$E(Y,1,5)_""00"" S LRAN=1+$S($D(^LRO(68,LRWLC,1,LRAD,1,0)):$P(^(0),""^"",3),1:0) Q"
S LRSEQ=1
;Start message with blank line for better readability.
S LRTEXT=" "
D LINE
D LAB6207,LRO68,MAIL
Q
;
LAB6207 ;
N LREX,LRSTR,LRCHECK,LRHIT,LRFDA,LRMSG
S LRTEXT="Entries in the EXECUTE CODE (#62.07) file which were corrected:"
D LINE
S LRTEXT="---------------------------------------------------------------"
D LINE
;This line will be overwritten if entries are corrected.
S LRTEXT="None"
D LINE
S (LRHIT,LREX)=0
F S LREX=$O(^LAB(62.07,LREX)) Q:'LREX D
. S LRSTR=$G(^LAB(62.07,LREX,0))
. I $P(LRSTR,"^",3)'="A" Q
. I $P(LRSTR,"^",2)'="MONTHLY" Q
. ;The entry might already have been manually corrected by the site.
. I $G(^LAB(62.07,LREX,.1))=LRCORRECT Q
. ;This entry does not match exactly the standard "wrong" execute code,
. ;so must be manually checked by the site.
. I $G(^LAB(62.07,LREX,.1))'=LRWRONG D Q
. . S LRCHECK(LREX)=""
. ;This entry must be corrected.
. S LRFDA(62.07,LREX_",",1)=LRCORRECT
. D FILE^DIE("","LRFDA","LRMSG")
. ;First entry which needs correction, so set sequence back by one
. ;to overwrite the "None" line.
. I 'LRHIT S LRSEQ=LRSEQ-1,LRHIT=1
. S LRTEXT=$P(LRSTR,"^")_" (IEN: "_LREX_")"
. I $D(LRMSG) S LRTEXT=LRTEXT_" *** Check this entry; FileMan returned an error. ***"
. D LINE
;List any entries which might require manual correction.
;Or maybe the site intends these entries to be set "as is".
I $D(LRCHECK) D
. S LRTEXT=" "
. D LINE
. S LRTEXT="The following entries in the EXECUTE CODE (#62.07) file must be"
. D LINE
. S LRTEXT="checked manually and evaluated as to whether correction is needed."
. D LINE
. S LRTEXT="------------------------------------------------------------------"
. D LINE
. S LREX=""
. F S LREX=$O(LRCHECK(LREX)) Q:LREX="" D
. . S LRTEXT=$P(^LAB(62.07,LREX,0),"^")_" (IEN: "_LREX_")"
. . D LINE
Q
;
LRO68 ;
N LRAA,LRFDA,LRMSG,LRHIT,LRCHECK
S LRTEXT=" "
D LINE
S LRTEXT="Entries in the ACCESSION (#68) file which were corrected:"
D LINE
S LRTEXT="---------------------------------------------------------"
D LINE
;This line will be overwritten if entries are corrected.
S LRTEXT="None"
D LINE
S (LRAA,LRHIT)=0
F S LRAA=$O(^LRO(68,LRAA)) Q:'LRAA I $P($G(^LRO(68,LRAA,0)),"^",3)="M" D
. ;Execute code might have already been corrected manually.
. Q:$G(^LRO(68,LRAA,.1))=LRCORRECT
. I $G(^LRO(68,LRAA,.1))'=LRWRONG D Q
. . S LRCHECK(LRAA)=""
. ;This entry needs correction.
. S LRFDA(68,LRAA_",",.051)=LRCORRECT
. D FILE^DIE("","LRFDA","LRMSG")
. ;First entry which needs correction, so set sequence back by one
. ;to overwrite the "None" line.
. I 'LRHIT S LRSEQ=LRSEQ-1,LRHIT=1
. S LRTEXT=$P(^LRO(68,LRAA,0),"^")
. I $D(LRMSG) S LRTEXT=LRTEXT_" *** Check this entry; FileMan returned an error. ***"
. D LINE
I $D(LRCHECK) D
. S LRTEXT=" "
. D LINE
. S LRTEXT="The ACC CODE (#.051) field in the ACCESSION (#68) file for the"
. D LINE
. S LRTEXT="following accession areas must be checked manually and evaluated"
. D LINE
. S LRTEXT="as to whether correction is needed."
. D LINE
. S LRTEXT="----------------------------------------------------------------"
. D LINE
. S LRAA=""
. F S LRAA=$O(LRCHECK(LRAA)) Q:LRAA="" D
. . S LRTEXT=$P(^LRO(68,LRAA,0),"^")
. . D LINE
Q
;
LINE ;
S LRSEQ=LRSEQ+1
S ^XTMP("LR 559 MAILMAN MESSAGE",LRSEQ)=LRTEXT
Q
;
MAIL ;
N LRMIN,LRMY,LRMSUB,LRMTEXT
S LRMIN("FROM")="LR*5.2*559 Post-Install"
S LRMY(LRDUZ)=""
S LRMY("G.LMI")=""
S LRMSUB="LR*5.2*559 Post-Install"
S LRMTEXT="^XTMP(""LR 559 MAILMAN MESSAGE"")"
D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR559PST 4910 printed Dec 13, 2024@02:04:32 Page 2
LR559PST ;HPS/DSK - LR*5.2*559 PATCH POST INSTALL ROUTINE ;Jun 02, 2022@16:00
+1 ;;5.2;LAB SERVICE;**559**;Sep 27, 1994;Build 3
+2 ;
+3 QUIT
+4 ;
EN ;
+1 ;This routine is not deleted after install since it is tasked. A future
+2 ;patch will delete the routine.
+3 ;
+4 NEW LRDUZ
+5 SET ZTRTN="START^LR559PST"
+6 SET ZTDESC="LR*5.2*559 Post-Install Routine"
+7 SET ZTIO=""
SET ZTDTH=$HOROLOG
+8 SET LRDUZ=DUZ
+9 SET ZTSAVE("LRDUZ")=""
+10 DO ^%ZTLOAD
+11 WRITE !!,"LR*5.2*559 Post-Install Routine has been tasked - TASK NUMBER: ",$GET(ZTSK)
+12 WRITE !!,"You as well as members of the LMI MailMan Group will receive"
+13 WRITE !,"a MailMan message when the search completes.",!
+14 QUIT
+15 ;
START ;
+1 NEW LRWRONG,LRCORRECT,LRSEQ,LRTEXT
+2 ;Initialize ^XTMP in case patch install re-started.
+3 KILL ^XTMP("LR 559 MAILMAN MESSAGE")
+4 SET ^XTMP("LR 559 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*559 POST INSTALL"
+5 ;Incorrect execute code for monthly accession areas
+6 SET LRWRONG="S %DT="""",X=""T"" D ^%DT S LRAD=$E(Y,1,5)_""00"" S LRAN=1+$S($D(^LRO(68,LRWLC,1,LRAD,1,0)):$P(^(0),""^"",4),1:0) Q"
+7 ;Correct execute code for monthly accession areas
+8 SET LRCORRECT="S %DT="""",X=""T"" D ^%DT S LRAD=$E(Y,1,5)_""00"" S LRAN=1+$S($D(^LRO(68,LRWLC,1,LRAD,1,0)):$P(^(0),""^"",3),1:0) Q"
+9 SET LRSEQ=1
+10 ;Start message with blank line for better readability.
+11 SET LRTEXT=" "
+12 DO LINE
+13 DO LAB6207
DO LRO68
DO MAIL
+14 QUIT
+15 ;
LAB6207 ;
+1 NEW LREX,LRSTR,LRCHECK,LRHIT,LRFDA,LRMSG
+2 SET LRTEXT="Entries in the EXECUTE CODE (#62.07) file which were corrected:"
+3 DO LINE
+4 SET LRTEXT="---------------------------------------------------------------"
+5 DO LINE
+6 ;This line will be overwritten if entries are corrected.
+7 SET LRTEXT="None"
+8 DO LINE
+9 SET (LRHIT,LREX)=0
+10 FOR
SET LREX=$ORDER(^LAB(62.07,LREX))
if 'LREX
QUIT
Begin DoDot:1
+11 SET LRSTR=$GET(^LAB(62.07,LREX,0))
+12 IF $PIECE(LRSTR,"^",3)'="A"
QUIT
+13 IF $PIECE(LRSTR,"^",2)'="MONTHLY"
QUIT
+14 ;The entry might already have been manually corrected by the site.
+15 IF $GET(^LAB(62.07,LREX,.1))=LRCORRECT
QUIT
+16 ;This entry does not match exactly the standard "wrong" execute code,
+17 ;so must be manually checked by the site.
+18 IF $GET(^LAB(62.07,LREX,.1))'=LRWRONG
Begin DoDot:2
+19 SET LRCHECK(LREX)=""
End DoDot:2
QUIT
+20 ;This entry must be corrected.
+21 SET LRFDA(62.07,LREX_",",1)=LRCORRECT
+22 DO FILE^DIE("","LRFDA","LRMSG")
+23 ;First entry which needs correction, so set sequence back by one
+24 ;to overwrite the "None" line.
+25 IF 'LRHIT
SET LRSEQ=LRSEQ-1
SET LRHIT=1
+26 SET LRTEXT=$PIECE(LRSTR,"^")_" (IEN: "_LREX_")"
+27 IF $DATA(LRMSG)
SET LRTEXT=LRTEXT_" *** Check this entry; FileMan returned an error. ***"
+28 DO LINE
End DoDot:1
+29 ;List any entries which might require manual correction.
+30 ;Or maybe the site intends these entries to be set "as is".
+31 IF $DATA(LRCHECK)
Begin DoDot:1
+32 SET LRTEXT=" "
+33 DO LINE
+34 SET LRTEXT="The following entries in the EXECUTE CODE (#62.07) file must be"
+35 DO LINE
+36 SET LRTEXT="checked manually and evaluated as to whether correction is needed."
+37 DO LINE
+38 SET LRTEXT="------------------------------------------------------------------"
+39 DO LINE
+40 SET LREX=""
+41 FOR
SET LREX=$ORDER(LRCHECK(LREX))
if LREX=""
QUIT
Begin DoDot:2
+42 SET LRTEXT=$PIECE(^LAB(62.07,LREX,0),"^")_" (IEN: "_LREX_")"
+43 DO LINE
End DoDot:2
End DoDot:1
+44 QUIT
+45 ;
LRO68 ;
+1 NEW LRAA,LRFDA,LRMSG,LRHIT,LRCHECK
+2 SET LRTEXT=" "
+3 DO LINE
+4 SET LRTEXT="Entries in the ACCESSION (#68) file which were corrected:"
+5 DO LINE
+6 SET LRTEXT="---------------------------------------------------------"
+7 DO LINE
+8 ;This line will be overwritten if entries are corrected.
+9 SET LRTEXT="None"
+10 DO LINE
+11 SET (LRAA,LRHIT)=0
+12 FOR
SET LRAA=$ORDER(^LRO(68,LRAA))
if 'LRAA
QUIT
IF $PIECE($GET(^LRO(68,LRAA,0)),"^",3)="M"
Begin DoDot:1
+13 ;Execute code might have already been corrected manually.
+14 if $GET(^LRO(68,LRAA,.1))=LRCORRECT
QUIT
+15 IF $GET(^LRO(68,LRAA,.1))'=LRWRONG
Begin DoDot:2
+16 SET LRCHECK(LRAA)=""
End DoDot:2
QUIT
+17 ;This entry needs correction.
+18 SET LRFDA(68,LRAA_",",.051)=LRCORRECT
+19 DO FILE^DIE("","LRFDA","LRMSG")
+20 ;First entry which needs correction, so set sequence back by one
+21 ;to overwrite the "None" line.
+22 IF 'LRHIT
SET LRSEQ=LRSEQ-1
SET LRHIT=1
+23 SET LRTEXT=$PIECE(^LRO(68,LRAA,0),"^")
+24 IF $DATA(LRMSG)
SET LRTEXT=LRTEXT_" *** Check this entry; FileMan returned an error. ***"
+25 DO LINE
End DoDot:1
+26 IF $DATA(LRCHECK)
Begin DoDot:1
+27 SET LRTEXT=" "
+28 DO LINE
+29 SET LRTEXT="The ACC CODE (#.051) field in the ACCESSION (#68) file for the"
+30 DO LINE
+31 SET LRTEXT="following accession areas must be checked manually and evaluated"
+32 DO LINE
+33 SET LRTEXT="as to whether correction is needed."
+34 DO LINE
+35 SET LRTEXT="----------------------------------------------------------------"
+36 DO LINE
+37 SET LRAA=""
+38 FOR
SET LRAA=$ORDER(LRCHECK(LRAA))
if LRAA=""
QUIT
Begin DoDot:2
+39 SET LRTEXT=$PIECE(^LRO(68,LRAA,0),"^")
+40 DO LINE
End DoDot:2
End DoDot:1
+41 QUIT
+42 ;
LINE ;
+1 SET LRSEQ=LRSEQ+1
+2 SET ^XTMP("LR 559 MAILMAN MESSAGE",LRSEQ)=LRTEXT
+3 QUIT
+4 ;
MAIL ;
+1 NEW LRMIN,LRMY,LRMSUB,LRMTEXT
+2 SET LRMIN("FROM")="LR*5.2*559 Post-Install"
+3 SET LRMY(LRDUZ)=""
+4 SET LRMY("G.LMI")=""
+5 SET LRMSUB="LR*5.2*559 Post-Install"
+6 SET LRMTEXT="^XTMP(""LR 559 MAILMAN MESSAGE"")"
+7 DO SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
+8 QUIT
