LR538PST ;HPS/DSK - LR*5.2*538 PATCH POST INSTALL ROUTINE ;May 22, 2020@12:00
;;5.2;LAB SERVICE;**538**;Sep 27, 1994;Build 9
;
;External reference to ^XLFDT is supported by DBIA 10103
Q
;
EN ;
;This post-install routine for LR*5.2*538 will clean up orphan entries
;in the ACCESSION (#68) file.
;This routine is not deleted after install since it is tasked. A future
;patch will delete the routine.
;
N LRDUZ
S ZTRTN="START^LR538PST"
S ZTDESC="LR*5.2*538 Post-Install Routine"
S ZTIO="",ZTDTH=$H
S LRDUZ=DUZ
S ZTSAVE("LRDUZ")=""
D ^%ZTLOAD
W !!,"LR*5.2*538 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 LRAREA,LRDATE,LRACN,LRNUM,LRNOWYR,LRHIT,LRTXT,LRYEAR
S ^XTMP("LR 538 POST INSTALL",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*538 POST INSTALL"
S ^XTMP("LR 538 POST INSTALL",1)="Accession Area^Year^Accession^Test IEN^Load List Entry"
;Setting variable for current year in case this patch is not released until 2021
S LRNOWYR=$$NOW^XLFDT(),LRNOWYR=$E(LRNOWYR,1,3)
S LRAREA=0,LRNUM=1
F S LRAREA=$O(^LRO(68,LRAREA)) Q:'LRAREA D
. I $P($G(^LRO(68,LRAREA,0)),"^",3)="Y" D
. . ;Variable LRHIT is used to determine whether the accession area is already set
. . ;into ^TMP("LR538",$J)
. . S (LRHIT,LRDATE)=0
. . S LRTXT=$P($G(^LRO(68,LRAREA,0)),"^")
. . ;There is no need to check the current year since the issue only
. . ;affects accessions for previous years.
. . F S LRDATE=$O(^LRO(68,LRAREA,1,LRDATE)) Q:'LRDATE Q:$E(LRDATE,1,3)=LRNOWYR D
. . . S LRYEAR=$$FMTE^XLFDT(LRDATE)
. . . S LRACN=0
. . . F S LRACN=$O(^LRO(68,LRAREA,1,LRDATE,1,LRACN)) Q:'LRACN D LRTST
D XTMP,MAIL
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
LRTST ;
N LRTST,LRSTR,LRTSTNM
S LRTST=0
F S LRTST=$O(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST)) Q:'LRTST D
. S LRSTR=$G(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0))
. S LRTSTNM=$P($G(^LAB(60,LRTST,0)),"^")
. ;Is the first piece (test number) null (it should never be null)
. ;and the load/list pointer field not null. (If it is null,
. ;the issue addressed by LR*5.2*538 did not occur for test.)
. I $P(LRSTR,"^")="",$P(LRSTR,"^",3)]"" D
. . S LRNUM=LRNUM+1
. . S ^XTMP("LR 538 POST INSTALL",LRNUM)=LRTXT_"^"_LRYEAR_"^"_LRACN_"^"_LRTSTNM_"^"_$P(LRSTR,"^",3)
. . I 'LRHIT S ^TMP("LR538",$J,LRTXT)="",LRHIT=1
. . ;Delete the corrupt node
. . K ^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0)
Q
;
XTMP ;Generate MailMan message and keep in ^XTMP for 60 days
S ^XTMP("LR 538 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*538 POST INSTALL"
I $O(^XTMP("LR 538 POST INSTALL",1))="" D Q
. S ^XTMP("LR 538 MAILMAN MESSAGE",2)=" "
. S ^XTMP("LR 538 MAILMAN MESSAGE",3)="LR*5.2*538 post-install routine found no occurrences"
. S ^XTMP("LR 538 MAILMAN MESSAGE",4)="in the ACCESSION (#68) file related to the issue for"
. S ^XTMP("LR 538 MAILMAN MESSAGE",5)="ServiceNow ticket INC10676331."
. ;Set an entry in the detail ^XTMP("LR 538 POST INSTALL" if needed for future reference
. S ^XTMP("LR 538 POST INSTALL",1)="No issues found."
;
;Issues were found
S ^XTMP("LR 538 MAILMAN MESSAGE",1)=" "
S ^XTMP("LR 538 MAILMAN MESSAGE",2)="The post install for LR*5.2*538 found orphan nodes in the ACCESSION (#68)"
S ^XTMP("LR 538 MAILMAN MESSAGE",3)="file which were set because of the issue for ServiceNow ticket INC10676331."
S ^XTMP("LR 538 MAILMAN MESSAGE",4)=" "
S ^XTMP("LR 538 MAILMAN MESSAGE",5)="The orphan nodes have been deleted."
S ^XTMP("LR 538 MAILMAN MESSAGE",6)=" "
S ^XTMP("LR 538 MAILMAN MESSAGE",7)="The global ^XTMP(""LR 538 POST INSTALL"") contains detailed information"
S ^XTMP("LR 538 MAILMAN MESSAGE",8)="regarding specific accessions and tests which were set as orphan nodes."
S ^XTMP("LR 538 MAILMAN MESSAGE",9)="The global will be deleted in sixty (60) days."
S ^XTMP("LR 538 MAILMAN MESSAGE",10)=" "
S ^XTMP("LR 538 MAILMAN MESSAGE",11)="Accession areas which contained orphan nodes are listed below:"
S ^XTMP("LR 538 MAILMAN MESSAGE",12)=" "
S ^XTMP("LR 538 MAILMAN MESSAGE",13)="Accession Area"
S ^XTMP("LR 538 MAILMAN MESSAGE",14)="==================================="
S LRNUM=14
S LRAREA=""
F S LRAREA=$O(^TMP("LR538",$J,LRAREA)) Q:LRAREA="" D
. S LRNUM=LRNUM+1
. S ^XTMP("LR 538 MAILMAN MESSAGE",LRNUM)=LRAREA
K ^TMP("LR538",$J)
Q
;
MAIL ;
N LRMY,LRMSUB,LRMTEXT,LRMFROM,LRMIN
S LRMIN("FROM")="LR*5.2*538 Post-Install"
S LRMY(LRDUZ)=""
S LRMY("G.LMI")=""
S LRMSUB="LR*5.2*538 Post-Install"
S LRMTEXT="^XTMP(""LR 538 MAILMAN MESSAGE"")"
D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR538PST 4779 printed Sep 23, 2025@19:40:02 Page 2
LR538PST ;HPS/DSK - LR*5.2*538 PATCH POST INSTALL ROUTINE ;May 22, 2020@12:00
+1 ;;5.2;LAB SERVICE;**538**;Sep 27, 1994;Build 9
+2 ;
+3 ;External reference to ^XLFDT is supported by DBIA 10103
+4 QUIT
+5 ;
EN ;
+1 ;This post-install routine for LR*5.2*538 will clean up orphan entries
+2 ;in the ACCESSION (#68) file.
+3 ;This routine is not deleted after install since it is tasked. A future
+4 ;patch will delete the routine.
+5 ;
+6 NEW LRDUZ
+7 SET ZTRTN="START^LR538PST"
+8 SET ZTDESC="LR*5.2*538 Post-Install Routine"
+9 SET ZTIO=""
SET ZTDTH=$HOROLOG
+10 SET LRDUZ=DUZ
+11 SET ZTSAVE("LRDUZ")=""
+12 DO ^%ZTLOAD
+13 WRITE !!,"LR*5.2*538 Post-Install Routine has been tasked - TASK NUMBER: ",$GET(ZTSK)
+14 WRITE !!,"You as well as members of the LMI MailMan Group will receive"
+15 WRITE !,"a MailMan message when the search completes.",!
+16 QUIT
+17 ;
START ;
+1 NEW LRAREA,LRDATE,LRACN,LRNUM,LRNOWYR,LRHIT,LRTXT,LRYEAR
+2 SET ^XTMP("LR 538 POST INSTALL",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*538 POST INSTALL"
+3 SET ^XTMP("LR 538 POST INSTALL",1)="Accession Area^Year^Accession^Test IEN^Load List Entry"
+4 ;Setting variable for current year in case this patch is not released until 2021
+5 SET LRNOWYR=$$NOW^XLFDT()
SET LRNOWYR=$EXTRACT(LRNOWYR,1,3)
+6 SET LRAREA=0
SET LRNUM=1
+7 FOR
SET LRAREA=$ORDER(^LRO(68,LRAREA))
if 'LRAREA
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^LRO(68,LRAREA,0)),"^",3)="Y"
Begin DoDot:2
+9 ;Variable LRHIT is used to determine whether the accession area is already set
+10 ;into ^TMP("LR538",$J)
+11 SET (LRHIT,LRDATE)=0
+12 SET LRTXT=$PIECE($GET(^LRO(68,LRAREA,0)),"^")
+13 ;There is no need to check the current year since the issue only
+14 ;affects accessions for previous years.
+15 FOR
SET LRDATE=$ORDER(^LRO(68,LRAREA,1,LRDATE))
if 'LRDATE
QUIT
if $EXTRACT(LRDATE,1,3)=LRNOWYR
QUIT
Begin DoDot:3
+16 SET LRYEAR=$$FMTE^XLFDT(LRDATE)
+17 SET LRACN=0
+18 FOR
SET LRACN=$ORDER(^LRO(68,LRAREA,1,LRDATE,1,LRACN))
if 'LRACN
QUIT
DO LRTST
End DoDot:3
End DoDot:2
End DoDot:1
+19 DO XTMP
DO MAIL
+20 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+21 QUIT
+22 ;
LRTST ;
+1 NEW LRTST,LRSTR,LRTSTNM
+2 SET LRTST=0
+3 FOR
SET LRTST=$ORDER(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST))
if 'LRTST
QUIT
Begin DoDot:1
+4 SET LRSTR=$GET(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0))
+5 SET LRTSTNM=$PIECE($GET(^LAB(60,LRTST,0)),"^")
+6 ;Is the first piece (test number) null (it should never be null)
+7 ;and the load/list pointer field not null. (If it is null,
+8 ;the issue addressed by LR*5.2*538 did not occur for test.)
+9 IF $PIECE(LRSTR,"^")=""
IF $PIECE(LRSTR,"^",3)]""
Begin DoDot:2
+10 SET LRNUM=LRNUM+1
+11 SET ^XTMP("LR 538 POST INSTALL",LRNUM)=LRTXT_"^"_LRYEAR_"^"_LRACN_"^"_LRTSTNM_"^"_$PIECE(LRSTR,"^",3)
+12 IF 'LRHIT
SET ^TMP("LR538",$JOB,LRTXT)=""
SET LRHIT=1
+13 ;Delete the corrupt node
+14 KILL ^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
XTMP ;Generate MailMan message and keep in ^XTMP for 60 days
+1 SET ^XTMP("LR 538 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*538 POST INSTALL"
+2 IF $ORDER(^XTMP("LR 538 POST INSTALL",1))=""
Begin DoDot:1
+3 SET ^XTMP("LR 538 MAILMAN MESSAGE",2)=" "
+4 SET ^XTMP("LR 538 MAILMAN MESSAGE",3)="LR*5.2*538 post-install routine found no occurrences"
+5 SET ^XTMP("LR 538 MAILMAN MESSAGE",4)="in the ACCESSION (#68) file related to the issue for"
+6 SET ^XTMP("LR 538 MAILMAN MESSAGE",5)="ServiceNow ticket INC10676331."
+7 ;Set an entry in the detail ^XTMP("LR 538 POST INSTALL" if needed for future reference
+8 SET ^XTMP("LR 538 POST INSTALL",1)="No issues found."
End DoDot:1
QUIT
+9 ;
+10 ;Issues were found
+11 SET ^XTMP("LR 538 MAILMAN MESSAGE",1)=" "
+12 SET ^XTMP("LR 538 MAILMAN MESSAGE",2)="The post install for LR*5.2*538 found orphan nodes in the ACCESSION (#68)"
+13 SET ^XTMP("LR 538 MAILMAN MESSAGE",3)="file which were set because of the issue for ServiceNow ticket INC10676331."
+14 SET ^XTMP("LR 538 MAILMAN MESSAGE",4)=" "
+15 SET ^XTMP("LR 538 MAILMAN MESSAGE",5)="The orphan nodes have been deleted."
+16 SET ^XTMP("LR 538 MAILMAN MESSAGE",6)=" "
+17 SET ^XTMP("LR 538 MAILMAN MESSAGE",7)="The global ^XTMP(""LR 538 POST INSTALL"") contains detailed information"
+18 SET ^XTMP("LR 538 MAILMAN MESSAGE",8)="regarding specific accessions and tests which were set as orphan nodes."
+19 SET ^XTMP("LR 538 MAILMAN MESSAGE",9)="The global will be deleted in sixty (60) days."
+20 SET ^XTMP("LR 538 MAILMAN MESSAGE",10)=" "
+21 SET ^XTMP("LR 538 MAILMAN MESSAGE",11)="Accession areas which contained orphan nodes are listed below:"
+22 SET ^XTMP("LR 538 MAILMAN MESSAGE",12)=" "
+23 SET ^XTMP("LR 538 MAILMAN MESSAGE",13)="Accession Area"
+24 SET ^XTMP("LR 538 MAILMAN MESSAGE",14)="==================================="
+25 SET LRNUM=14
+26 SET LRAREA=""
+27 FOR
SET LRAREA=$ORDER(^TMP("LR538",$JOB,LRAREA))
if LRAREA=""
QUIT
Begin DoDot:1
+28 SET LRNUM=LRNUM+1
+29 SET ^XTMP("LR 538 MAILMAN MESSAGE",LRNUM)=LRAREA
End DoDot:1
+30 KILL ^TMP("LR538",$JOB)
+31 QUIT
+32 ;
MAIL ;
+1 NEW LRMY,LRMSUB,LRMTEXT,LRMFROM,LRMIN
+2 SET LRMIN("FROM")="LR*5.2*538 Post-Install"
+3 SET LRMY(LRDUZ)=""
+4 SET LRMY("G.LMI")=""
+5 SET LRMSUB="LR*5.2*538 Post-Install"
+6 SET LRMTEXT="^XTMP(""LR 538 MAILMAN MESSAGE"")"
+7 DO SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
+8 QUIT
