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/PXRMSXRM.m

    r613 r623  
    1 PXRMSXRM        ; SLC/PKR - Main driver for building indexes. ;11/23/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;
    4         ;==========================================
    5 ADDERROR(GLOBAL,IDEN,NERROR)    ;Add to the error list.
    6         S NERROR=NERROR+1
    7         S ^TMP("PXRMERROR",$J,NERROR,0)="GLOBAL: "_GLOBAL_" ENTRY: "_IDEN
    8         Q
    9         ;
    10         ;==========================================
    11 ASKTASK()       ;See if this should be tasked.
    12         N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
    13         S DIR(0)="YO"
    14         S DIR("A")="Do you want this to be tasked"
    15         S DIR("B")="Y"
    16         D ^DIR
    17         I $D(DIROUT)!$D(DIRUT) Q ""
    18         I $D(DUOUT)!$D(DTOUT) Q ""
    19         Q Y
    20         ;
    21         ;==========================================
    22 COMMSG(GLOBAL,START,END,NE,NERROR)      ;Send a MailMan message providing
    23         ;notification that the indexing completed.
    24         N XMSUB
    25         K ^TMP("PXRMXMZ",$J)
    26         S XMSUB="Index for global "_GLOBAL_" sucessfully built"
    27         S ^TMP("PXRMXMZ",$J,1,0)="Build of Clinical Reminders index for global "_GLOBAL_" completed."
    28         S ^TMP("PXRMXMZ",$J,2,0)="Build finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
    29         S ^TMP("PXRMXMZ",$J,3,0)=NE_" entries were created."
    30         S ^TMP("PXRMXMZ",$J,4,0)=$$ETIME(START,END)
    31         S ^TMP("PXRMXMZ",$J,5,0)=NERROR_" errors were encountered."
    32         I NERROR>0 S ^TMP("PXRMXMZ",$J,6,0)="Another MailMan message will contain the error information."
    33         D SEND^PXRMMSG(XMSUB)
    34         Q
    35         ;
    36         ;==========================================
    37 DETIME(START,END)       ;Write out the elapsed time.
    38         ;START and END are $H times.
    39         N TEXT
    40         S TEXT=$$ETIME(START,END)
    41         D MES^XPDUTL(TEXT)
    42         Q
    43         ;
    44         ;==========================================
    45 ERRMSG(NERROR,GLOBAL)   ;If there were errors send an error message.
    46         N END,IND,MAXERR,NE,XMSUB
    47         I NERROR=0 Q
    48         ;Return the last MAXERR errors
    49         S MAXERR=+$G(^PXRM(800,1,"MIERR"))
    50         I MAXERR=0 S MAXERR=200
    51         K ^TMP("PXRMXMZ",$J)
    52         S END=$S(NERROR'>MAXERR:NERROR,1:MAXERR)
    53         S NE=NERROR+1
    54         F IND=1:1:END S NE=NE-1,^TMP("PXRMXMZ",$J,IND,0)=^TMP("PXRMERROR",$J,NE,0)
    55         I END=MAXERR S ^TMP("PXRMXMZ",$J,MAXERR+1,0)="GLOBAL: "_GLOBAL_"- Maximum number of errors reached, will not report any more."
    56         K ^TMP("PXRMERROR",$J)
    57         S XMSUB="CLINICAL REMINDER INDEX BUILD ERROR(S) FOR GLOBAL "_GLOBAL
    58         D SEND^PXRMMSG(XMSUB)
    59         Q
    60         ;
    61         ;==========================================
    62 ETIME(START,END)        ;Calculate and format the elapsed time.
    63         ;START and END are $H times.
    64         N ETIME,TEXT
    65         S ETIME=$$HDIFF^XLFDT(END,START,2)
    66         I ETIME>90 D
    67         . S ETIME=$$HDIFF^XLFDT(END,START,3)
    68         . S TEXT="Elapsed time: "_ETIME
    69         E  S TEXT="Elapsed time: "_ETIME_" secs"
    70         Q TEXT
    71         ;
    72         ;==========================================
    73 INDEX   ;Driver for building the various indexes.
    74         N GBL,LIST,ROUTINE,TASKIT
    75         S ROUTINE(45)="INDEX^DGPTDDCR" ;DBIA #4521
    76         S ROUTINE(52)="PSRX^PSOPXRMI"  ;DBIA #4522
    77         S ROUTINE(55)="PSPA^PSSSXRD"   ;DBIA #4172
    78         S ROUTINE(63)="LAB^LRPXSXRL"   ;DBIA #4247
    79         S ROUTINE(70)="RAD^RAPXRM"     ;DBIA #3731
    80         S ROUTINE(100)="INDEX^ORPXRM"  ;DBIA #4498
    81         S ROUTINE(120.5)="VITALS^GMVPXRM"  ;DBIA #3647
    82         S ROUTINE(601.2)="INDEX^YTPXRM" ;DBIA #4523
    83         S ROUTINE(601.84)="INDEX^YTQPXRM" ;DBIA #5055
    84         S ROUTINE(9000011)="INDEX^GMPLPXRM" ;DBIA #4516
    85         S ROUTINE(9000010.07)="VPOV^PXPXRMI2" ;DBIA #4520
    86         S ROUTINE(9000010.11)="VIMM^PXPXRMI1" ;DBIA #4519
    87         S ROUTINE(9000010.12)="VSK^PXPXRMI2"  ;DBIA #4520
    88         S ROUTINE(9000010.13)="VXAM^PXPXRMI2" ;DBIA #4520
    89         S ROUTINE(9000010.16)="VPED^PXPXRMI2" ;DBIA #4520
    90         S ROUTINE(9000010.18)="VCPT^PXPXRMI1" ;DBIA #4519
    91         S ROUTINE(9000010.23)="VHF^PXPXRMI1"  ;DBIA #4519
    92         ;Get the list
    93         W !,"Which indexes do you want to (re)build?"
    94         D SEL(.LIST,.GBL)
    95         I LIST="" Q
    96         ;See if this should be tasked.
    97         S TASKIT=$$ASKTASK
    98         I TASKIT="" Q
    99         I TASKIT D
    100         . W !,"Queue the Clinical Reminders index job."
    101         . D TASKIT(LIST,.GBL,.ROUTINE)
    102         E  D RUNNOW(LIST,.GBL,.ROUTINE)
    103         Q
    104         ;
    105         ;==========================================
    106 RUNNOW(LIST,GBL,ROUTINE)        ;Run the routines now.
    107         N IND,LI,NUM,RTN
    108         S NUM=$L(LIST,",")-1
    109         F IND=1:1:NUM D
    110         . S LI=$P(LIST,",",IND)
    111         . S RTN=ROUTINE(GBL(LI))
    112         . D @RTN
    113         Q
    114         ;
    115         ;==========================================
    116 SEL(LIST,GBL)   ;Select global list
    117         N ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,INUM,X,Y
    118         S INUM=1,ALIST(INUM)="  "_INUM_" - LABORATORY TEST (CH, Anatomic Path, Micro)",GBL(INUM)=63
    119         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - MENTAL HEALTH",GBL(INUM)=601.2
    120         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - MENTAL HEALTH (MHA3)",GBL(INUM)=601.84
    121         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - ORDER",GBL(INUM)=100
    122         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - PTF",GBL(INUM)=45
    123         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - PHARMACY PATIENT",GBL(INUM)=55
    124         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - PRESCRIPTION",GBL(INUM)=52
    125         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - PROBLEM LIST",GBL(INUM)=9000011
    126         S INUM=INUM+1,ALIST(INUM)="  "_INUM_" - RADIOLOGY",GBL(INUM)=70
    127         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V CPT",GBL(INUM)=9000010.18
    128         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V EXAM",GBL(INUM)=9000010.13
    129         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V HEALTH FACTORS",GBL(INUM)=9000010.23
    130         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V IMMUNIZATION",GBL(INUM)=9000010.11
    131         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V PATIENT ED",GBL(INUM)=9000010.16
    132         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V POV",GBL(INUM)=9000010.07
    133         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - V SKIN TEST",GBL(INUM)=9000010.12
    134         S INUM=INUM+1,ALIST(INUM)=" "_INUM_" - VITAL MEASUREMENT",GBL(INUM)=120.5
    135         M DIR("A")=ALIST
    136         S DIR("A")="Enter your list"
    137         S DIR(0)="LO^1:"_INUM
    138         D ^DIR
    139         I $D(DIROUT)!$D(DIRUT) S LIST="" Q
    140         I $D(DUOUT)!$D(DTOUT) S LIST="" Q
    141         S LIST=Y
    142         Q
    143         ;
    144         ;==========================================
    145 TASKIT(LIST,GBL,ROUTINE)        ;Build the indexes as a tasked job.
    146         N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
    147         S MINDT=$$NOW^XLFDT
    148         S DIR("A",1)="Enter the date and time you want the job to start."
    149         S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
    150         S DIR("A")="Start the task at: "
    151         S DIR(0)="DAU"_U_MINDT_"::RSX"
    152         D ^DIR
    153         I $D(DIROUT)!$D(DIRUT) Q
    154         I $D(DUOUT)!$D(DTOUT) Q
    155         S SDTIME=Y
    156         ;Put the task into the queue.
    157         K ZTSAVE
    158         S ZTSAVE("LIST")=""
    159         S ZTSAVE("GBL(")=""
    160         S ZTSAVE("ROUTINE(")=""
    161         S ZTRTN="TASKJOB^PXRMSXRM"
    162         S ZTDESC="Clinical Reminders index build"
    163         S ZTDTH=SDTIME
    164         S ZTIO=""
    165         D ^%ZTLOAD
    166         W !,"Task number ",ZTSK," queued."
    167         Q
    168         ;
    169         ;==========================================
    170 TASKJOB ;Execute as tasked job. LIST, GBL, and ROUTINE come through
    171         ;ZTSAVE.
    172         N IND,LI,NUM,RTN
    173         S ZTREQ="@"
    174         S ZTSTOP=0
    175         S NUM=$L(LIST,",")-1
    176         F IND=1:1:NUM D
    177         .;Check to see if the task has had a stop request
    178         . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
    179         . S LI=$P(LIST,",",IND)
    180         . S RTN=ROUTINE(GBL(LI))
    181         . D @RTN
    182         Q
    183         ;
     1PXRMSXRM ; SLC/PKR - Main driver for building indexes. ;12/20/2004
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;
     4 ;==========================================
     5ADDERROR(GLOBAL,IDEN,NERROR) ;Add to the error list.
     6 S NERROR=NERROR+1
     7 S ^TMP("PXRMERROR",$J,NERROR,0)="GLOBAL: "_GLOBAL_" ENTRY: "_IDEN
     8 Q
     9 ;
     10 ;==========================================
     11ASKTASK() ;See if this should be tasked.
     12 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
     13 S DIR(0)="YO"
     14 S DIR("A")="Do you want this to be tasked"
     15 S DIR("B")="Y"
     16 D ^DIR
     17 I $D(DIROUT)!$D(DIRUT) Q ""
     18 I $D(DUOUT)!$D(DTOUT) Q ""
     19 Q Y
     20 ;
     21 ;==========================================
     22COMMSG(GLOBAL,START,END,NE,NERROR) ;Send a MailMan message providing
     23 ;notification that the indexing completed.
     24 N XMSUB
     25 K ^TMP("PXRMXMZ",$J)
     26 S XMSUB="Index for global "_GLOBAL_" sucessfully built"
     27 S ^TMP("PXRMXMZ",$J,1,0)="Build of Clinical Reminders index for global "_GLOBAL_" completed."
     28 S ^TMP("PXRMXMZ",$J,2,0)="Build finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
     29 S ^TMP("PXRMXMZ",$J,3,0)=NE_" entries were created."
     30 S ^TMP("PXRMXMZ",$J,4,0)=$$ETIME(START,END)
     31 S ^TMP("PXRMXMZ",$J,5,0)=NERROR_" errors were encountered."
     32 I NERROR>0 S ^TMP("PXRMXMZ",$J,6,0)="Another MailMan message will contain the error information."
     33 D SEND^PXRMMSG(XMSUB)
     34 Q
     35 ;
     36 ;==========================================
     37DETIME(START,END) ;Write out the elapsed time.
     38 ;START and END are $H times.
     39 N TEXT
     40 S TEXT=$$ETIME(START,END)
     41 D MES^XPDUTL(TEXT)
     42 Q
     43 ;
     44 ;==========================================
     45ERRMSG(NERROR,GLOBAL) ;If there were errors send an error message.
     46 N END,IND,MAXERR,NE,XMSUB
     47 I NERROR=0 Q
     48 ;Return the last MAXERR errors
     49 S MAXERR=+$G(^PXRM(800,1,"MIERR"))
     50 I MAXERR=0 S MAXERR=200
     51 K ^TMP("PXRMXMZ",$J)
     52 S END=$S(NERROR'>MAXERR:NERROR,1:MAXERR)
     53 S NE=NERROR+1
     54 F IND=1:1:END S NE=NE-1,^TMP("PXRMXMZ",$J,IND,0)=^TMP("PXRMERROR",$J,NE,0)
     55 I END=MAXERR S ^TMP("PXRMXMZ",$J,MAXERR+1,0)="GLOBAL: "_GLOBAL_"- Maximum number of errors reached, will not report any more."
     56 K ^TMP("PXRMERROR",$J)
     57 S XMSUB="CLINICAL REMINDER INDEX BUILD ERROR(S) FOR GLOBAL "_GLOBAL
     58 D SEND^PXRMMSG(XMSUB)
     59 Q
     60 ;
     61 ;==========================================
     62ETIME(START,END) ;Calculate and format the elapsed time.
     63 ;START and END are $H times.
     64 N ETIME,TEXT
     65 S ETIME=$$HDIFF^XLFDT(END,START,2)
     66 I ETIME>90 D
     67 . S ETIME=$$HDIFF^XLFDT(END,START,3)
     68 . S TEXT="Elapsed time: "_ETIME
     69 E  S TEXT="Elapsed time: "_ETIME_" secs"
     70 Q TEXT
     71 ;
     72 ;==========================================
     73INDEX ;Driver for building the various indexes.
     74 N GBL,LIST,ROUTINE,TASKIT
     75 S ROUTINE(45)="INDEX^DGPTDDCR" ;DBIA #4521
     76 S ROUTINE(52)="PSRX^PSOPXRMI"  ;DBIA #4522
     77 S ROUTINE(55)="PSPA^PSSSXRD"   ;DBIA #4172
     78 S ROUTINE(63)="LAB^LRPXSXRL"   ;DBIA #4247
     79 S ROUTINE(70)="RAD^RAPXRM"     ;DBIA #3731
     80 S ROUTINE(100)="INDEX^ORPXRM"  ;DBIA #4498
     81 S ROUTINE(120.5)="VITALS^GMVPXRM"  ;DBIA #3647
     82 S ROUTINE(601.2)="INDEX^YTPXRM" ;DBIA #4523
     83 S ROUTINE(9000011)="INDEX^GMPLPXRM" ;DBIA #4516
     84 S ROUTINE(9000010.07)="VPOV^PXPXRMI2" ;DBIA #4520
     85 S ROUTINE(9000010.11)="VIMM^PXPXRMI1" ;DBIA #4519
     86 S ROUTINE(9000010.12)="VSK^PXPXRMI2"  ;DBIA #4520
     87 S ROUTINE(9000010.13)="VXAM^PXPXRMI2" ;DBIA #4520
     88 S ROUTINE(9000010.16)="VPED^PXPXRMI2" ;DBIA #4520
     89 S ROUTINE(9000010.18)="VCPT^PXPXRMI1" ;DBIA #4519
     90 S ROUTINE(9000010.23)="VHF^PXPXRMI1"  ;DBIA #4519
     91 ;Get the list
     92 W !,"Which indexes do you want to (re)build?"
     93 D SEL(.LIST,.GBL)
     94 I LIST="" Q
     95 ;See if this should be tasked.
     96 S TASKIT=$$ASKTASK
     97 I TASKIT="" Q
     98 I TASKIT D
     99 . W !,"Queue the Clinical Reminders index job."
     100 . D TASKIT(LIST,.GBL,.ROUTINE)
     101 E  D RUNNOW(LIST,.GBL,.ROUTINE)
     102 Q
     103 ;
     104 ;==========================================
     105RUNNOW(LIST,GBL,ROUTINE) ;Run the routines now.
     106 N IND,LI,NUM,RTN
     107 S NUM=$L(LIST,",")-1
     108 F IND=1:1:NUM D
     109 . S LI=$P(LIST,",",IND)
     110 . S RTN=ROUTINE(GBL(LI))
     111 . D @RTN
     112 Q
     113 ;
     114 ;==========================================
     115SEL(LIST,GBL) ;Select global list
     116 N ALIST,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
     117 S ALIST(1)="  1 - LABORATORY TEST (CH, Anatomic Path, Micro)",GBL(1)=63
     118 S ALIST(2)="  2 - MENTAL HEALTH",GBL(2)=601.2
     119 S ALIST(3)="  3 - ORDER",GBL(3)=100
     120 S ALIST(4)="  4 - PTF",GBL(4)=45
     121 S ALIST(5)="  5 - PHARMACY PATIENT",GBL(5)=55
     122 S ALIST(6)="  6 - PRESCRIPTION",GBL(6)=52
     123 S ALIST(7)="  7 - PROBLEM LIST",GBL(7)=9000011
     124 S ALIST(8)="  8 - RADIOLOGY",GBL(8)=70
     125 S ALIST(9)="  9 - V CPT",GBL(9)=9000010.18
     126 S ALIST(10)=" 10 - V EXAM",GBL(10)=9000010.13
     127 S ALIST(11)=" 11 - V HEALTH FACTORS",GBL(11)=9000010.23
     128 S ALIST(12)=" 12 - V IMMUNIZATION",GBL(12)=9000010.11
     129 S ALIST(13)=" 13 - V PATIENT ED",GBL(13)=9000010.16
     130 S ALIST(14)=" 14 - V POV",GBL(14)=9000010.07
     131 S ALIST(15)=" 15 - V SKIN TEST",GBL(15)=9000010.12
     132 S ALIST(16)=" 16 - VITAL MEASUREMENT",GBL(16)=120.5
     133 M DIR("A")=ALIST
     134 S DIR("A")="Enter your list"
     135 S DIR(0)="LO^1:16"
     136 D ^DIR
     137 I $D(DIROUT)!$D(DIRUT) S LIST="" Q
     138 I $D(DUOUT)!$D(DTOUT) S LIST="" Q
     139 S LIST=Y
     140 Q
     141 ;
     142 ;==========================================
     143TASKIT(LIST,GBL,ROUTINE) ;Build the indexes as a tasked job.
     144 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
     145 S MINDT=$$NOW^XLFDT
     146 S DIR("A",1)="Enter the date and time you want the job to start."
     147 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
     148 S DIR("A")="Start the task at: "
     149 S DIR(0)="DAU"_U_MINDT_"::RSX"
     150 D ^DIR
     151 I $D(DIROUT)!$D(DIRUT) Q
     152 I $D(DUOUT)!$D(DTOUT) Q
     153 S SDTIME=Y
     154 ;Put the task into the queue.
     155 K ZTSAVE
     156 S ZTSAVE("LIST")=""
     157 S ZTSAVE("GBL(")=""
     158 S ZTSAVE("ROUTINE(")=""
     159 S ZTRTN="TASKJOB^PXRMSXRM"
     160 S ZTDESC="Clinical Reminders index build"
     161 S ZTDTH=SDTIME
     162 S ZTIO=""
     163 D ^%ZTLOAD
     164 W !,"Task number ",ZTSK," queued."
     165 Q
     166 ;
     167 ;==========================================
     168TASKJOB ;Execute as tasked job. LIST, GBL, and ROUTINE come through
     169 ;ZTSAVE.
     170 N IND,LI,NUM,RTN
     171 S ZTREQ="@"
     172 S ZTSTOP=0
     173 S NUM=$L(LIST,",")-1
     174 F IND=1:1:NUM D
     175 .;Check to see if the task has had a stop request
     176 . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
     177 . S LI=$P(LIST,",",IND)
     178 . S RTN=ROUTINE(GBL(LI))
     179 . D @RTN
     180 Q
     181 ;
Note: See TracChangeset for help on using the changeset viewer.