PXRMSXRM ; SLC/PKR - Main driver for building indexes. ;08/14/2017
;;2.0;CLINICAL REMINDERS;**6,17,26,47,42**;Feb 04, 2005;Build 245
;
;==========================================
ADDERROR(GLOBAL,IDEN,NERROR) ;Add to the error list.
S NERROR=NERROR+1
S ^TMP("PXRMERROR",$J,NERROR,0)="GLOBAL: "_GLOBAL_" ENTRY: "_IDEN
Q
;
;==========================================
ASKTASK() ;See if this should be tasked.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO"
S DIR("A")="Do you want this to be tasked"
S DIR("B")="Y"
D ^DIR
I $D(DIROUT)!$D(DIRUT) Q ""
I $D(DUOUT)!$D(DTOUT) Q ""
Q Y
;
;==========================================
BLDINDEX(FNUMLIST,START,SEQP) ;API for building the Clinical Reminders
;Index. FNUMLIST contains the list of file numbers whose portion
;of the Index is to be built. START is the date/time to start the
;task. If SEQP is 1 then the indexes are built sequentially.
N FNUM,NTB,ROUTINE,SEQ
S SEQ=$S($G(SEQP)="":1,1:SEQP)
S FNUM="",NTB=0
F S FNUM=$O(FNUMLIST(FNUM)) Q:FNUM="" S NTB=NTB+1
I NTB=0 Q
I NTB=1 S SEQ=0
D RTNLIST(.ROUTINE)
K ZTSAVE
S ZTSAVE("FNUMLIST(")=""
S ZTSAVE("ROUTINE(")=""
S ZTSAVE("SEQ")=SEQ
S ZTSAVE("START")=START
S ZTRTN="TASKRUN^PXRMSXRM"
S ZTDESC="Clinical Reminders Index build"
S ZTDTH=START
S ZTIO=""
D ^%ZTLOAD
Q ZTSK
;
;==========================================
COMMSG(GLOBAL,START,END,NE,NERROR) ;Send a MailMan message providing
;notification that the indexing completed.
N FROM,MGIEN,MGROUP,TO,XMSUB
K ^TMP("PXRMXMZ",$J)
S XMSUB="Index for global "_GLOBAL_" successfully built"
S ^TMP("PXRMXMZ",$J,1,0)="Build of Clinical Reminders index for global "_GLOBAL_" completed."
S ^TMP("PXRMXMZ",$J,2,0)="Build finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S ^TMP("PXRMXMZ",$J,3,0)=NE_" entries were created."
S ^TMP("PXRMXMZ",$J,4,0)=$$ETIME(START,END)
S ^TMP("PXRMXMZ",$J,5,0)="There were "_NERROR_" entries that could not be indexed."
I NERROR>0 D
. S ^TMP("PXRMXMZ",$J,6,0)="Another MailMan message will contain detailed information about the entries"
. S ^TMP("PXRMXMZ",$J,7,0)="that could not be indexed."
S FROM=$$GET1^DIQ(200,DUZ,.01)
S TO(DUZ)=""
S MGIEN=$G(^PXRM(800,1,"MGFE"))
I MGIEN'="" D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
Q
;
;==========================================
DETIME(START,END) ;Write out the elapsed time.
;START and END are $H times.
N TEXT
S TEXT=$$ETIME(START,END)
D MES^XPDUTL(TEXT)
Q
;
;==========================================
ERRMSG(NERROR,GLOBAL) ;If there were errors send an error message.
N END,FROM,IND,MAXERR,MGIEN,MGROUP,NE,TO,XMSUB
I NERROR=0 Q
;Return the last MAXERR errors
S MAXERR=+$G(^PXRM(800,1,"MIERR"))
I MAXERR=0 S MAXERR=200
K ^TMP("PXRMXMZ",$J)
S END=$S(NERROR'>MAXERR:NERROR,1:MAXERR)
S NE=NERROR+1
F IND=1:1:END S NE=NE-1,^TMP("PXRMXMZ",$J,IND,0)=^TMP("PXRMERROR",$J,NE,0)
I END=MAXERR S ^TMP("PXRMXMZ",$J,MAXERR+1,0)="GLOBAL: "_GLOBAL_"- The maximum number of non-indexable entries to report has been reached, will not report any more."
K ^TMP("PXRMERROR",$J)
S XMSUB="CR INDEX: NON-INDEXABLE ENTRIES FOR GLOBAL "_GLOBAL
S FROM=$$GET1^DIQ(200,DUZ,.01)
S TO(DUZ)=""
S MGIEN=$G(^PXRM(800,1,"MGFE"))
I MGIEN'="" D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
Q
;
;==========================================
ETIME(START,END) ;Calculate and format the elapsed time.
;START and END are $H times.
N ETIME,TEXT
S ETIME=$$HDIFF^XLFDT(END,START,2)
I ETIME>90 D
. S ETIME=$$HDIFF^XLFDT(END,START,3)
. S TEXT="Elapsed time: "_ETIME
E S TEXT="Elapsed time: "_ETIME_" secs"
Q TEXT
;
;==========================================
INDEX ;Driver for building the various indexes.
N ANS,GBL,LIST,ROUTINE,TASKIT
D RTNLIST(.ROUTINE)
W !,"Rebuilding an index will stop all evaluation, dialogs,"
W !,"reminder order checks, and anything using reminder evaluation!"
W !,"Are you sure you want to proceed?"
S ANS=$$ASKYN^PXRMEUT("N","Rebuild index and disable reminder evaluation")
I 'ANS Q
;Get the list
W !,"Which indexes do you want to (re)build?"
D SEL(.LIST,.GBL)
I LIST="" Q
;See if this should be tasked.
S TASKIT=$$ASKTASK
I TASKIT="" Q
I TASKIT D
. W !,"Queue the Clinical Reminders index job."
. D TASKIT(LIST,.GBL,.ROUTINE)
E D RUNNOW(LIST,.GBL,.ROUTINE)
Q
;
;==========================================
NDONEMSG(FNUM,ZTSK) ;If the task to rebuild an index did not complete
;in the allowed time send a message.
N FROM,MGIEN,MGROUP,TO,XMSUB
S XMSUB="CR INDEX REBUILD FOR FILE #"_FNUM_" HAS NOT FINISHED"
S FROM=$$GET1^DIQ(200,DUZ,.01)
S TO(DUZ)=""
S MGIEN=$G(^PXRM(800,1,"MGFE"))
I MGIEN'="" D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="As of "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S ^TMP("PXRMXMZ",$J,2,0)="Task #"_ZTSK_" to rebuild the index for file #"_FNUM_" has not finished."
S ^TMP("PXRMXMZ",$J,3,0)="You may want to investigate this."
D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
Q
;
;==========================================
RTNLIST(ROUTINE) ;Populate the routine list.
S ROUTINE(45)="INDEX^DGPTDDCR" ;DBIA #4521
S ROUTINE(52)="PSRX^PSOPXRMI" ;DBIA #4522
S ROUTINE(55)="PSPA^PSSSXRD" ;DBIA #4172
S ROUTINE(63)="LAB^LRPXSXRL" ;DBIA #4247
S ROUTINE(70)="RAD^RAPXRM" ;DBIA #3731
S ROUTINE(100)="INDEX^ORPXRM" ;DBIA #4498
S ROUTINE(120.5)="VITALS^GMVPXRM" ;DBIA #3647
S ROUTINE(601.2)="INDEX^YTPXRM" ;DBIA #4523
S ROUTINE(601.84)="INDEX^YTQPXRM" ;DBIA #5055
S ROUTINE(9000011)="INDEX^GMPLPXRM" ;DBIA #4516
S ROUTINE(9000010.07)="VPOV^PXPXRMI2" ;DBIA #4520
S ROUTINE(9000010.11)="VIMM^PXPXRMI1" ;DBIA #4519
S ROUTINE(9000010.12)="VSK^PXPXRMI2" ;DBIA #4520
S ROUTINE(9000010.13)="VXAM^PXPXRMI2" ;DBIA #4520
S ROUTINE(9000010.16)="VPED^PXPXRMI2" ;DBIA #4520
S ROUTINE(9000010.18)="VCPT^PXPXRMI1" ;DBIA #4519
S ROUTINE(9000010.23)="VHF^PXPXRMI1" ;DBIA #4519
S ROUTINE(9000010.71)="VSC^PXPXRMI2" ;DBIA #4520
Q
;
;==========================================
RUNNOW(LIST,GBL,ROUTINE) ;Run the index build routines now.
N IND,INDEXL,LI,NUM,RTN
S NUM=$L(LIST,",")-1
I NUM>1 F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S INDEXL(GBL(LI))=""
F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S RTN=ROUTINE(GBL(LI))
. D INDEXD^PXRMDIEV(GBL(LI),.INDEXL)
. D @RTN
Q
;
;==========================================
SEL(LIST,GBL) ;Select global list
N ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,INUM,X,Y
S INUM=1,ALIST(INUM)=" "_INUM_" - LABORATORY TEST (CH, Anatomic Path, Micro)",GBL(INUM)=63
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - MENTAL HEALTH",GBL(INUM)=601.2
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - MENTAL HEALTH (MHA3)",GBL(INUM)=601.84
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - ORDER",GBL(INUM)=100
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - PTF",GBL(INUM)=45
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - PHARMACY PATIENT",GBL(INUM)=55
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - PRESCRIPTION",GBL(INUM)=52
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - PROBLEM LIST",GBL(INUM)=9000011
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - RADIOLOGY",GBL(INUM)=70
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V CPT",GBL(INUM)=9000010.18
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V EXAM",GBL(INUM)=9000010.13
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V HEALTH FACTORS",GBL(INUM)=9000010.23
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V IMMUNIZATION",GBL(INUM)=9000010.11
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V PATIENT ED",GBL(INUM)=9000010.16
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V POV",GBL(INUM)=9000010.07
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V SKIN TEST",GBL(INUM)=9000010.12
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V STANDARD CODES",GBL(INUM)=9000010.71
S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - VITAL MEASUREMENT",GBL(INUM)=120.5
M DIR("A")=ALIST
S DIR("A")="Enter your list"
S DIR(0)="LO^1:"_INUM
D ^DIR
I $D(DIROUT)!$D(DIRUT) S LIST="" Q
I $D(DUOUT)!$D(DTOUT) S LIST="" Q
S LIST=Y
Q
;
;==========================================
TASKIT(LIST,GBL,ROUTINE) ;Build the indexes as a tasked job.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
S MINDT=$$NOW^XLFDT
S DIR("A",1)="Enter the date and time you want the job to start."
S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
S DIR("A")="Start the task at: "
S DIR(0)="DAU"_U_MINDT_"::RSX"
D ^DIR
I $D(DIROUT)!$D(DIRUT) Q
I $D(DUOUT)!$D(DTOUT) Q
S SDTIME=Y
;Put the task into the queue.
K ZTSAVE
S ZTSAVE("LIST")=""
S ZTSAVE("GBL(")=""
S ZTSAVE("ROUTINE(")=""
S ZTRTN="TASKJOB^PXRMSXRM"
S ZTDESC="Clinical Reminders index build"
S ZTDTH=SDTIME
S ZTIO=""
D ^%ZTLOAD
W !,"Task number ",ZTSK," queued."
Q
;
;==========================================
TASKBLD ;Execute as tasked job. FNUM, FNUMLIST, and RTN come through ZTSAVE.
S ZTREQ="@"
D INDEXD^PXRMDIEV(FNUM,.FNUMLIST)
D @RTN
Q
;
;==========================================
TASKJOB ;Execute as tasked job, used by list build option.
;LIST, GBL, and ROUTINE come through ZTSAVE.
N IND,INDEXL,LI,NUM,RTN
S ZTREQ="@"
S ZTSTOP=0
S NUM=$L(LIST,",")-1
I NUM>1 F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S INDEXL(GBL(LI))=""
F IND=1:1:NUM D
.;Check to see if the task has had a stop request.
. I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
. S LI=$P(LIST,",",IND)
. S RTN=ROUTINE(GBL(LI))
. D INDEXD^PXRMDIEV(GBL(LI),.INDEXL)
. D @RTN
Q
;
;==========================================
TASKDONE(TASKNUM) ;Return a 1 when task number TASKNUM has completed.
N DONE,NT,ZTSK
S ZTREQ="@"
S ZTSK=TASKNUM
S (DONE,NT)=0
F Q:DONE D
. S NT=NT+1
. D STAT^%ZTLOAD
. I ZTSK(0)=0 S DONE=1 Q
. I ZTSK(1)=3 S DONE=1 Q
. I ZTSK(1)=5 S DONE=1 Q
.;Timeout after 6 hours.
. I NT>359 S DONE=1 Q
. I 'DONE H 60
I NT>359 S DONE=0
Q DONE
;
;==========================================
TASKRUN ;Task to queue index builds for BLDINDEX API.
;FNUMLIST, ROUTINE, and START come through ZTSAVE.
N BUILT,DESC,FNUM,RTN
S ZTREQ="@"
S FNUM=""
F S FNUM=$O(FNUMLIST(FNUM)) Q:FNUM="" D
. S RTN=$G(ROUTINE(FNUM))
. I RTN="" Q
. K ZTSAVE,ZTSK
. S ZTSAVE("FNUM")=FNUM
. S ZTSAVE("FNUMLIST(")=""
. S ZTSAVE("RTN")=RTN
. S ZTRTN="TASKBLD^PXRMSXRM"
. S ZTDESC="Clinical Reminders Index build for file #"_FNUM
. S DESC=ZTDESC
. S ZTDTH=START
. S ZTIO=""
. D ^%ZTLOAD
. I '$D(ZTSK) Q
.;If SEQ is true then wait for the current index build to finish
.;before starting the next one.
. I SEQ D
.. S BUILT=$$TASKDONE^PXRMSXRM(ZTSK)
.. I 'BUILT D NDONEMSG(FNUM,ZTSK)
.;If concurrent allow some time for the first job to establish ^XTMP.
. I 'SEQ H 2
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSXRM 10917 printed Dec 13, 2024@01:49:18 Page 2
PXRMSXRM ; SLC/PKR - Main driver for building indexes. ;08/14/2017
+1 ;;2.0;CLINICAL REMINDERS;**6,17,26,47,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;==========================================
ADDERROR(GLOBAL,IDEN,NERROR) ;Add to the error list.
+1 SET NERROR=NERROR+1
+2 SET ^TMP("PXRMERROR",$JOB,NERROR,0)="GLOBAL: "_GLOBAL_" ENTRY: "_IDEN
+3 QUIT
+4 ;
+5 ;==========================================
ASKTASK() ;See if this should be tasked.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Do you want this to be tasked"
+4 SET DIR("B")="Y"
+5 DO ^DIR
+6 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT ""
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT ""
+8 QUIT Y
+9 ;
+10 ;==========================================
BLDINDEX(FNUMLIST,START,SEQP) ;API for building the Clinical Reminders
+1 ;Index. FNUMLIST contains the list of file numbers whose portion
+2 ;of the Index is to be built. START is the date/time to start the
+3 ;task. If SEQP is 1 then the indexes are built sequentially.
+4 NEW FNUM,NTB,ROUTINE,SEQ
+5 SET SEQ=$SELECT($GET(SEQP)="":1,1:SEQP)
+6 SET FNUM=""
SET NTB=0
+7 FOR
SET FNUM=$ORDER(FNUMLIST(FNUM))
if FNUM=""
QUIT
SET NTB=NTB+1
+8 IF NTB=0
QUIT
+9 IF NTB=1
SET SEQ=0
+10 DO RTNLIST(.ROUTINE)
+11 KILL ZTSAVE
+12 SET ZTSAVE("FNUMLIST(")=""
+13 SET ZTSAVE("ROUTINE(")=""
+14 SET ZTSAVE("SEQ")=SEQ
+15 SET ZTSAVE("START")=START
+16 SET ZTRTN="TASKRUN^PXRMSXRM"
+17 SET ZTDESC="Clinical Reminders Index build"
+18 SET ZTDTH=START
+19 SET ZTIO=""
+20 DO ^%ZTLOAD
+21 QUIT ZTSK
+22 ;
+23 ;==========================================
COMMSG(GLOBAL,START,END,NE,NERROR) ;Send a MailMan message providing
+1 ;notification that the indexing completed.
+2 NEW FROM,MGIEN,MGROUP,TO,XMSUB
+3 KILL ^TMP("PXRMXMZ",$JOB)
+4 SET XMSUB="Index for global "_GLOBAL_" successfully built"
+5 SET ^TMP("PXRMXMZ",$JOB,1,0)="Build of Clinical Reminders index for global "_GLOBAL_" completed."
+6 SET ^TMP("PXRMXMZ",$JOB,2,0)="Build finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+7 SET ^TMP("PXRMXMZ",$JOB,3,0)=NE_" entries were created."
+8 SET ^TMP("PXRMXMZ",$JOB,4,0)=$$ETIME(START,END)
+9 SET ^TMP("PXRMXMZ",$JOB,5,0)="There were "_NERROR_" entries that could not be indexed."
+10 IF NERROR>0
Begin DoDot:1
+11 SET ^TMP("PXRMXMZ",$JOB,6,0)="Another MailMan message will contain detailed information about the entries"
+12 SET ^TMP("PXRMXMZ",$JOB,7,0)="that could not be indexed."
End DoDot:1
+13 SET FROM=$$GET1^DIQ(200,DUZ,.01)
+14 SET TO(DUZ)=""
+15 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+16 IF MGIEN'=""
Begin DoDot:1
+17 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+18 SET TO(MGROUP)=""
End DoDot:1
+19 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
+20 QUIT
+21 ;
+22 ;==========================================
DETIME(START,END) ;Write out the elapsed time.
+1 ;START and END are $H times.
+2 NEW TEXT
+3 SET TEXT=$$ETIME(START,END)
+4 DO MES^XPDUTL(TEXT)
+5 QUIT
+6 ;
+7 ;==========================================
ERRMSG(NERROR,GLOBAL) ;If there were errors send an error message.
+1 NEW END,FROM,IND,MAXERR,MGIEN,MGROUP,NE,TO,XMSUB
+2 IF NERROR=0
QUIT
+3 ;Return the last MAXERR errors
+4 SET MAXERR=+$GET(^PXRM(800,1,"MIERR"))
+5 IF MAXERR=0
SET MAXERR=200
+6 KILL ^TMP("PXRMXMZ",$JOB)
+7 SET END=$SELECT(NERROR'>MAXERR:NERROR,1:MAXERR)
+8 SET NE=NERROR+1
+9 FOR IND=1:1:END
SET NE=NE-1
SET ^TMP("PXRMXMZ",$JOB,IND,0)=^TMP("PXRMERROR",$JOB,NE,0)
+10 IF END=MAXERR
SET ^TMP("PXRMXMZ",$JOB,MAXERR+1,0)="GLOBAL: "_GLOBAL_"- The maximum number of non-indexable entries to report has been reached, will not report any more."
+11 KILL ^TMP("PXRMERROR",$JOB)
+12 SET XMSUB="CR INDEX: NON-INDEXABLE ENTRIES FOR GLOBAL "_GLOBAL
+13 SET FROM=$$GET1^DIQ(200,DUZ,.01)
+14 SET TO(DUZ)=""
+15 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+16 IF MGIEN'=""
Begin DoDot:1
+17 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+18 SET TO(MGROUP)=""
End DoDot:1
+19 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
+20 QUIT
+21 ;
+22 ;==========================================
ETIME(START,END) ;Calculate and format the elapsed time.
+1 ;START and END are $H times.
+2 NEW ETIME,TEXT
+3 SET ETIME=$$HDIFF^XLFDT(END,START,2)
+4 IF ETIME>90
Begin DoDot:1
+5 SET ETIME=$$HDIFF^XLFDT(END,START,3)
+6 SET TEXT="Elapsed time: "_ETIME
End DoDot:1
+7 IF '$TEST
SET TEXT="Elapsed time: "_ETIME_" secs"
+8 QUIT TEXT
+9 ;
+10 ;==========================================
INDEX ;Driver for building the various indexes.
+1 NEW ANS,GBL,LIST,ROUTINE,TASKIT
+2 DO RTNLIST(.ROUTINE)
+3 WRITE !,"Rebuilding an index will stop all evaluation, dialogs,"
+4 WRITE !,"reminder order checks, and anything using reminder evaluation!"
+5 WRITE !,"Are you sure you want to proceed?"
+6 SET ANS=$$ASKYN^PXRMEUT("N","Rebuild index and disable reminder evaluation")
+7 IF 'ANS
QUIT
+8 ;Get the list
+9 WRITE !,"Which indexes do you want to (re)build?"
+10 DO SEL(.LIST,.GBL)
+11 IF LIST=""
QUIT
+12 ;See if this should be tasked.
+13 SET TASKIT=$$ASKTASK
+14 IF TASKIT=""
QUIT
+15 IF TASKIT
Begin DoDot:1
+16 WRITE !,"Queue the Clinical Reminders index job."
+17 DO TASKIT(LIST,.GBL,.ROUTINE)
End DoDot:1
+18 IF '$TEST
DO RUNNOW(LIST,.GBL,.ROUTINE)
+19 QUIT
+20 ;
+21 ;==========================================
NDONEMSG(FNUM,ZTSK) ;If the task to rebuild an index did not complete
+1 ;in the allowed time send a message.
+2 NEW FROM,MGIEN,MGROUP,TO,XMSUB
+3 SET XMSUB="CR INDEX REBUILD FOR FILE #"_FNUM_" HAS NOT FINISHED"
+4 SET FROM=$$GET1^DIQ(200,DUZ,.01)
+5 SET TO(DUZ)=""
+6 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+7 IF MGIEN'=""
Begin DoDot:1
+8 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+9 SET TO(MGROUP)=""
End DoDot:1
+10 KILL ^TMP("PXRMXMZ",$JOB)
+11 SET ^TMP("PXRMXMZ",$JOB,1,0)="As of "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+12 SET ^TMP("PXRMXMZ",$JOB,2,0)="Task #"_ZTSK_" to rebuild the index for file #"_FNUM_" has not finished."
+13 SET ^TMP("PXRMXMZ",$JOB,3,0)="You may want to investigate this."
+14 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
+15 QUIT
+16 ;
+17 ;==========================================
RTNLIST(ROUTINE) ;Populate the routine list.
+1 ;DBIA #4521
SET ROUTINE(45)="INDEX^DGPTDDCR"
+2 ;DBIA #4522
SET ROUTINE(52)="PSRX^PSOPXRMI"
+3 ;DBIA #4172
SET ROUTINE(55)="PSPA^PSSSXRD"
+4 ;DBIA #4247
SET ROUTINE(63)="LAB^LRPXSXRL"
+5 ;DBIA #3731
SET ROUTINE(70)="RAD^RAPXRM"
+6 ;DBIA #4498
SET ROUTINE(100)="INDEX^ORPXRM"
+7 ;DBIA #3647
SET ROUTINE(120.5)="VITALS^GMVPXRM"
+8 ;DBIA #4523
SET ROUTINE(601.2)="INDEX^YTPXRM"
+9 ;DBIA #5055
SET ROUTINE(601.84)="INDEX^YTQPXRM"
+10 ;DBIA #4516
SET ROUTINE(9000011)="INDEX^GMPLPXRM"
+11 ;DBIA #4520
SET ROUTINE(9000010.07)="VPOV^PXPXRMI2"
+12 ;DBIA #4519
SET ROUTINE(9000010.11)="VIMM^PXPXRMI1"
+13 ;DBIA #4520
SET ROUTINE(9000010.12)="VSK^PXPXRMI2"
+14 ;DBIA #4520
SET ROUTINE(9000010.13)="VXAM^PXPXRMI2"
+15 ;DBIA #4520
SET ROUTINE(9000010.16)="VPED^PXPXRMI2"
+16 ;DBIA #4519
SET ROUTINE(9000010.18)="VCPT^PXPXRMI1"
+17 ;DBIA #4519
SET ROUTINE(9000010.23)="VHF^PXPXRMI1"
+18 ;DBIA #4520
SET ROUTINE(9000010.71)="VSC^PXPXRMI2"
+19 QUIT
+20 ;
+21 ;==========================================
RUNNOW(LIST,GBL,ROUTINE) ;Run the index build routines now.
+1 NEW IND,INDEXL,LI,NUM,RTN
+2 SET NUM=$LENGTH(LIST,",")-1
+3 IF NUM>1
FOR IND=1:1:NUM
Begin DoDot:1
+4 SET LI=$PIECE(LIST,",",IND)
+5 SET INDEXL(GBL(LI))=""
End DoDot:1
+6 FOR IND=1:1:NUM
Begin DoDot:1
+7 SET LI=$PIECE(LIST,",",IND)
+8 SET RTN=ROUTINE(GBL(LI))
+9 DO INDEXD^PXRMDIEV(GBL(LI),.INDEXL)
+10 DO @RTN
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========================================
SEL(LIST,GBL) ;Select global list
+1 NEW ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,INUM,X,Y
+2 SET INUM=1
SET ALIST(INUM)=" "_INUM_" - LABORATORY TEST (CH, Anatomic Path, Micro)"
SET GBL(INUM)=63
+3 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - MENTAL HEALTH"
SET GBL(INUM)=601.2
+4 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - MENTAL HEALTH (MHA3)"
SET GBL(INUM)=601.84
+5 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - ORDER"
SET GBL(INUM)=100
+6 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - PTF"
SET GBL(INUM)=45
+7 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - PHARMACY PATIENT"
SET GBL(INUM)=55
+8 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - PRESCRIPTION"
SET GBL(INUM)=52
+9 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - PROBLEM LIST"
SET GBL(INUM)=9000011
+10 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - RADIOLOGY"
SET GBL(INUM)=70
+11 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V CPT"
SET GBL(INUM)=9000010.18
+12 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V EXAM"
SET GBL(INUM)=9000010.13
+13 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V HEALTH FACTORS"
SET GBL(INUM)=9000010.23
+14 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V IMMUNIZATION"
SET GBL(INUM)=9000010.11
+15 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V PATIENT ED"
SET GBL(INUM)=9000010.16
+16 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V POV"
SET GBL(INUM)=9000010.07
+17 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V SKIN TEST"
SET GBL(INUM)=9000010.12
+18 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - V STANDARD CODES"
SET GBL(INUM)=9000010.71
+19 SET INUM=INUM+1
SET ALIST(INUM)=" "_INUM_" - VITAL MEASUREMENT"
SET GBL(INUM)=120.5
+20 MERGE DIR("A")=ALIST
+21 SET DIR("A")="Enter your list"
+22 SET DIR(0)="LO^1:"_INUM
+23 DO ^DIR
+24 IF $DATA(DIROUT)!$DATA(DIRUT)
SET LIST=""
QUIT
+25 IF $DATA(DUOUT)!$DATA(DTOUT)
SET LIST=""
QUIT
+26 SET LIST=Y
+27 QUIT
+28 ;
+29 ;==========================================
TASKIT(LIST,GBL,ROUTINE) ;Build the indexes as a tasked job.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
+2 SET MINDT=$$NOW^XLFDT
+3 SET DIR("A",1)="Enter the date and time you want the job to start."
+4 SET DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
+5 SET DIR("A")="Start the task at: "
+6 SET DIR(0)="DAU"_U_MINDT_"::RSX"
+7 DO ^DIR
+8 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+9 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+10 SET SDTIME=Y
+11 ;Put the task into the queue.
+12 KILL ZTSAVE
+13 SET ZTSAVE("LIST")=""
+14 SET ZTSAVE("GBL(")=""
+15 SET ZTSAVE("ROUTINE(")=""
+16 SET ZTRTN="TASKJOB^PXRMSXRM"
+17 SET ZTDESC="Clinical Reminders index build"
+18 SET ZTDTH=SDTIME
+19 SET ZTIO=""
+20 DO ^%ZTLOAD
+21 WRITE !,"Task number ",ZTSK," queued."
+22 QUIT
+23 ;
+24 ;==========================================
TASKBLD ;Execute as tasked job. FNUM, FNUMLIST, and RTN come through ZTSAVE.
+1 SET ZTREQ="@"
+2 DO INDEXD^PXRMDIEV(FNUM,.FNUMLIST)
+3 DO @RTN
+4 QUIT
+5 ;
+6 ;==========================================
TASKJOB ;Execute as tasked job, used by list build option.
+1 ;LIST, GBL, and ROUTINE come through ZTSAVE.
+2 NEW IND,INDEXL,LI,NUM,RTN
+3 SET ZTREQ="@"
+4 SET ZTSTOP=0
+5 SET NUM=$LENGTH(LIST,",")-1
+6 IF NUM>1
FOR IND=1:1:NUM
Begin DoDot:1
+7 SET LI=$PIECE(LIST,",",IND)
+8 SET INDEXL(GBL(LI))=""
End DoDot:1
+9 FOR IND=1:1:NUM
Begin DoDot:1
+10 ;Check to see if the task has had a stop request.
+11 IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IND=NUM
QUIT
+12 SET LI=$PIECE(LIST,",",IND)
+13 SET RTN=ROUTINE(GBL(LI))
+14 DO INDEXD^PXRMDIEV(GBL(LI),.INDEXL)
+15 DO @RTN
End DoDot:1
+16 QUIT
+17 ;
+18 ;==========================================
TASKDONE(TASKNUM) ;Return a 1 when task number TASKNUM has completed.
+1 NEW DONE,NT,ZTSK
+2 SET ZTREQ="@"
+3 SET ZTSK=TASKNUM
+4 SET (DONE,NT)=0
+5 FOR
if DONE
QUIT
Begin DoDot:1
+6 SET NT=NT+1
+7 DO STAT^%ZTLOAD
+8 IF ZTSK(0)=0
SET DONE=1
QUIT
+9 IF ZTSK(1)=3
SET DONE=1
QUIT
+10 IF ZTSK(1)=5
SET DONE=1
QUIT
+11 ;Timeout after 6 hours.
+12 IF NT>359
SET DONE=1
QUIT
+13 IF 'DONE
HANG 60
End DoDot:1
+14 IF NT>359
SET DONE=0
+15 QUIT DONE
+16 ;
+17 ;==========================================
TASKRUN ;Task to queue index builds for BLDINDEX API.
+1 ;FNUMLIST, ROUTINE, and START come through ZTSAVE.
+2 NEW BUILT,DESC,FNUM,RTN
+3 SET ZTREQ="@"
+4 SET FNUM=""
+5 FOR
SET FNUM=$ORDER(FNUMLIST(FNUM))
if FNUM=""
QUIT
Begin DoDot:1
+6 SET RTN=$GET(ROUTINE(FNUM))
+7 IF RTN=""
QUIT
+8 KILL ZTSAVE,ZTSK
+9 SET ZTSAVE("FNUM")=FNUM
+10 SET ZTSAVE("FNUMLIST(")=""
+11 SET ZTSAVE("RTN")=RTN
+12 SET ZTRTN="TASKBLD^PXRMSXRM"
+13 SET ZTDESC="Clinical Reminders Index build for file #"_FNUM
+14 SET DESC=ZTDESC
+15 SET ZTDTH=START
+16 SET ZTIO=""
+17 DO ^%ZTLOAD
+18 IF '$DATA(ZTSK)
QUIT
+19 ;If SEQ is true then wait for the current index build to finish
+20 ;before starting the next one.
+21 IF SEQ
Begin DoDot:2
+22 SET BUILT=$$TASKDONE^PXRMSXRM(ZTSK)
+23 IF 'BUILT
DO NDONEMSG(FNUM,ZTSK)
End DoDot:2
+24 ;If concurrent allow some time for the first job to establish ^XTMP.
+25 IF 'SEQ
HANG 2
End DoDot:1
+26 QUIT
+27 ;