Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR538PST

LR538PST.m

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