source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSXRM.m@ 1611

Last change on this file since 1611 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1PXRMSXRM ; SLC/PKR - Main driver for building indexes. ;11/23/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
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(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 ;==========================================
106RUNNOW(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 ;==========================================
116SEL(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 ;==========================================
145TASKIT(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 ;==========================================
170TASKJOB ;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 ;
Note: See TracBrowser for help on using the repository browser.