source: ccr/trunk/p/GPLRIMA.m@ 216

Last change on this file since 216 was 176, checked in by George Lilly, 16 years ago

changes for multiple directions

File size: 16.8 KB
Line 
1GPLRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
21 ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
22 ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
23 ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
24 ; CONVEYED VIA THE CCR OR CCD.
25 ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
26 ; 1. THE PRESENSE OF CLINICAL DATA IN A SECTION
27 ; 2. ARE THE DATA ELEMENTS TIME-BOUND
28 ; 3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
29 ; 4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
30 ; 5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
31 ; .. AND OTHER FACTORS YET TO BE DETERMINED
32 ;
33 ; SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
34 ; REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
35 ; CONVEYANCE TO THE RIM APPLICATION.
36 ;
37 ;
38ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
39 ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
40 ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
41 ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
42 ;
43 N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
44 N CCRGLO
45 D ASETUP ; SET UP VARIABLES AND GLOBALS
46 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
47 I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
48 S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
49 S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
50 I RIMDFN="" S RIMDFN=RESUME
51 I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS
52 . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
53 F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END
54 . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
55 . W RIMDFN,!
56 . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
57 . ;
58 . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
59 . ;
60 . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS
61 . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
62 . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
63 . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS
64 . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
65 . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS
66 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
67 . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
68 . ;
69 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
70 . ;
71 . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
72 . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
73 . ;
74 . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
75 . ;
76 . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS
77 . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
78 . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
79 . ;
80 . N CATNAME,CATTBL
81 . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
82 . S CATNAME=""
83 . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
84 . W "CATEGORY NAME: ",CATNAME,!
85 . ;
86 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
87 . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
88 . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
89 . ; AND WE SKIP IT
90 . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
91 ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
92 Q
93 ;
94SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
95 N SBASE,SATTR
96 S SBASE=$NA(@RIMBASE@("VARS",SDFN))
97 D APOST("SATTR","RIMTBL","HEADER")
98 I $D(@SBASE@("PROBLEMS",1)) D ;
99 . D APOST("SATTR","RIMTBL","PROBLEMS")
100 . ; W "POSTING PROBLEMS",!
101 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
102 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
103 . D APOST("SATTR","RIMTBL","MEDS")
104 . N ZR,ZI
105 . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
106 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
107 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
108 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
109 . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
110 D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
111 W "ATTRIBUTES: ",SATTR,!
112 Q SATTR
113 ;
114RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
115 K ^TMP("GPLRIM","RESUME")
116 K ^TMP("GPLRIM")
117 Q
118 ;
119CLIST ; LIST THE CATEGORIES
120 ;
121 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
122 N CLBASE,CLNUM,ZI,CLIDX
123 S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
124 S CLNUM=@CLBASE@(0)
125 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
126 . S CLIDX=@CLBASE@(ZI)
127 . W "(",$P(@CLBASE@(CLIDX),"^",1)
128 . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
129 . W CLIDX,!
130 ; D PARY^GPLXPATH(CLBASE)
131 Q
132 ;
133CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
134 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
135 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
136 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
137 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
138 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
139 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
140 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
141 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
142 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
143 ; NUMBER IE CTBL_X(CDFN)=""
144 ;
145 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
146 S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
147 W "CBASE: ",CCTBL,!
148 ;
149 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
150 . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
151 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
152 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
153 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
154 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
155 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
156 ;
157 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
158 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
159 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
160 ;
161 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
162 ;
163 S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
164 W "PATS BASE: ",CPATLIST,!
165 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
166 ;
167 Q
168 ;
169CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
170 ;
171 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
172 N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
173 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
174 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
175 S ZTOT=0 ; INITIALIZE OVERALL TOTAL
176 F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS
177 . S ZCNT=0
178 . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
179 . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
180 . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
181 . ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
182 . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
183 . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
184 . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
185 . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
186 . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
187 . S ZTOT=ZTOT+ZCNT
188 W "TOTAL: ",ZTOT,!
189 Q
190 ;
191CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
192 ; INLST IS PASSED BY NAME
193 N ZI,ZDX,ZCOUNT
194 W INLST,!
195 S ZCOUNT=0
196 S ZDX=""
197 F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END
198 . S ZCOUNT=ZCOUNT+1
199 . S ZDX=$O(@INLST@(ZDX))
200 . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
201 Q ZCOUNT
202 ;
203XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
204 ;
205 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
206 N ZI,ZJ,ZC,ZPATBASE
207 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
208 S ZI=""
209 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
210 . S ZI=$O(@ZPATBASE@(ZI))
211 . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
212 Q
213 ;
214CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
215 ;
216 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
217 N ZI,ZJ,ZC,ZPATBASE
218 S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
219 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
220 S ZI=""
221 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
222 . S ZI=$O(@ZPATBASE@(ZI))
223 . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
224 . W ZI," "
225 . I ZC=10 D ; NEW LINE
226 . . S ZC=0
227 . . W !
228 Q
229 ;
230PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
231 ;
232 N ATTR S ATTR=""
233 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
234 . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
235 S ATTR=^TMP("GPLRIM","ATTR",DFN)
236 I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND
237 I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT
238 . N CAT
239 . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
240 . W CAT,": ",ATTR,!
241 Q
242 ;
243APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
244 ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
245 ; AND AMAP(N)=AVAL IS THE NTH AVAL
246 ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
247 ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
248 ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
249 ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
250 ;
251 I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST
252 . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
253 S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
254 S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
255 S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
256 Q
257 ;
258ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
259 I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
260 I '$D(@RIMBASE) S @RIMBASE=""
261 I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
262 S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
263 Q
264 ;
265AINIT ; INITIALIZE ATTRIBUTE TABLE
266 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
267 K @RIMTBL
268 D APUSH(RIMTBL,"EXTRACTED")
269 D APUSH(RIMTBL,"NOTEXTRACTED")
270 D APUSH(RIMTBL,"HEADER")
271 D APUSH(RIMTBL,"NOPCP")
272 D APUSH(RIMTBL,"PCP")
273 D APUSH(RIMTBL,"PROBLEMS")
274 D APUSH(RIMTBL,"PROBCODE")
275 D APUSH(RIMTBL,"PROBNOCODE")
276 D APUSH(RIMTBL,"PROBDATE")
277 D APUSH(RIMTBL,"PROBNODATE")
278 D APUSH(RIMTBL,"VITALS")
279 D APUSH(RIMTBL,"VITALSCODE")
280 D APUSH(RIMTBL,"VITALSNOCODE")
281 D APUSH(RIMTBL,"VITALSDATE")
282 D APUSH(RIMTBL,"VITALSNODATE")
283 D APUSH(RIMTBL,"MEDS")
284 D APUSH(RIMTBL,"MEDSCODE")
285 D APUSH(RIMTBL,"MEDSNOCODE")
286 D APUSH(RIMTBL,"MEDSDATE")
287 D APUSH(RIMTBL,"MEDSNODATE")
288 Q
289 ;
290APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
291 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
292 ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
293 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
294 I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
295 N USETBL
296 I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE
297 . W "ERROR NO SUCH TABLE",!
298 S USETBL=@RIMBASE@("TABLES",PTBL)
299 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
300 Q
301GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
302 ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
303 ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
304 ; IN SECTION "MEDS"
305 ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
306 ; PENDING FOR MED 2 FOR PATIENT 2
307 ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
308 ; RETURNED. RTN IS PASSED BY REFERENCE
309 ;
310 S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
311 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
312 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
313 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION
314 . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
315 N ZZI,ZZS
316 S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
317 ; ZWR @ZZS@(1)
318 S RTN(0)=@ZZS@(0)
319 F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
320 . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
321 . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
322 Q
323 ;
324PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
325 ;
326 N ZR
327 D GETPA(.ZR,DFN,ISEC,IVAR)
328 I $D(ZR(0)) D PARY^GPLXPATH("ZR")
329 E W "NOTHING RETURNED",!
330 Q
331 ;
332CAGET(RTN,IATTR) ;
333 ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
334 ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
335 ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
336 Q
337 ;
338PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
339 ;
340 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
341 N ZLST
342 S LSTRTN(0)=0 ; DEFAULT RETURN NONE
343 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
344 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
345 N ZNC ; ZNC IS NUMBER OF CATEGORIES
346 S ZNC=@ZCBASE@(0)
347 I ZNC=0 Q ; NO CATEGORIES TO SEARCH
348 N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
349 S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
350 N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
351 F ZI=1:1:ZNC D ; FOR ALL CATEGORIES
352 . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
353 . I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR
354 . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
355 . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
356 S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
357 S ZPAT=0 ; START AT FIRST PATIENT IN LIST
358 F S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT="" D ;
359 . S ZCNT=ZCNT+1
360 S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
361 Q
362 ;
363DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
364 ;
365 N ZR
366 D PCLST(.ZR,CATTR)
367 I ZR(0)=0 D Q ;
368 . W "NO PATIENTS RETURNED",!
369 E D ;
370 . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
371 . W "COUNT=",ZR(0),!
372 Q
373 ;
374RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
375 ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
376 ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
377 ; DFN IS THE PATIENT NUMBER.
378 ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
379 ; OR OTHER SECTIONS AS THEY ARE ADDED
380 ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
381 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
382 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
383 S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
384 N ZZGI
385 I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS
386 . F ZZGI="PROBLEMS","VITALS","MEDS" D ; FOR EACH SECTION
387 . . D ZGVWRK(ZZGI) ; DO EACH SECTION
388 E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
389 Q
390 ;
391ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
392 ;
393 N ZZGN ; NAME FOR SECTION VARIABLES
394 S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
395 I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
396 E D ; VARS EXIST
397 . N ZGVI
398 . F ZGVI=1:1:@ZZGN@(0) D ; FOR EACH MULTIPLE IN SECTION
399 . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
400 . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
401 . . S ZZGN2=$NA(@ZZGN@(ZGVI))
402 . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
403 . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
404 . . ; D PARY^GPLXPATH("ZZGA")
405 . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
406 Q
407 ;
408DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
409 ; ALONG WITH SAMPLE VALUES.
410 ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
411 N GTMP
412 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
413 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
414 I '$D(IWHICH) S IWHICH="ALL"
415 D RPCGV(.GTMP,DFN,IWHICH)
416 D PARY^GPLXPATH("GTMP")
417 Q
418 ;
Note: See TracBrowser for help on using the repository browser.