PSB3P68 ;BIRMINGHAM/GN - POST INSTALL FOR PSB3P68 ;2/23/12 4:38pm
;;3.0;BAR CODE MED ADMIN;**68**;Mar 2004;Build 26
;
; Init XPAR parameters DIV & SYS for PSB INJECTION SITE MAX HOURS
; and submit a background job to build two indexes AINJ & AINJOI
; for file 53.79.
;
; Direct Programmer mode callable Tag's in this routine:
; STATUS - shows user the current status of the background job
; QUEUE - allows user to manuall restart a previous Stopped or
; Errored job and it will resume with where it left off.
;
BEGIN ;
N ENT,DV,T5,T10,T20,NAM,VAL
S T5="",$P(T5," ",5)=" ",T10="",$P(T10," ",10)=" ",T20="",$P(T20," ",20)=" "
S NAM="PSB INJECTION SITE MAX HOURS",VAL=72
D INITSYS(NAM,VAL)
D MES^XPDUTL("")
D MES^XPDUTL("*** PSB*3*68 Post Install Running ***")
D MES^XPDUTL("")
D MES^XPDUTL(" Initialize BCMA parameter PSB INJECTION SITE MAX HOURS...")
D MES^XPDUTL("")
D MES^XPDUTL(" DIV"_T20_T10_"MAX HRS")
D MES^XPDUTL("")
D INITDIV(NAM,VAL,0) ;before update
D INITDIV(NAM,VAL,1) ;after update
D MES^XPDUTL("")
H 2
;
QUEUE ;begin of queueing to background to run xref builder
N DA,DIK,ENDTIME,QUIT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE
;
; setup variables and submit Cross Ref builder to Taskman
S ZTRTN=("JOB^PSB3P68")
S ZTDESC="BCMA Injection Site Cross Ref Builder"
S ZTDTH=$$NOW^XLFDT,ZTIO=""
;check if already running or completed.
I $$CHKSTAT L -^XTMP($$NAMSPC) Q
L -^XTMP($$NAMSPC)
D ^%ZTLOAD
S ZTDESC="BCMA Injection Site Cross Ref Builder"
D MES^XPDUTL(""),MES^XPDUTL(" "_ZTDESC)
I $G(ZTSK) D
. D MES^XPDUTL(""),MES^XPDUTL(" This request queued as Task # "_ZTSK)
. D MES^XPDUTL(""),MES^XPDUTL(" A Mailman message will be sent to you when the Cross Reference Builder")
. D MES^XPDUTL(" completes.")
. D MES^XPDUTL("")
Q
;
JOB ; Entry point for taskman
L +^XTMP($$NAMSPC):10 I '$T D Q ;quit if can't get a lock
. S ^XTMP($$NAMSPC,0,"STATUS")="NO LOCK GAINED"_U_$$NOW^XLFDT
. S ^TMP($$NAMSPC,$J,"MSG",1)=""
. S ^TMP($$NAMSPC,$J,"MSG",2)=" Builder did not run, could not lock file."
. D MAIL(ZTDESC)
;
N PCT,RECS,TLRECS,IEN,ZTSTOP,NAMSPC,BEGTIME,PURGDT,STAT
S NAMSPC=$$NAMSPC
S ZTDESC=$G(ZTDESC,"PSB3P68")
S ^XTMP(NAMSPC,0,"RECS TOTL")=$P($G(^PSB(53.79,0)),U,4)
;
;setup XTMP according to stds.
S BEGTIME=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGTIME,30)
S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME_U_ZTDESC
S ^XTMP(NAMSPC,0,"TASKID")=$G(ZTSK,"DIRECT")
S:'$D(^XTMP(NAMSPC,0,"INITIAL TIME")) ^XTMP(NAMSPC,0,"INITIAL TIME")=$$NOW^XLFDT
;get last run data
D GETLAST
I STAT]"",STAT'["COMPLETED" D
. S ^TMP($$NAMSPC,$J,"MSG",1)=""
. S ^TMP($$NAMSPC,$J,"MSG",2)=" Cross Reference Builder Resuming with IEN "_IEN
. S PCT=100-((RECS/TLRECS)*100\1)
. S ^TMP($$NAMSPC,$J,"MSG",3)=" Job has "_PCT_"% remaining to complete."
. D MAIL(ZTDESC)
. S ^XTMP(NAMSPC,0,"RESTART")="RESTARTED: "_$$NOW^XLFDT
;
;init begin time, if not there, and status & stop time fields
S ^XTMP(NAMSPC,0,"STATUS")="RUNNING since"_U_$$NOW^XLFDT
S ^XTMP(NAMSPC,0,"RECS TOTL")=TLRECS
;
;start/restart cleanups
S ZTSTOP=0
F S IEN=$O(^PSB(53.79,IEN),-1) Q:'IEN D Q:ZTSTOP
. S DIK="^PSB(53.79,",DIK(1)=".01^AINJ^AINJOI"
. S DA=IEN D EN1^DIK
. S RECS=RECS+1
. ;update and check for stop request after every 2000 processed recs
. I RECS#2000=0 D
. . S:$$S^%ZTLOAD ZTSTOP=1 ;Systems person asked to stop
. . S ^XTMP(NAMSPC,0,"RECS DONE")=RECS
. . S ^XTMP(NAMSPC,0,"LAST IEN")=IEN
S ^XTMP(NAMSPC,0,"RECS DONE")=RECS
S ^XTMP(NAMSPC,0,"LAST IEN")=IEN
;
;set proper Exit status
I ZTSTOP D
. S ^XTMP(NAMSPC,0,"STATUS")="STOPPED"_U_$$NOW^XLFDT
E D
. S ^XTMP(NAMSPC,0,"STATUS")="COMPLETED"_U_$$NOW^XLFDT
;
N LIN
S LIN=0
K ^TMP(NAMSPC,$J)
;get last run data
D GETLAST
;build mailman text for message
S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=ZTDESC_" Status: "_STAT_" "_$$FMTE^XLFDT(ENDTIME)
S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=""
S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Total Records in file:",30)_$J($FN(TLRECS,","),15)
S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Records processed:",30)_$J($FN(RECS,","),15)
I STAT'["COMPLETED" D
. S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=""
. S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Reading file backwards",29)
. S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Last IEN processed:",30)_$J(IEN,15)
. S PCT=(RECS/TLRECS)*100\1
I STAT["COMPLETED" D
. S PCT=100
. S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Total elapsed time:",30)_$J($$FMDIFF^XLFDT(ENDTIME,BEGTIME,3),15)
S LIN=LIN+1,^TMP(NAMSPC,$J,"MSG",LIN)=$J("Percent complete:",30)_$J(PCT,14)_"%"
;send the message
D MAIL(ZTDESC)
L -^XTMP(NAMSPC)
K ^TMP(NAMSPC,$J)
Q
;
GETLAST ;get last run info
S IEN=+$G(^XTMP(NAMSPC,0,"LAST IEN")) ;last ien
S:IEN=0 IEN=999999999
S STAT=$P($G(^XTMP(NAMSPC,0,"STATUS")),U) ;status
S RECS=+$G(^XTMP(NAMSPC,0,"RECS DONE")) ;recs processed
S TLRECS=+$G(^XTMP(NAMSPC,0,"RECS TOTL")) ;tot recs in file
S BEGTIME=$G(^XTMP(NAMSPC,0,"INITIAL TIME")) ;initial begin time
S ENDTIME=$P($G(^XTMP(NAMSPC,0,"STATUS")),U,2) ;end time
Q
;
INITSYS(NAM,VAL) ; Init the SYSTEM value
; Input: NAM = param name
; VAL = num of hours
;
D EN^XPAR("SYS",NAM,1,VAL)
Q
;
INITDIV(NAM,VAL,UPD) ; Init DIVISION value
; Input: NAM = param name
; VAL = num of hours
; UPD = 1 to update, else list curr values only
;
N FOUND S FOUND=0
D:'UPD MES^XPDUTL(" Before update")
D:UPD MES^XPDUTL(" After update")
D MES^XPDUTL("")
;loop thru all medical divisions and only update those that use BCMA
F DV=0:0 S DV=$O(^DG(40.8,"AD",DV)) Q:'DV D
. S ENT=DV_";DIC(4,"
. Q:'$$GET^XPAR(ENT,"PSB ONLINE")
. S FOUND=1
. I UPD,+$$GET^XPAR(ENT,NAM,,"E")=0 D EN^XPAR(ENT,NAM,1,VAL)
. D MES^XPDUTL(" "_$E($P(^DIC(4,+ENT,0),U)_T20,1,25)_T10_$$GET^XPAR(ENT,NAM,,"E"))
D:'FOUND MES^XPDUTL(T5_"** NO DIVISIONS FOUND WITH BCMA ONLINE **")
D:'FOUND MES^XPDUTL(" ** NO DIVISIONS FOUND WITH BCMA ONLINE **")
D MES^XPDUTL("")
Q
;
MAIL(HTEXT) ; send the mail message
N XMY,XMDUZ,XMSUB,XMTEXT
S XMY(DUZ)="",XMDUZ="PSB3P68 Post Install"
S XMSUB=HTEXT_" Results"
S XMTEXT="^TMP("""_$$NAMSPC_""",$J,""MSG"","
D ^XMD
K ^TMP($$NAMSPC)
Q
;
CHKSTAT() ;check if job is running
N Y,DUOUT,DTOUT,QUIT
S NAMSPC=$$NAMSPC
S STAT=$G(^XTMP(NAMSPC,0,"STATUS"))
S QUIT=0
L +^XTMP(NAMSPC):3
I '$T D H 2 Q 1
. D MES^XPDUTL("*** WARNING ***"),MES^XPDUTL("")
. D MES^XPDUTL(NAMSPC_" Cross Reference Builder is already RUNNING ")
. D MES^XPDUTL(" from a previous install and can't be run now.")
. D MES^XPDUTL("")
I STAT["COMPLETED" D H 2 Q 1
. D MES^XPDUTL("*** WARNING ***"),MES^XPDUTL("")
. D MES^XPDUTL(NAMSPC_" Cross Reference Builder was "_STAT)
. D MES^XPDUTL(" by a previous install and can't run again.")
. D MES^XPDUTL("")
Q QUIT
;
STATUS ;Display status of this job
;check lock status
N STAT,TIME,JOB,RECS,TLRESC,PCT,RUNNING
L +^XTMP($$NAMSPC):3
I '$T S RUNNING=1
E S RUNNING=0
L -^XTMP($$NAMSPC)
S STAT=$P(^XTMP($$NAMSPC,0,"STATUS"),U)
S TIME=$P(^XTMP($$NAMSPC,0,"STATUS"),U,2)
S JOB=$P(^XTMP($$NAMSPC,0),U,3)
S RECS=+^XTMP($$NAMSPC,0,"RECS DONE")
S TLRECS=+^XTMP($$NAMSPC,0,"RECS TOTL")
S PCT=(RECS/TLRECS)*100\1
I 'RUNNING,STAT["RUNNING" D Q
. W !!,JOB,!,"Has errored and quit abruptly. Please restart Post Install",!
. W !," at Programmers prompt '>' type 'D QUEUE^PSB3P68' and press Enter.",!!
W !!,JOB,!,"Status: ",STAT," ",$$FMTE^XLFDT(TIME)
W !,PCT,"% complete",!!
Q
;
NAMSPC() ;
Q "PSB3P68"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSB3P68 7727 printed Dec 13, 2024@01:39:52 Page 2
PSB3P68 ;BIRMINGHAM/GN - POST INSTALL FOR PSB3P68 ;2/23/12 4:38pm
+1 ;;3.0;BAR CODE MED ADMIN;**68**;Mar 2004;Build 26
+2 ;
+3 ; Init XPAR parameters DIV & SYS for PSB INJECTION SITE MAX HOURS
+4 ; and submit a background job to build two indexes AINJ & AINJOI
+5 ; for file 53.79.
+6 ;
+7 ; Direct Programmer mode callable Tag's in this routine:
+8 ; STATUS - shows user the current status of the background job
+9 ; QUEUE - allows user to manuall restart a previous Stopped or
+10 ; Errored job and it will resume with where it left off.
+11 ;
BEGIN ;
+1 NEW ENT,DV,T5,T10,T20,NAM,VAL
+2 SET T5=""
SET $PIECE(T5," ",5)=" "
SET T10=""
SET $PIECE(T10," ",10)=" "
SET T20=""
SET $PIECE(T20," ",20)=" "
+3 SET NAM="PSB INJECTION SITE MAX HOURS"
SET VAL=72
+4 DO INITSYS(NAM,VAL)
+5 DO MES^XPDUTL("")
+6 DO MES^XPDUTL("*** PSB*3*68 Post Install Running ***")
+7 DO MES^XPDUTL("")
+8 DO MES^XPDUTL(" Initialize BCMA parameter PSB INJECTION SITE MAX HOURS...")
+9 DO MES^XPDUTL("")
+10 DO MES^XPDUTL(" DIV"_T20_T10_"MAX HRS")
+11 DO MES^XPDUTL("")
+12 ;before update
DO INITDIV(NAM,VAL,0)
+13 ;after update
DO INITDIV(NAM,VAL,1)
+14 DO MES^XPDUTL("")
+15 HANG 2
+16 ;
QUEUE ;begin of queueing to background to run xref builder
+1 NEW DA,DIK,ENDTIME,QUIT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE
+2 ;
+3 ; setup variables and submit Cross Ref builder to Taskman
+4 SET ZTRTN=("JOB^PSB3P68")
+5 SET ZTDESC="BCMA Injection Site Cross Ref Builder"
+6 SET ZTDTH=$$NOW^XLFDT
SET ZTIO=""
+7 ;check if already running or completed.
+8 IF $$CHKSTAT
LOCK -^XTMP($$NAMSPC)
QUIT
+9 LOCK -^XTMP($$NAMSPC)
+10 DO ^%ZTLOAD
+11 SET ZTDESC="BCMA Injection Site Cross Ref Builder"
+12 DO MES^XPDUTL("")
DO MES^XPDUTL(" "_ZTDESC)
+13 IF $GET(ZTSK)
Begin DoDot:1
+14 DO MES^XPDUTL("")
DO MES^XPDUTL(" This request queued as Task # "_ZTSK)
+15 DO MES^XPDUTL("")
DO MES^XPDUTL(" A Mailman message will be sent to you when the Cross Reference Builder")
+16 DO MES^XPDUTL(" completes.")
+17 DO MES^XPDUTL("")
End DoDot:1
+18 QUIT
+19 ;
JOB ; Entry point for taskman
+1 ;quit if can't get a lock
LOCK +^XTMP($$NAMSPC):10
IF '$TEST
Begin DoDot:1
+2 SET ^XTMP($$NAMSPC,0,"STATUS")="NO LOCK GAINED"_U_$$NOW^XLFDT
+3 SET ^TMP($$NAMSPC,$JOB,"MSG",1)=""
+4 SET ^TMP($$NAMSPC,$JOB,"MSG",2)=" Builder did not run, could not lock file."
+5 DO MAIL(ZTDESC)
End DoDot:1
QUIT
+6 ;
+7 NEW PCT,RECS,TLRECS,IEN,ZTSTOP,NAMSPC,BEGTIME,PURGDT,STAT
+8 SET NAMSPC=$$NAMSPC
+9 SET ZTDESC=$GET(ZTDESC,"PSB3P68")
+10 SET ^XTMP(NAMSPC,0,"RECS TOTL")=$PIECE($GET(^PSB(53.79,0)),U,4)
+11 ;
+12 ;setup XTMP according to stds.
+13 SET BEGTIME=$$NOW^XLFDT()
+14 SET PURGDT=$$FMADD^XLFDT(BEGTIME,30)
+15 SET ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME_U_ZTDESC
+16 SET ^XTMP(NAMSPC,0,"TASKID")=$GET(ZTSK,"DIRECT")
+17 if '$DATA(^XTMP(NAMSPC,0,"INITIAL TIME"))
SET ^XTMP(NAMSPC,0,"INITIAL TIME")=$$NOW^XLFDT
+18 ;get last run data
+19 DO GETLAST
+20 IF STAT]""
IF STAT'["COMPLETED"
Begin DoDot:1
+21 SET ^TMP($$NAMSPC,$JOB,"MSG",1)=""
+22 SET ^TMP($$NAMSPC,$JOB,"MSG",2)=" Cross Reference Builder Resuming with IEN "_IEN
+23 SET PCT=100-((RECS/TLRECS)*100\1)
+24 SET ^TMP($$NAMSPC,$JOB,"MSG",3)=" Job has "_PCT_"% remaining to complete."
+25 DO MAIL(ZTDESC)
+26 SET ^XTMP(NAMSPC,0,"RESTART")="RESTARTED: "_$$NOW^XLFDT
End DoDot:1
+27 ;
+28 ;init begin time, if not there, and status & stop time fields
+29 SET ^XTMP(NAMSPC,0,"STATUS")="RUNNING since"_U_$$NOW^XLFDT
+30 SET ^XTMP(NAMSPC,0,"RECS TOTL")=TLRECS
+31 ;
+32 ;start/restart cleanups
+33 SET ZTSTOP=0
+34 FOR
SET IEN=$ORDER(^PSB(53.79,IEN),-1)
if 'IEN
QUIT
Begin DoDot:1
+35 SET DIK="^PSB(53.79,"
SET DIK(1)=".01^AINJ^AINJOI"
+36 SET DA=IEN
DO EN1^DIK
+37 SET RECS=RECS+1
+38 ;update and check for stop request after every 2000 processed recs
+39 IF RECS#2000=0
Begin DoDot:2
+40 ;Systems person asked to stop
if $$S^%ZTLOAD
SET ZTSTOP=1
+41 SET ^XTMP(NAMSPC,0,"RECS DONE")=RECS
+42 SET ^XTMP(NAMSPC,0,"LAST IEN")=IEN
End DoDot:2
End DoDot:1
if ZTSTOP
QUIT
+43 SET ^XTMP(NAMSPC,0,"RECS DONE")=RECS
+44 SET ^XTMP(NAMSPC,0,"LAST IEN")=IEN
+45 ;
+46 ;set proper Exit status
+47 IF ZTSTOP
Begin DoDot:1
+48 SET ^XTMP(NAMSPC,0,"STATUS")="STOPPED"_U_$$NOW^XLFDT
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 SET ^XTMP(NAMSPC,0,"STATUS")="COMPLETED"_U_$$NOW^XLFDT
End DoDot:1
+51 ;
+52 NEW LIN
+53 SET LIN=0
+54 KILL ^TMP(NAMSPC,$JOB)
+55 ;get last run data
+56 DO GETLAST
+57 ;build mailman text for message
+58 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=ZTDESC_" Status: "_STAT_" "_$$FMTE^XLFDT(ENDTIME)
+59 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=""
+60 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Total Records in file:",30)_$JUSTIFY($FNUMBER(TLRECS,","),15)
+61 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Records processed:",30)_$JUSTIFY($FNUMBER(RECS,","),15)
+62 IF STAT'["COMPLETED"
Begin DoDot:1
+63 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=""
+64 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Reading file backwards",29)
+65 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Last IEN processed:",30)_$JUSTIFY(IEN,15)
+66 SET PCT=(RECS/TLRECS)*100\1
End DoDot:1
+67 IF STAT["COMPLETED"
Begin DoDot:1
+68 SET PCT=100
+69 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Total elapsed time:",30)_$JUSTIFY($$FMDIFF^XLFDT(ENDTIME,BEGTIME,3),15)
End DoDot:1
+70 SET LIN=LIN+1
SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=$JUSTIFY("Percent complete:",30)_$JUSTIFY(PCT,14)_"%"
+71 ;send the message
+72 DO MAIL(ZTDESC)
+73 LOCK -^XTMP(NAMSPC)
+74 KILL ^TMP(NAMSPC,$JOB)
+75 QUIT
+76 ;
GETLAST ;get last run info
+1 ;last ien
SET IEN=+$GET(^XTMP(NAMSPC,0,"LAST IEN"))
+2 if IEN=0
SET IEN=999999999
+3 ;status
SET STAT=$PIECE($GET(^XTMP(NAMSPC,0,"STATUS")),U)
+4 ;recs processed
SET RECS=+$GET(^XTMP(NAMSPC,0,"RECS DONE"))
+5 ;tot recs in file
SET TLRECS=+$GET(^XTMP(NAMSPC,0,"RECS TOTL"))
+6 ;initial begin time
SET BEGTIME=$GET(^XTMP(NAMSPC,0,"INITIAL TIME"))
+7 ;end time
SET ENDTIME=$PIECE($GET(^XTMP(NAMSPC,0,"STATUS")),U,2)
+8 QUIT
+9 ;
INITSYS(NAM,VAL) ; Init the SYSTEM value
+1 ; Input: NAM = param name
+2 ; VAL = num of hours
+3 ;
+4 DO EN^XPAR("SYS",NAM,1,VAL)
+5 QUIT
+6 ;
INITDIV(NAM,VAL,UPD) ; Init DIVISION value
+1 ; Input: NAM = param name
+2 ; VAL = num of hours
+3 ; UPD = 1 to update, else list curr values only
+4 ;
+5 NEW FOUND
SET FOUND=0
+6 if 'UPD
DO MES^XPDUTL(" Before update")
+7 if UPD
DO MES^XPDUTL(" After update")
+8 DO MES^XPDUTL("")
+9 ;loop thru all medical divisions and only update those that use BCMA
+10 FOR DV=0:0
SET DV=$ORDER(^DG(40.8,"AD",DV))
if 'DV
QUIT
Begin DoDot:1
+11 SET ENT=DV_";DIC(4,"
+12 if '$$GET^XPAR(ENT,"PSB ONLINE")
QUIT
+13 SET FOUND=1
+14 IF UPD
IF +$$GET^XPAR(ENT,NAM,,"E")=0
DO EN^XPAR(ENT,NAM,1,VAL)
+15 DO MES^XPDUTL(" "_$EXTRACT($PIECE(^DIC(4,+ENT,0),U)_T20,1,25)_T10_$$GET^XPAR(ENT,NAM,,"E"))
End DoDot:1
+16 if 'FOUND
DO MES^XPDUTL(T5_"** NO DIVISIONS FOUND WITH BCMA ONLINE **")
+17 if 'FOUND
DO MES^XPDUTL(" ** NO DIVISIONS FOUND WITH BCMA ONLINE **")
+18 DO MES^XPDUTL("")
+19 QUIT
+20 ;
MAIL(HTEXT) ; send the mail message
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
SET XMDUZ="PSB3P68 Post Install"
+3 SET XMSUB=HTEXT_" Results"
+4 SET XMTEXT="^TMP("""_$$NAMSPC_""",$JOB,""MSG"","
+5 DO ^XMD
+6 KILL ^TMP($$NAMSPC)
+7 QUIT
+8 ;
CHKSTAT() ;check if job is running
+1 NEW Y,DUOUT,DTOUT,QUIT
+2 SET NAMSPC=$$NAMSPC
+3 SET STAT=$GET(^XTMP(NAMSPC,0,"STATUS"))
+4 SET QUIT=0
+5 LOCK +^XTMP(NAMSPC):3
+6 IF '$TEST
Begin DoDot:1
+7 DO MES^XPDUTL("*** WARNING ***")
DO MES^XPDUTL("")
+8 DO MES^XPDUTL(NAMSPC_" Cross Reference Builder is already RUNNING ")
+9 DO MES^XPDUTL(" from a previous install and can't be run now.")
+10 DO MES^XPDUTL("")
End DoDot:1
HANG 2
QUIT 1
+11 IF STAT["COMPLETED"
Begin DoDot:1
+12 DO MES^XPDUTL("*** WARNING ***")
DO MES^XPDUTL("")
+13 DO MES^XPDUTL(NAMSPC_" Cross Reference Builder was "_STAT)
+14 DO MES^XPDUTL(" by a previous install and can't run again.")
+15 DO MES^XPDUTL("")
End DoDot:1
HANG 2
QUIT 1
+16 QUIT QUIT
+17 ;
STATUS ;Display status of this job
+1 ;check lock status
+2 NEW STAT,TIME,JOB,RECS,TLRESC,PCT,RUNNING
+3 LOCK +^XTMP($$NAMSPC):3
+4 IF '$TEST
SET RUNNING=1
+5 IF '$TEST
SET RUNNING=0
+6 LOCK -^XTMP($$NAMSPC)
+7 SET STAT=$PIECE(^XTMP($$NAMSPC,0,"STATUS"),U)
+8 SET TIME=$PIECE(^XTMP($$NAMSPC,0,"STATUS"),U,2)
+9 SET JOB=$PIECE(^XTMP($$NAMSPC,0),U,3)
+10 SET RECS=+^XTMP($$NAMSPC,0,"RECS DONE")
+11 SET TLRECS=+^XTMP($$NAMSPC,0,"RECS TOTL")
+12 SET PCT=(RECS/TLRECS)*100\1
+13 IF 'RUNNING
IF STAT["RUNNING"
Begin DoDot:1
+14 WRITE !!,JOB,!,"Has errored and quit abruptly. Please restart Post Install",!
+15 WRITE !," at Programmers prompt '>' type 'D QUEUE^PSB3P68' and press Enter.",!!
End DoDot:1
QUIT
+16 WRITE !!,JOB,!,"Status: ",STAT," ",$$FMTE^XLFDT(TIME)
+17 WRITE !,PCT,"% complete",!!
+18 QUIT
+19 ;
NAMSPC() ;
+1 QUIT "PSB3P68"
