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

XU8P662.m

Go to the documentation of this file. 
  1. XU8P662 ;SLC/JAS - Post Install for 662 ;July 21, 2022@12:08:00
  1.  ;;8.0;KERNEL;**662**;Jul 10, 1995;Build 49
  1.  ;Per VHA Directive 2004-038, this routine should not be modified
  1.  ;
  1.  ; DBIA 10112  $$SITE^VASITE
  1.  ; DBIA 10060  ^VA(200,"B"
  1.  ;
  1. ENV ; ensure that user understands what is about to happen with creation
  1.  ; of New Style cross reference.
  1.  Q  ;Decided not to use the environment check
  1.  N DIR,DIRUT,DTOUT,DUOUT,Y
  1.  S XPDABORT=""
  1.  W !!,$C(7),"****** Creation of New Style 'PAR' Cross Reference ******",!
  1.  W !,"This will loop through the RECIPIENT Multiple of the entire ALERT"
  1.  W !,"TRACKING File (#8992.1) and create the 'PAR' New Style Cross"
  1.  W !,"Reference based on the PROCESSED ALERT & RECIPIENT sub-fields.",!
  1.  W !,"WARNING: Once you agree to create this, you should let it run until"
  1.  W !,"it has finished completely !!",!
  1.  S DIR("A")="Are you sure you want to do this"
  1.  S DIR("A",1)="You are about to create the index which could take quite awhile."
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y'=1) W !!,"Ok, I am stopping the install." S XPDABORT=1 Q
  1.  E  W !,"Ok, let's continue!",!
  1.  I XPDABORT="" K XPDABORT
  1.  Q
  1.  ;
  1. POST ; Post-Install for XU*8.0*662
  1.  ; This will assist with PAR cross reference creation along with
  1.  ; Creation of new PAR Indices
  1.  N XUMSG
  1.  S XUMSG(1)="This patch will create a new New Style cross reference"
  1.  S XUMSG(2)="called 'PAR' which will be at the ALERT TRACKING file level"
  1.  S XUMSG(3)="but on PROCESSED ALERT & RECIPIENT sub-fields of the"
  1.  S XUMSG(4)="RECIPIENT Multiple."
  1.  S XUMSG(5)=" "
  1.  S XUMSG(6)="Creation of 'PAR' will now go forward in the"
  1.  S XUMSG(7)="Background."
  1.  S XUMSG(8)=" "
  1.  S XUMSG(9)="You will be given a TaskMan task # to check on or,"
  1.  S XUMSG(10)="alternately, you can check your mail on MailMan for a"
  1.  S XUMSG(11)="message expressing Completion of this Task with"
  1.  S XUMSG(12)="appropriate details."
  1.  S XUMSG(13)=" "
  1.  S XUMSG(14)="Note Install of this Patch cannot be considered"
  1.  S XUMSG(15)="Complete unless and until this Task is Completed."
  1.  S XUMSG(16)=" "
  1.  D BMES^XPDUTL(.XUMSG)
  1.  I $D(^XTMP("XU8P662","START")) D
  1.  . D MES^XPDUTL("Task to Create 'PAR' Already Begun "_$$HTE^XLFDT(^XTMP("XU8P662","START"))_".")
  1.  . D MES^XPDUTL("")
  1.  I $D(^XTMP("XU8P662","FINISH")) D  Q
  1.  . D MES^XPDUTL("...and Completed "_$$HTE^XLFDT(^XTMP("XU8P662","FINISH"))_".")
  1.  . D MES^XPDUTL("")
  1.  Q:$D(^XTMP("XU8P662"))
  1.  S ZTRTN="SETXREF^XU8P662",ZTIO="",ZTDTH=$H
  1.  S ZTDESC="Creation of New Style X-Ref 'PAR' in ALERT TRACKING file" D ^%ZTLOAD
  1.  I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
  1.  E  D MES^XPDUTL("***** UNABLE TO QUEUE CREATION OF 'PAR' ALERT TRACKING FILE X-REF *****")
  1.  K ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK
  1.  Q
  1.  ;
  1. RERUN ; if post install didn't complete this tag will allow manual rerun
  1.  K ^XTMP("XU8P662"),^XTMP("XU8P662ERR")
  1.  D POST
  1.  Q
  1.  ;
  1. SETXREF ; Set new PAR New Style cross reference for old data
  1.  N DA,DIK,ORIEN,XTMPCNT,XTMPMSG,ZTREQ,XUIEN,ERRDD
  1.  ; mwa defensive coding added to protect against bug where ^DD(8992.11,"IX",.01) goes missing after many records are already processed
  1.  H 60 ; just in case something with the install is causing a set/killwait 60 seconds to start the processing
  1.  S (ERRDD,ERRDD("HANGS"))=0
  1.  K ^XTMP("XU8P662")
  1.  S ^XTMP("XU8P662",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)
  1.  S ^XTMP("XU8P662","START")=$H
  1.  S XTMPCNT=1
  1.  S XTMPMSG="Creation of 'PAR' X-Ref for ALERT TRACKING file Started "
  1.  S XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("XU8P662","START"))_"."
  1.  S ^XTMP("XU8P662",XTMPCNT)=XTMPMSG
  1.  S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)=" "
  1.  K ^XTV(8992.1,"PAR")
  1.  S XUIEN=0
  1.  F  S XUIEN=$O(^XTV(8992.1,XUIEN)) Q:'XUIEN  D
  1.  . ; mwa ^DD(8992.11,"IX",.01) is required for D ENALL^DIK (if not present error occurs)
  1.  . ; the hope is that it is temporary (during a set/kill...etc), so just hang the task and try again
  1.  . ; If too many records get passed due to attempted hangs...just record the number of errors for mailman and stop hanging
  1.  . I '$D(^DD(8992.11,"IX",.01)) Q:ERRDD("HANGS")>5  H 30 S ERRDD("HANGS")=ERRDD("HANGS")+1
  1.  . I '$D(^DD(8992.11,"IX",.01)) S ERRDD=ERRDD+1 Q
  1.  . S DIK="^XTV(8992.1,"_XUIEN_",20,",DIK(1)=".01^PAR",DA(1)=XUIEN D ENALL^DIK
  1.  S XTMPMSG="Creation of 'PAR' X-Ref Completed"
  1.  I ERRDD>0 S XTMPMSG=XTMPMSG_" With Errors"
  1.  S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)=XTMPMSG
  1.  S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)=" "
  1.  S ^XTMP("XU8P662","FINISH")=$H
  1.  S XTMPMSG="Background Task Finished "
  1.  S XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("XU8P662","FINISH"))_"."
  1.  S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)=XTMPMSG
  1.  I ERRDD>0 D
  1.  . S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)=""
  1.  . S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)="The CPRS Development team has already been contacted to assist with the errors"
  1.  . S XTMPCNT=XTMPCNT+1,^XTMP("XU8P662",XTMPCNT)="You will be contacted to as soon as possible by a CPRS Developer"
  1.  ;
  1.  D:ERRDD ERRMSG
  1.  ; Send Mail to installer to notify of completion
  1.  S XMSUB="XU*8.0*662 post install has run to completion."
  1.  S XMDUZ="Patch XU*8.0*662"
  1.  S XTMPCNT=0
  1. XRFLOOP S XTMPCNT=$O(^XTMP("XU8P662",XTMPCNT)) G:XTMPCNT'?1N.N FIN
  1.  S ^TMP($J,"XU8P662",XTMPCNT,0)=^XTMP("XU8P662",XTMPCNT)
  1.  G XRFLOOP
  1.  ;
  1. FIN S XMTEXT="^TMP($J,""XU8P662"","
  1.  S XMY(DUZ)="" D ^XMD K ^TMP($J,"XU8P662") S ZTREQ="@"
  1.  K XMDUZ,XMSUB,XMTEXT,XMY
  1.  Q
  1.  ;
  1. ERRMSG ;
  1.  ; Send Mail to CPRS Dev Team to notify of errors...need to rerun
  1.  N SITE S SITE=$P($$SITE^VASITE,U,2)
  1.  S XMTEXT="^XTMP($J,""XU8P662ERR"","
  1.  S ^XTMP($J,"XU8P662ERR",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)
  1.  S ^XTMP($J,"XU8P662ERR",1)=ERRDD_" ^DD(8992.11,""IX"",.01) error(s) occurred while installing XU*8.0*662"
  1.  S ^XTMP($J,"XU8P662ERR",2)="Site: "_SITE_" Installer: "_$G(^VA(200,"B",DUZ))
  1.  S ^XTMP($J,"XU8P662ERR",3)="Verify that Data Dictionary is correct...then instruct site to rerun this post install routine using ""D RERUN^XU8P662"" at the programmer prompt"
  1.  S XMSUB="XU*8.0*662 Error reported at "_SITE
  1.  S XMDUZ="Patch XU*8.0*662"
  1.  S XMY("AUGUSTINIAK.MARK@DOMAIN.EXT")=""
  1.  S XMY("PHELPS.TY@DOMAIN.EXT")=""
  1.  S XMY("CRUMLEY.JAMIE@DOMAIN.EXT")=""
  1.  S XMY("LEVI.TEITELBAUM@DOMAIN.EXT")=""
  1.  S XMY("THOMPSON.WILLIAM_ANTHONY@DOMAIN.EXT")=""
  1.  D ^XMD K ^TMP($J,"XU8P662ERR") S ZTREQ="@"
  1.  K XMDUZ,XMSUB,XMTEXT,XMY
  1.  Q
  1.  ;