source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDD.m@ 1754

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1PXRMINDD ; SLC/PKR - Index string date checking routines. ;03/06/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
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, 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 ;========================================================
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(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 ;===============================================================
202TASKIT(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 ;===============================================================
227TASKJOB ;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 ;
Note: See TracBrowser for help on using the repository browser.