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

PXRMSXRM.m

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