source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSXRM.m@ 1211

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

revised back to 6/30/08 version

File size: 5.8 KB
Line 
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 TracBrowser for help on using the repository browser.