Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDD.m

    r613 r623  
    1 PXRMINDD        ; SLC/PKR - Index string date checking routines. ;03/06/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ;========================================================
    5 CNT5(FILENUM,NSD)       ;Check for string dates for indexes where the date
    6         ;is at subscript 5. Works for file numbers:
    7         ;63, 70, 120.5, 601.2, 601.84
    8         ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
    9         N DAS,DATE,DFN,IND,ITEM
    10         I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
    11         S IND=0
    12         S DFN=""
    13         F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
    14         . S IND=IND+1
    15         . I '$D(ZTQUEUED),(IND#10000=0) W "."
    16         . S ITEM=""
    17         . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
    18         .. S DATE=""
    19         .. F  S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
    20         ... I +DATE=DATE Q
    21         ... S DAS=""
    22         ... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS=""  D
    23         .... S NSD=NSD+1
    24         .... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_DATE_""","_DAS_")"
    25         Q
    26         ;
    27         ;========================================================
    28 CNT6(FILENUM,NSD)       ;Check for string dates for indexes where the date
    29         ;is at subscript 6. Works for file numbers:
    30         ;9000010.07, 9000010.18
    31         N DAS,DATE,DFN,IND,ITEM,TYPE
    32         I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
    33         S IND=0
    34         S DFN=""
    35         F  S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN=""  D
    36         . S IND=IND+1
    37         . I '$D(ZTQUEUED),(IND#10000=0) W "."
    38         . S TYPE=""
    39         . F  S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE=""  D
    40         .. S ITEM=""
    41         .. F  S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM=""  D
    42         ... S DATE=""
    43         ... F  S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
    44         .... I +DATE=DATE Q
    45         .... S DAS=""
    46         .... F  S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS=""  D
    47         ..... S NSD=NSD+1
    48         ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
    49         Q
    50         ;
    51         ;========================================================
    52 CNTPL(FILENUM,NSD)      ;Check for string date for Problem List indexes where the
    53         ;date is at subscript 7. Works for file numbers:
    54         ;9000011
    55         N DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE
    56         I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
    57         S IND=0
    58         S DFN=""
    59         F  S DFN=$O(^PXRMINDX(FILENUM,"PSPI",DFN)) Q:DFN=""  D
    60         . S IND=IND+1
    61         . I '$D(ZTQUEUED),(IND#10000=0) W "."
    62         . S STATUS=""
    63         . F  S STATUS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS)) Q:STATUS=""  D
    64         .. S PRIORITY=""
    65         .. F  S PRIORITY=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
    66         ... S ITEM=""
    67         ... F  S ITEM=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM=""  D
    68         .... S DATE=""
    69         .... F  S DATE=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
    70         ..... I +DATE=DATE Q
    71         ..... S DAS=""
    72         ..... F  S DAS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS=""  D
    73         ...... S NSD=NSD+1
    74         ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PSPI"","_DFN_","_STATUS_","_PRIORITY_","_ITEM_","""_DATE_""","_DAS_")"
    75         Q
    76         ;
    77         ;========================================================
    78 CNTPTF(FILENUM,NSD)     ;Check for string dates for PTF indexes where the
    79         ;date is at subscript 7. Works for file numbers:
    80         ;45
    81         N DAS,DATE,DFN,IND,ITEM,NODE,TYPE
    82         I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
    83         S IND=0
    84         F TYPE="ICD0","ICD9" D
    85         . S DFN=""
    86         . F  S DFN=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN)) Q:DFN=""  D
    87         .. S IND=IND+1
    88         .. I '$D(ZTQUEUED),(IND#10000=0) W "."
    89         .. S NODE=""
    90         .. F  S NODE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE)) Q:NODE=""  D
    91         ... S ITEM=""
    92         ... F  S ITEM=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM)) Q:ITEM=""  D
    93         .... S DATE=""
    94         .... F  S DATE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE=""  D
    95         ..... I +DATE=DATE Q
    96         ..... S DAS=""
    97         ..... F  S DAS=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS=""  D
    98         ...... S NSD=NSD+1
    99         ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_TYPE_",""PNI"","_DFN_","_NODE_","_ITEM_","""_DATE_""","_DAS_")"
    100         Q
    101         ;
    102         ;========================================================
    103 CNTSS(FILENUM,NSD)      ;Check for string dates for indexes where the start date
    104         ;is at subscript 5 and the stop date is at subscript 6.
    105         ;Works for file numbers: 52, 55, 100
    106         N DAS,DFN,IND,ITEM,START,STOP
    107         I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
    108         S IND=0
    109         S DFN=""
    110         F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
    111         . S IND=IND+1
    112         . I '$D(ZTQUEUED),(IND#10000=0) W "."
    113         . S ITEM=""
    114         . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
    115         .. S START=""
    116         .. F  S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START=""  D
    117         ... I +START=START Q
    118         ... S STOP=""
    119         ... F  S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP=""  D
    120         .... S DAS=""
    121         .... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS=""  D
    122         ..... S NSD=NSD+1
    123         ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_START_""","_STOP_","_DAS_")"
    124         Q
    125         ;
    126         ;========================================================
    127 CHECK   ;Driver for making index date checks.
    128         N GBL,LIST,TASKIT
    129         W !,"Which indexes do you want to check?"
    130         D SEL^PXRMSXRM(.LIST,.GBL)
    131         I LIST="" Q
    132         ;See if this should be tasked.
    133         S TASKIT=$$ASKTASK^PXRMSXRM
    134         I TASKIT D
    135         . W !,"Queue the Clinical Reminders Index date check."
    136         . D TASKIT(LIST,.GBL,.ROUTINE)
    137         E  D RUNNOW(LIST,.GBL)
    138         Q
    139         ;
    140         ;========================================================
    141 MESSAGE(FILENUM,NSD,START,END)  ;Build the MailMan message giving the
    142         ;list of entries with string dates.
    143         N IND,NAME,NL,TEXT,XMSUB
    144         K ^TMP("PXRMXMZ",$J)
    145         S XMSUB="CR Index string date check for file #"_FILENUM
    146         S NAME=$$GET1^DID(FILENUM,"","","NAME")_", file #"_FILENUM
    147         I NSD=0 S TEXT="No string dates were found for "_NAME_"."
    148         I NSD>0 S TEXT="A total of "_NSD_" string dates were found for "_NAME_"."
    149         S ^TMP("PXRMXMZ",$J,1,0)=TEXT
    150         S ^TMP("PXRMXMZ",$J,2,0)="Check finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
    151         S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
    152         S ^TMP("PXRMXMZ",$J,4,0)=" "
    153         I NSD=0,'$D(^PXRMINDX(FILENUM)) D
    154         . S ^TMP("PXRMXMZ",$J,5,0)="The index for file number "_FILENUM_" does not exist."
    155         . S ^TMP("PXRMXMZ",$J,6,0)=" "
    156         I NSD>0 D
    157         . S ^TMP("PXRMXMZ",$J,5,0)="The following entries with string dates were found:"
    158         . S NL=5
    159         . F IND=1:1:NSD D
    160         .. S NL=NL+1
    161         .. S ^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDATE",IND)
    162         . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
    163         D SEND^PXRMMSG(XMSUB)
    164         K ^TMP($J,"SDATE"),^TMP("PXRMXMZ",$J)
    165         Q
    166         ;
    167         ;===============================================================
    168 RUNNOW(LIST,GBL)        ;Run the routines now.
    169         N END,FN,IND,LI,NSD,NUM,ROUTINE,RTN,START,TOTAL
    170         K ^TMP($J,"SDATE")
    171         S ROUTINE(45)="CNTPTF^PXRMINDD"
    172         S ROUTINE(52)="CNTSS^PXRMINDD"
    173         S ROUTINE(55)="CNTSS^PXRMINDD"
    174         S ROUTINE(63)="CNT5^PXRMINDD"
    175         S ROUTINE(70)="CNT5^PXRMINDD"
    176         S ROUTINE(100)="CNTSS^PXRMINDD"
    177         S ROUTINE(120.5)="CNT5^PXRMINDD"
    178         S ROUTINE(601.2)="CNT5^PXRMINDD"
    179         S ROUTINE(601.84)="CNT5^PXRMINDD"
    180         S ROUTINE(9000011)="CNTPL^PXRMINDD"
    181         S ROUTINE(9000010.07)="CNT6^PXRMINDD"
    182         S ROUTINE(9000010.11)="CNT5^PXRMINDD"
    183         S ROUTINE(9000010.12)="CNT5^PXRMINDD"
    184         S ROUTINE(9000010.13)="CNT5^PXRMINDD"
    185         S ROUTINE(9000010.16)="CNT5^PXRMINDD"
    186         S ROUTINE(9000010.18)="CNT6^PXRMINDD"
    187         S ROUTINE(9000010.23)="CNT5^PXRMINDD"
    188         S NUM=$L(LIST,",")-1
    189         F IND=1:1:NUM D
    190         . S LI=$P(LIST,",",IND)
    191         . S NSD=0
    192         . S FN=GBL(LI)
    193         . S RTN=ROUTINE(FN)
    194         . S RTN=RTN_"("_FN_",.NSD)"
    195         . S START=$H
    196         . I $D(^PXRMINDX(FN)) D @RTN
    197         . S END=$H
    198         . D MESSAGE(FN,NSD,START,END)
    199         Q
    200         ;
    201         ;===============================================================
    202 TASKIT(LIST,GBL,ROUTINE)        ;Check the indexes as a tasked job.
    203         N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
    204         S MINDT=$$NOW^XLFDT
    205         S DIR("A",1)="Enter the date and time you want the job to start."
    206         S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
    207         S DIR("A")="Start the task at: "
    208         S DIR(0)="DAU"_U_MINDT_"::RSX"
    209         D ^DIR
    210         I $D(DIROUT)!$D(DIRUT) Q
    211         I $D(DTOUT)!$D(DUOUT) Q
    212         S SDTIME=Y
    213         K DIR
    214         ;Put the task into the queue.
    215         K ZTSAVE
    216         S ZTSAVE("LIST")=""
    217         S ZTSAVE("GBL(")=""
    218         S ZTRTN="TASKJOB^PXRMINDD"
    219         S ZTDESC="Clinical Reminders Index string date check"
    220         S ZTDTH=SDTIME
    221         S ZTIO=""
    222         D ^%ZTLOAD
    223         W !,"Task number ",ZTSK," queued."
    224         Q
    225         ;
    226         ;===============================================================
    227 TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
    228         N IND,LI,NUM
    229         S ZTREQ="@"
    230         S ZTSTOP=0
    231         S NUM=$L(LIST,",")-1
    232         F IND=1:1:NUM D
    233         .;Check to see if the task has had a stop request
    234         . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
    235         . S LI=$P(LIST,",",IND)_","
    236         . D RUNNOW^PXRMINDD(LI,.GBL)
    237         Q
    238         ;
     1PXRMINDD ; SLC/PKR - Index string date checking routines. ;05/02/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ;========================================================
     5CNT5(FILENUM,NSD) ;Check for string dates for indexes where the date
     6 ;is at subscript 5. Works for file numbers:
     7 ;63, 70, 120.5, 601.2,
     8 ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
     9 N DAS,DATE,DFN,IND,ITEM
     10 I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
     11 S IND=0
     12 S DFN=""
     13 F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
     14 . S IND=IND+1
     15 . I '$D(ZTQUEUED),(IND#10000=0) W "."
     16 . S ITEM=""
     17 . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
     18 .. S DATE=""
     19 .. F  S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
     20 ... I +DATE=DATE Q
     21 ... S DAS=""
     22 ... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS=""  D
     23 .... S NSD=NSD+1
     24 .... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_DATE_""","_DAS_")"
     25 Q
     26 ;
     27 ;========================================================
     28CNT6(FILENUM,NSD) ;Check for string dates for indexes where the date
     29 ;is at subscript 6. Works for file numbers:
     30 ;9000010.07, 9000010.18
     31 N DAS,DATE,DFN,IND,ITEM,TYPE
     32 I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
     33 S IND=0
     34 S DFN=""
     35 F  S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN=""  D
     36 . S IND=IND+1
     37 . I '$D(ZTQUEUED),(IND#10000=0) W "."
     38 . S TYPE=""
     39 . F  S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE=""  D
     40 .. S ITEM=""
     41 .. F  S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM=""  D
     42 ... S DATE=""
     43 ... F  S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE=""  D
     44 .... I +DATE=DATE Q
     45 .... S DAS=""
     46 .... F  S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS=""  D
     47 ..... S NSD=NSD+1
     48 ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
     49 Q
     50 ;
     51 ;========================================================
     52CNTPL(FILENUM,NSD) ;Check for string date for Problem List indexes where the
     53 ;date is at subscript 7. Works for file numbers:
     54 ;9000011
     55 N DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE
     56 I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
     57 S IND=0
     58 S DFN=""
     59 F  S DFN=$O(^PXRMINDX(FILENUM,"PSPI",DFN)) Q:DFN=""  D
     60 . S IND=IND+1
     61 . I '$D(ZTQUEUED),(IND#10000=0) W "."
     62 . S STATUS=""
     63 . F  S STATUS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS)) Q:STATUS=""  D
     64 .. S PRIORITY=""
     65 .. F  S PRIORITY=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
     66 ... S ITEM=""
     67 ... F  S ITEM=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM=""  D
     68 .... S DATE=""
     69 .... F  S DATE=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
     70 ..... I +DATE=DATE Q
     71 ..... S DAS=""
     72 ..... F  S DAS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS=""  D
     73 ...... S NSD=NSD+1
     74 ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PSPI"","_DFN_","_STATUS_","_PRIORITY_","_ITEM_","""_DATE_""","_DAS_")"
     75 Q
     76 ;
     77 ;========================================================
     78CNTPTF(FILENUM,NSD) ;Check for string dates for PTF indexes where the
     79 ;date is at subscript 7. Works for file numbers:
     80 ;45
     81 N DAS,DATE,DFN,IND,ITEM,NODE,TYPE
     82 I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
     83 S IND=0
     84 F TYPE="ICD0","ICD9" D
     85 . S DFN=""
     86 . F  S DFN=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN)) Q:DFN=""  D
     87 .. S IND=IND+1
     88 .. I '$D(ZTQUEUED),(IND#10000=0) W "."
     89 .. S NODE=""
     90 .. F  S NODE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE)) Q:NODE=""  D
     91 ... S ITEM=""
     92 ... F  S ITEM=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM)) Q:ITEM=""  D
     93 .... S DATE=""
     94 .... F  S DATE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE=""  D
     95 ..... I +DATE=DATE Q
     96 ..... S DAS=""
     97 ..... F  S DAS=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS=""  D
     98 ...... S NSD=NSD+1
     99 ...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_TYPE_",""PNI"","_DFN_","_NODE_","_ITEM_","""_DATE_""","_DAS_")"
     100 Q
     101 ;
     102 ;========================================================
     103CNTSS(FILENUM,NSD) ;Check for string dates for indexes where the start date
     104 ;is at subscript 5 and the stop date is at subscript 6.
     105 ;Works for file numbers: 52, 55, 100
     106 N DAS,DFN,IND,ITEM,START,STOP
     107 I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
     108 S IND=0
     109 S DFN=""
     110 F  S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN=""  D
     111 . S IND=IND+1
     112 . I '$D(ZTQUEUED),(IND#10000=0) W "."
     113 . S ITEM=""
     114 . F  S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM=""  D
     115 .. S START=""
     116 .. F  S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START=""  D
     117 ... I +START=START Q
     118 ... S STOP=""
     119 ... F  S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP=""  D
     120 .... S DAS=""
     121 .... F  S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS=""  D
     122 ..... S NSD=NSD+1
     123 ..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_START_""","_STOP_","_DAS_")"
     124 Q
     125 ;
     126 ;========================================================
     127CHECK ;Driver for making index date checks.
     128 N GBL,LIST,TASKIT
     129 W !,"Which indexes do you want to check?"
     130 D SEL^PXRMSXRM(.LIST,.GBL)
     131 I LIST="" Q
     132 ;See if this should be tasked.
     133 S TASKIT=$$ASKTASK^PXRMSXRM
     134 I TASKIT D
     135 . W !,"Queue the Clinical Reminders Index date check."
     136 . D TASKIT(LIST,.GBL,.ROUTINE)
     137 E  D RUNNOW(LIST,.GBL)
     138 Q
     139 ;
     140 ;========================================================
     141MESSAGE(FILENUM,NSD,START,END) ;Build the MailMan message giving the
     142 ;list of entries with string dates.
     143 N IND,NAME,NL,TEXT,XMSUB
     144 K ^TMP("PXRMXMZ",$J)
     145 S XMSUB="CR Index string date check for file #"_FILENUM
     146 S NAME=$$GET1^DID(FILENUM,"","","NAME")_", file #"_FILENUM
     147 I NSD=0 S TEXT="No string dates were found for "_NAME_"."
     148 I NSD>0 S TEXT="A total of "_NSD_" string dates were found for "_NAME_"."
     149 S ^TMP("PXRMXMZ",$J,1,0)=TEXT
     150 S ^TMP("PXRMXMZ",$J,2,0)="Check finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
     151 S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
     152 S ^TMP("PXRMXMZ",$J,4,0)=" "
     153 I NSD=0,'$D(^PXRMINDX(FILENUM)) D
     154 . S ^TMP("PXRMXMZ",$J,5,0)="The index for file number "_FILENUM_" does not exist."
     155 . S ^TMP("PXRMXMZ",$J,6,0)=" "
     156 I NSD>0 D
     157 . S ^TMP("PXRMXMZ",$J,5,0)="The following entries with string dates were found:"
     158 . S NL=5
     159 . F IND=1:1:NSD D
     160 .. S NL=NL+1
     161 .. S ^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDATE",IND)
     162 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
     163 D SEND^PXRMMSG(XMSUB)
     164 K ^TMP($J,"SDATE"),^TMP("PXRMXMZ",$J)
     165 Q
     166 ;
     167 ;===============================================================
     168RUNNOW(LIST,GBL) ;Run the routines now.
     169 N END,FN,IND,LI,NSD,NUM,ROUTINE,RTN,START,TOTAL
     170 K ^TMP($J,"SDATE")
     171 S ROUTINE(45)="CNTPTF^PXRMINDD"
     172 S ROUTINE(52)="CNTSS^PXRMINDD"
     173 S ROUTINE(55)="CNTSS^PXRMINDD"
     174 S ROUTINE(63)="CNT5^PXRMINDD"
     175 S ROUTINE(70)="CNT5^PXRMINDD"
     176 S ROUTINE(100)="CNTSS^PXRMINDD"
     177 S ROUTINE(120.5)="CNT5^PXRMINDD"
     178 S ROUTINE(601.2)="CNT5^PXRMINDD"
     179 S ROUTINE(9000011)="CNTPL^PXRMINDD"
     180 S ROUTINE(9000010.07)="CNT6^PXRMINDD"
     181 S ROUTINE(9000010.11)="CNT5^PXRMINDD"
     182 S ROUTINE(9000010.12)="CNT5^PXRMINDD"
     183 S ROUTINE(9000010.13)="CNT5^PXRMINDD"
     184 S ROUTINE(9000010.16)="CNT5^PXRMINDD"
     185 S ROUTINE(9000010.18)="CNT6^PXRMINDD"
     186 S ROUTINE(9000010.23)="CNT5^PXRMINDD"
     187 S NUM=$L(LIST,",")-1
     188 F IND=1:1:NUM D
     189 . S LI=$P(LIST,",",IND)
     190 . S NSD=0
     191 . S FN=GBL(LI)
     192 . S RTN=ROUTINE(FN)
     193 . S RTN=RTN_"("_FN_",.NSD)"
     194 . S START=$H
     195 . I $D(^PXRMINDX(FN)) D @RTN
     196 . S END=$H
     197 . D MESSAGE(FN,NSD,START,END)
     198 Q
     199 ;
     200 ;===============================================================
     201TASKIT(LIST,GBL,ROUTINE) ;Check the indexes as a tasked job.
     202 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
     203 S MINDT=$$NOW^XLFDT
     204 S DIR("A",1)="Enter the date and time you want the job to start."
     205 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
     206 S DIR("A")="Start the task at: "
     207 S DIR(0)="DAU"_U_MINDT_"::RSX"
     208 D ^DIR
     209 I $D(DIROUT)!$D(DIRUT) Q
     210 I $D(DTOUT)!$D(DUOUT) Q
     211 S SDTIME=Y
     212 K DIR
     213 ;Put the task into the queue.
     214 K ZTSAVE
     215 S ZTSAVE("LIST")=""
     216 S ZTSAVE("GBL(")=""
     217 S ZTRTN="TASKJOB^PXRMINDD"
     218 S ZTDESC="Clinical Reminders Index string date check"
     219 S ZTDTH=SDTIME
     220 S ZTIO=""
     221 D ^%ZTLOAD
     222 W !,"Task number ",ZTSK," queued."
     223 Q
     224 ;
     225 ;===============================================================
     226TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
     227 N IND,LI,NUM
     228 S ZTREQ="@"
     229 S ZTSTOP=0
     230 S NUM=$L(LIST,",")-1
     231 F IND=1:1:NUM D
     232 .;Check to see if the task has had a stop request
     233 . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
     234 . S LI=$P(LIST,",",IND)_","
     235 . D RUNNOW^PXRMINDD(LI,.GBL)
     236 Q
     237 ;
Note: See TracChangeset for help on using the changeset viewer.