source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDD.m@ 1150

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

revised back to 6/30/08 version
File size: 8.3 KB
Line 
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 TracBrowser for help on using the repository browser.