TIU285PS ; SLC/DJH - Patch 285 post-install routine ; 5/21/14 1:47pm
;;1.0;TEXT INTEGRATION UTILITIES;**285**;Jun 20, 1997;Build 5
;;Per VA Directive 6402, this routine should not be modified.
Q
EN ; reindex the "AC" index on file 8925.7
;
N TIUD0,NAMSP,TIUDOC
S NAMSP=$$NAMSP
I $P($G(^XTMP(NAMSP,0,"STATUS")),U)="COMPLETED" Q
K ^TIU(8925.7,"AC")
;
S TIUD0=0
F S TIUD0=$O(^TIU(8925.7,TIUD0)) Q:'TIUD0 D
. S TIUDOC=+$G(^TIU(8925.7,TIUD0,0))
. I 'TIUDOC!'+$G(^TIU(8925,TIUDOC,0)) Q ; skip if no tiu doc ptr or record
. I $P($G(^TIU(8925.7,TIUD0,0)),U,4) Q ; skip if signed
. S ^TIU(8925.7,"AC",$P($G(^TIU(8925,TIUDOC,12)),U),$G(TIUDOC),TIUD0)=""
S $P(^XTMP(NAMSP,0,"STATUS"),U)="COMPLETED" ; Set Completed status
S $P(^XTMP(NAMSP,0,"STATUS"),U,3)=$$NOW^XLFDT ; Set completed date/time
D MAIL
Q
;
MAIL ;
N CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT,I,NMSP,VAR
S CNT=1,XMY(DUZ)="",XMY("G.TIU CACS")=""
S XMSUB="INDEX REBUILD POST INSTALL",XMTEXT="MSG(",XMDUZ="Patch TIU*1.0*285"
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="Patch TIU*1.0*285 post install routine has completed",CNT=CNT+1
S MSG(CNT)="",CNT=CNT+1
S MSG(CNT)="For more information about the related issue, review patch TIU*1*285",CNT=CNT+1
S MSG(CNT)=""
D ^XMD
Q
;
QUE ; Entry point from KIDS Install
N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSAVE,BEGDT,PURGDT
S NAMSP=$$NAMSP ;TIU285PS
S JOBN="TIU FIX REPORT INDEX",PATCH="TIU*1.0*285"
;
I $D(^XTMP(NAMSP)) D Q
. D BMES^XPDUTL("=============================================================")
. D MES^XPDUTL("Cannot queue background job!")
. D MES^XPDUTL("This job was previously run on "_$$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"STATUS")),"^",2)))
. D MES^XPDUTL("to run it again, ^XTMP('"_NAMSP_"') must be deleted.")
. D MES^XPDUTL("=============================================================")
;
; INITIALIZE ^XTMP
S BEGDT=$$NOW^XLFDT,PURGDT=$$FMADD^XLFDT(BEGDT,90) ;90 day life
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_PATCH
S ^XTMP(NAMSP,0,"STATUS")="RUN^"_$$NOW^XLFDT_"^^^"
;
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT($H))
D MES^XPDUTL("A Mailman message will be sent when it finishes")
D MES^XPDUTL("==============================================================")
;
S ZTRTN="EN^"_NAMSP,ZTIO=""
S ZTDESC="Background job "_JOBN_" updated via "_PATCH,ZTSAVE("JOBN")=""
S ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT) ; start time now
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
;
NAMSP() ;
Q $T(+0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU285PS 2743 printed Apr 09, 2024@21:48:44 Page 2
TIU285PS ; SLC/DJH - Patch 285 post-install routine ; 5/21/14 1:47pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**285**;Jun 20, 1997;Build 5
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
EN ; reindex the "AC" index on file 8925.7
+1 ;
+2 NEW TIUD0,NAMSP,TIUDOC
+3 SET NAMSP=$$NAMSP
+4 IF $PIECE($GET(^XTMP(NAMSP,0,"STATUS")),U)="COMPLETED"
QUIT
+5 KILL ^TIU(8925.7,"AC")
+6 ;
+7 SET TIUD0=0
+8 FOR
SET TIUD0=$ORDER(^TIU(8925.7,TIUD0))
if 'TIUD0
QUIT
Begin DoDot:1
+9 SET TIUDOC=+$GET(^TIU(8925.7,TIUD0,0))
+10 ; skip if no tiu doc ptr or record
IF 'TIUDOC!'+$GET(^TIU(8925,TIUDOC,0))
QUIT
+11 ; skip if signed
IF $PIECE($GET(^TIU(8925.7,TIUD0,0)),U,4)
QUIT
+12 SET ^TIU(8925.7,"AC",$PIECE($GET(^TIU(8925,TIUDOC,12)),U),$GET(TIUDOC),TIUD0)=""
End DoDot:1
+13 ; Set Completed status
SET $PIECE(^XTMP(NAMSP,0,"STATUS"),U)="COMPLETED"
+14 ; Set completed date/time
SET $PIECE(^XTMP(NAMSP,0,"STATUS"),U,3)=$$NOW^XLFDT
+15 DO MAIL
+16 QUIT
+17 ;
MAIL ;
+1 NEW CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT,I,NMSP,VAR
+2 SET CNT=1
SET XMY(DUZ)=""
SET XMY("G.TIU CACS")=""
+3 SET XMSUB="INDEX REBUILD POST INSTALL"
SET XMTEXT="MSG("
SET XMDUZ="Patch TIU*1.0*285"
+4 SET MSG(CNT)=""
SET CNT=CNT+1
+5 SET MSG(CNT)="Patch TIU*1.0*285 post install routine has completed"
SET CNT=CNT+1
+6 SET MSG(CNT)=""
SET CNT=CNT+1
+7 SET MSG(CNT)="For more information about the related issue, review patch TIU*1*285"
SET CNT=CNT+1
+8 SET MSG(CNT)=""
+9 DO ^XMD
+10 QUIT
+11 ;
QUE ; Entry point from KIDS Install
+1 NEW NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSAVE,BEGDT,PURGDT
+2 ;TIU285PS
SET NAMSP=$$NAMSP
+3 SET JOBN="TIU FIX REPORT INDEX"
SET PATCH="TIU*1.0*285"
+4 ;
+5 IF $DATA(^XTMP(NAMSP))
Begin DoDot:1
+6 DO BMES^XPDUTL("=============================================================")
+7 DO MES^XPDUTL("Cannot queue background job!")
+8 DO MES^XPDUTL("This job was previously run on "_$$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"STATUS")),"^",2)))
+9 DO MES^XPDUTL("to run it again, ^XTMP('"_NAMSP_"') must be deleted.")
+10 DO MES^XPDUTL("=============================================================")
End DoDot:1
QUIT
+11 ;
+12 ; INITIALIZE ^XTMP
+13 ;90 day life
SET BEGDT=$$NOW^XLFDT
SET PURGDT=$$FMADD^XLFDT(BEGDT,90)
+14 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_PATCH
+15 SET ^XTMP(NAMSP,0,"STATUS")="RUN^"_$$NOW^XLFDT_"^^^"
+16 ;
+17 DO BMES^XPDUTL("=============================================================")
+18 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+19 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT($HOROLOG))
+20 DO MES^XPDUTL("A Mailman message will be sent when it finishes")
+21 DO MES^XPDUTL("==============================================================")
+22 ;
+23 SET ZTRTN="EN^"_NAMSP
SET ZTIO=""
+24 SET ZTDESC="Background job "_JOBN_" updated via "_PATCH
SET ZTSAVE("JOBN")=""
+25 ; start time now
SET ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT)
+26 DO ^%ZTLOAD
+27 if $DATA(ZTSK)
Begin DoDot:1
+28 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+29 DO BMES^XPDUTL("")
End DoDot:1
+30 DO BMES^XPDUTL("")
+31 KILL XPDQUES
+32 QUIT
+33 ;
NAMSP() ;
+1 QUIT $TEXT(+0)
