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

PXRMINDD.m

Go to the documentation of this file. 
  1. PXRMINDD ; SLC/PKR - Index string date checking routines. ;09/27/2012
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,17,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  ;========================================================
  1. CNT5(FILENUM,NSD) ;Check for string dates for indexes where the date
  1.  ;is at subscript 5. Works for file numbers:
  1.  ;63, 70, 120.5, 601.2, 601.84
  1.  ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
  1.  N DAS,DATE,DFN,IND,ITEM
  1.  I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
  1.  S IND=0
  1.  S DFN=""
  1.  F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
  1.  . S IND=IND+1
  1.  . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  . S ITEM=""
  1.  . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
  1.  .. S DATE=""
  1.  .. F  S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
  1.  ... I +DATE=DATE Q
  1.  ... S DAS=""
  1.  ... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS=""  D
  1.  .... S NSD=NSD+1
  1.  .... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_DATE_""","_DAS_")"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. CNT6(FILENUM,NSD) ;Check for string dates for indexes where the date
  1.  ;is at subscript 6. Works for file numbers:
  1.  ;9000010.07, 9000010.18
  1.  N CODESYS,DAS,DATE,DFN,IND,ITEM,TYPE
  1.  I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
  1.  S DFN="",IND=0
  1.  F  S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN=""  D
  1.  . S IND=IND+1
  1.  . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  . S TYPE=""
  1.  . F  S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE=""  D
  1.  .. S ITEM=""
  1.  .. F  S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM=""  D
  1.  ... S DATE=""
  1.  ... F  S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
  1.  .... I +DATE=DATE Q
  1.  .... S DAS=""
  1.  .... F  S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS=""  D
  1.  ..... S NSD=NSD+1
  1.  ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
  1.  I FILENUM'=9000010.07 Q
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS=""  D
  1.  . I (CODESYS="PPI")!(CODESYS="IPP") Q
  1.  . S DFN=""
  1.  . F  S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN)) Q:DFN=""  D
  1.  .. S IND=IND+1
  1.  .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  .. S TYPE=""
  1.  .. F  S TYPE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE)) Q:TYPE=""  D
  1.  ... S ITEM=""
  1.  ... F  S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM)) Q:ITEM=""  D
  1.  .... S DATE=""
  1.  .... F  S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
  1.  ..... I +DATE=DATE Q
  1.  ..... S DAS=""
  1.  ..... F  S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS=""  D
  1.  ...... S NSD=NSD+1
  1.  ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. CNTPL(FILENUM,NSD) ;Check for string date for Problem List indexes where the
  1.  ;date is at subscript 8. Works for file numbers:
  1.  ;9000011
  1.  N CODESYS,DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE
  1.  I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(^PXRMINDX(9000011,CODESYS)) Q:CODESYS=""  D
  1.  . S DFN="",IND=0
  1.  . F  S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN)) Q:DFN=""  D
  1.  .. S IND=IND+1
  1.  .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  .. S STATUS=""
  1.  .. F  S STATUS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS)) Q:STATUS=""  D
  1.  ... S PRIORITY=""
  1.  ... F  S PRIORITY=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
  1.  .... S ITEM=""
  1.  .... F  S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM=""  D
  1.  ..... S DATE=""
  1.  ..... F  S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
  1.  ...... I +DATE=DATE Q
  1.  ...... S DAS=""
  1.  ...... F  S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS=""  D
  1.  ....... S NSD=NSD+1
  1.  ....... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PSPI"","_DFN_","_STATUS_","_PRIORITY_","_ITEM_","""_DATE_""","_DAS_")"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. CNTPTF(FILENUM,NSD) ;Check for string dates for PTF indexes where the
  1.  ;date is at subscript 7. Works for file numbers:
  1.  ;45
  1.  N CODESYS,DAS,DATE,DFN,IND,ITEM,NODE
  1.  I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
  1.  S CODESYS="",IND=0
  1.  F  S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS=""  D
  1.  . S DFN=""
  1.  . F  S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN)) Q:DFN=""  D
  1.  .. S IND=IND+1
  1.  .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  .. S NODE=""
  1.  .. F  S NODE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE)) Q:NODE=""  D
  1.  ... S ITEM=""
  1.  ... F  S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM)) Q:ITEM=""  D
  1.  .... S DATE=""
  1.  .... F  S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE=""  D
  1.  ..... I +DATE=DATE Q
  1.  ..... S DAS=""
  1.  ..... F  S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS=""  D
  1.  ...... S NSD=NSD+1
  1.  ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PNI"","_DFN_","_NODE_","_ITEM_","""_DATE_""","_DAS_")"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. CNTSS(FILENUM,NSD) ;Check for string dates for indexes where the start date
  1.  ;is at subscript 5 and the stop date is at subscript 6.
  1.  ;Works for file numbers: 52, 55, 100
  1.  N DAS,DFN,IND,ITEM,START,STOP
  1.  I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
  1.  S IND=0
  1.  S DFN=""
  1.  F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
  1.  . S IND=IND+1
  1.  . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1.  . S ITEM=""
  1.  . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
  1.  .. S START=""
  1.  .. F  S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START=""  D
  1.  ... I +START=START Q
  1.  ... S STOP=""
  1.  ... F  S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP=""  D
  1.  .... S DAS=""
  1.  .... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS=""  D
  1.  ..... S NSD=NSD+1
  1.  ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_START_""","_STOP_","_DAS_")"
  1.  Q
  1.  ;
  1.  ;========================================================
  1. CHECK ;Driver for making index date checks.
  1.  N GBL,LIST,TASKIT
  1.  W !,"Which indexes do you want to check?"
  1.  D SEL^PXRMSXRM(.LIST,.GBL)
  1.  I LIST="" Q
  1.  ;See if this should be tasked.
  1.  S TASKIT=$$ASKTASK^PXRMSXRM
  1.  I TASKIT D
  1.  . W !,"Queue the Clinical Reminders Index date check."
  1.  . D TASKIT(LIST,.GBL,.ROUTINE)
  1.  E  D RUNNOW(LIST,.GBL)
  1.  Q
  1.  ;
  1.  ;========================================================
  1. MESSAGE(FILENUM,NSD,START,END) ;Build the MailMan message giving the
  1.  ;list of entries with string dates.
  1.  N FROM,IND,NAME,NL,TEXT,TO,XMSUB
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S XMSUB="CR Index string date check for file #"_FILENUM
  1.  S NAME=$$GET1^DID(FILENUM,"","","NAME")_", file #"_FILENUM
  1.  I NSD=0 S TEXT="No string dates were found for "_NAME_"."
  1.  I NSD>0 S TEXT="A total of "_NSD_" string dates were found for "_NAME_"."
  1.  S ^TMP("PXRMXMZ",$J,1,0)=TEXT
  1.  S ^TMP("PXRMXMZ",$J,2,0)="Check finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1.  S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
  1.  S ^TMP("PXRMXMZ",$J,4,0)=" "
  1.  I NSD=0,'$D(^PXRMINDX(FILENUM)) D
  1.  . S ^TMP("PXRMXMZ",$J,5,0)="The index for file number "_FILENUM_" does not exist."
  1.  . S ^TMP("PXRMXMZ",$J,6,0)=" "
  1.  I NSD>0 D
  1.  . S ^TMP("PXRMXMZ",$J,5,0)="The following entries with string dates were found:"
  1.  . S NL=5
  1.  . F IND=1:1:NSD D
  1.  .. S NL=NL+1
  1.  .. S ^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDATE",IND)
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
  1.  S FROM=$$GET1^DIQ(200,DUZ,.01)
  1.  S TO(DUZ)=""
  1.  D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
  1.  K ^TMP($J,"SDATE"),^TMP("PXRMXMZ",$J)
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. RUNNOW(LIST,GBL) ;Run the routines now.
  1.  N END,FN,IND,LI,NSD,NUM,ROUTINE,RTN,START,TOTAL
  1.  K ^TMP($J,"SDATE")
  1.  S ROUTINE(45)="CNTPTF^PXRMINDD"
  1.  S ROUTINE(52)="CNTSS^PXRMINDD"
  1.  S ROUTINE(55)="CNTSS^PXRMINDD"
  1.  S ROUTINE(63)="CNT5^PXRMINDD"
  1.  S ROUTINE(70)="CNT5^PXRMINDD"
  1.  S ROUTINE(100)="CNTSS^PXRMINDD"
  1.  S ROUTINE(120.5)="CNT5^PXRMINDD"
  1.  S ROUTINE(601.2)="CNT5^PXRMINDD"
  1.  S ROUTINE(601.84)="CNT5^PXRMINDD"
  1.  S ROUTINE(9000011)="CNTPL^PXRMINDD"
  1.  S ROUTINE(9000010.07)="CNT6^PXRMINDD"
  1.  S ROUTINE(9000010.11)="CNT5^PXRMINDD"
  1.  S ROUTINE(9000010.12)="CNT5^PXRMINDD"
  1.  S ROUTINE(9000010.13)="CNT5^PXRMINDD"
  1.  S ROUTINE(9000010.16)="CNT5^PXRMINDD"
  1.  S ROUTINE(9000010.18)="CNT6^PXRMINDD"
  1.  S ROUTINE(9000010.23)="CNT5^PXRMINDD"
  1.  S NUM=$L(LIST,",")-1
  1.  F IND=1:1:NUM D
  1.  . S LI=$P(LIST,",",IND)
  1.  . S NSD=0
  1.  . S FN=GBL(LI)
  1.  . S RTN=ROUTINE(FN)
  1.  . S RTN=RTN_"("_FN_",.NSD)"
  1.  . S START=$H
  1.  . I $D(^PXRMINDX(FN)) D @RTN
  1.  . S END=$H
  1.  . D MESSAGE(FN,NSD,START,END)
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. TASKIT(LIST,GBL,ROUTINE) ;Check 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(DTOUT)!$D(DUOUT) Q
  1.  S SDTIME=Y
  1.  K DIR
  1.  ;Put the task into the queue.
  1.  K ZTSAVE
  1.  S ZTSAVE("LIST")=""
  1.  S ZTSAVE("GBL(")=""
  1.  S ZTRTN="TASKJOB^PXRMINDD"
  1.  S ZTDESC="Clinical Reminders Index string date check"
  1.  S ZTDTH=SDTIME
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  W !,"Task number ",ZTSK," queued."
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
  1.  N IND,LI,NUM
  1.  S ZTREQ="@"
  1.  S ZTSTOP=0
  1.  S NUM=$L(LIST,",")-1
  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.  . D RUNNOW^PXRMINDD(LI,.GBL)
  1.  Q
  1.  ;