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

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

fix to add IMMUNE section to DPATV("ALL")
File size: 20.0 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,APARMS) ; 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 ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
43 ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
44 ;
45 N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
46 N CCRGLO
47 D ASETUP ; SET UP VARIABLES AND GLOBALS
48 D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
49 I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
50 S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
51 S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
52 I RIMDFN="" S RIMDFN=RESUME
53 I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS
54 . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
55 I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
56 F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END
57 . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
58 . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
59 . W RIMDFN,!
60 . ;
61 . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
62 . ;
63 . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS
64 . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
65 . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
66 . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS
67 . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
68 . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D ; MEDS VARS EXISTS
69 . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
70 . I $D(^TMP("GPLCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D ; ALERTS EXIST
71 . . W "FOUND ALERT VARS",!
72 . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("GPLCCR",$J,"ALERTS")
73 . I $D(^TMP("GPLCCR",$J,"RESULTS",0)) D ; RESULTS EXIST
74 . . W "FOUND RESULTS VARS",!
75 . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("GPLCCR",$J,"RESULTS")
76 . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
77 . ;
78 . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
79 . ;
80 . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
81 . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
82 . ;
83 . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
84 . ;
85 . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D ; IF FIRST PAT WITH THESE ATTRS
86 . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
87 . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
88 . ;
89 . N CATNAME,CATTBL
90 . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
91 . S CATNAME=""
92 . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
93 . W "CATEGORY NAME: ",CATNAME,!
94 . ;
95 . F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
96 . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
97 . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
98 . ; AND WE SKIP IT
99 . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
100 ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
101 Q
102 ;
103SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
104 N SBASE,SATTR
105 S SBASE=$NA(@RIMBASE@("VARS",SDFN))
106 D APOST("SATTR","RIMTBL","HEADER")
107 I $D(@SBASE@("PROBLEMS",1)) D ;
108 . D APOST("SATTR","RIMTBL","PROBLEMS")
109 . ; W "POSTING PROBLEMS",!
110 I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
111 I $D(@SBASE@("IMMUNE",1)) D ;IMMUNIZATIONS PRESENT
112 . D APOST("SATTR","RIMTBL","IMMUNE")
113 . N ZR,ZI
114 . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
115 . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
116 I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
117 . D APOST("SATTR","RIMTBL","MEDS")
118 . N ZR,ZI
119 . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
120 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
121 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
122 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
123 . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
124 I $D(@SBASE@("ALERTS",1)) D ; IF THE PATIENT HAS ALERTS
125 . D APOST("SATTR","RIMTBL","ALERTS")
126 . N ZR,ZI
127 . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
128 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
129 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
130 . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
131 I $D(@SBASE@("RESULTS",1)) D ; IF THE PATIENT HAS LABS VARIABLES
132 . D APOST("SATTR","RIMTBL","RESULTS")
133 . N ZR,ZI
134 . S ZR(0)=0 ; INITIALIZE TO NONE
135 . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
136 . ; D PARY^GPLXPATH("ZR") ;
137 . I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
138 . . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
139 . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK
140 . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
141 ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
142 W "ATTRIBUTES: ",SATTR,!
143 Q SATTR
144 ;
145RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
146 K ^TMP("GPLRIM","RESUME")
147 K ^TMP("GPLRIM")
148 Q
149 ;
150CLIST ; LIST THE CATEGORIES
151 ;
152 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
153 N CLBASE,CLNUM,ZI,CLIDX
154 S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
155 S CLNUM=@CLBASE@(0)
156 F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
157 . S CLIDX=@CLBASE@(ZI)
158 . W "(",$P(@CLBASE@(CLIDX),"^",1)
159 . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
160 . W CLIDX,!
161 ; D PARY^GPLXPATH(CLBASE)
162 Q
163 ;
164CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
165 ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
166 ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
167 ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
168 ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
169 ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
170 ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
171 ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
172 ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
173 ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
174 ; NUMBER IE CTBL_X(CDFN)=""
175 ;
176 ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
177 S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
178 W "CBASE: ",CCTBL,!
179 ;
180 I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
181 . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
182 . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
183 . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
184 . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
185 . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
186 . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
187 ;
188 S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
189 S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
190 S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
191 ;
192 S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
193 ;
194 S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
195 W "PATS BASE: ",CPATLIST,!
196 S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
197 ;
198 Q
199 ;
200CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
201 ;
202 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
203 N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
204 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
205 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
206 S ZTOT=0 ; INITIALIZE OVERALL TOTAL
207 F ZI=1:1:@ZCBASE@(0) D ; FOR ALL CATS
208 . S ZCNT=0
209 . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
210 . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
211 . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
212 . ; F ZJ=0:0 D Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
213 . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
214 . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
215 . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
216 . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
217 . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
218 . S ZTOT=ZTOT+ZCNT
219 W "TOTAL: ",ZTOT,!
220 Q
221 ;
222CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
223 ; INLST IS PASSED BY NAME
224 N ZI,ZDX,ZCOUNT
225 W INLST,!
226 S ZCOUNT=0
227 S ZDX=""
228 F ZI=$O(@INLST@(ZDX)):0 D Q:$O(@INLST@(ZDX))="" ; LOOP UNTIL THE END
229 . S ZCOUNT=ZCOUNT+1
230 . S ZDX=$O(@INLST@(ZDX))
231 . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
232 Q ZCOUNT
233 ;
234XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
235 ;
236 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
237 N ZI,ZJ,ZC,ZPATBASE
238 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
239 S ZI=""
240 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
241 . S ZI=$O(@ZPATBASE@(ZI))
242 . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
243 Q
244 ;
245CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
246 ;
247 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
248 N ZI,ZJ,ZC,ZPATBASE
249 S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
250 S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
251 S ZI=""
252 F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
253 . S ZI=$O(@ZPATBASE@(ZI))
254 . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
255 . W ZI," "
256 . I ZC=10 D ; NEW LINE
257 . . S ZC=0
258 . . W !
259 Q
260 ;
261PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
262 ;
263 N ATTR S ATTR=""
264 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
265 . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
266 S ATTR=^TMP("GPLRIM","ATTR",DFN)
267 I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q ;NO ATTRIBUTES FOUND
268 I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D ; FOUND A CAT
269 . N CAT
270 . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
271 . W CAT,": ",ATTR,!
272 Q
273 ;
274APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
275 ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
276 ; AND AMAP(N)=AVAL IS THE NTH AVAL
277 ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
278 ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
279 ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
280 ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
281 ;
282 I '$D(@AMAP) D ; IF THE MAP DOES NOT EXIST
283 . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
284 S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
285 S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
286 S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
287 Q
288 ;
289ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
290 I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
291 I '$D(@RIMBASE) S @RIMBASE=""
292 I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
293 S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
294 Q
295 ;
296AINIT ; INITIALIZE ATTRIBUTE TABLE
297 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
298 K @RIMTBL
299 D APUSH(RIMTBL,"EXTRACTED")
300 D APUSH(RIMTBL,"NOTEXTRACTED")
301 D APUSH(RIMTBL,"HEADER")
302 D APUSH(RIMTBL,"NOPCP")
303 D APUSH(RIMTBL,"PCP")
304 D APUSH(RIMTBL,"PROBLEMS")
305 D APUSH(RIMTBL,"PROBCODE")
306 D APUSH(RIMTBL,"PROBNOCODE")
307 D APUSH(RIMTBL,"PROBDATE")
308 D APUSH(RIMTBL,"PROBNODATE")
309 D APUSH(RIMTBL,"VITALS")
310 D APUSH(RIMTBL,"VITALSCODE")
311 D APUSH(RIMTBL,"VITALSNOCODE")
312 D APUSH(RIMTBL,"VITALSDATE")
313 D APUSH(RIMTBL,"VITALSNODATE")
314 D APUSH(RIMTBL,"IMMUNE")
315 D APUSH(RIMTBL,"IMMUNECODE")
316 D APUSH(RIMTBL,"MEDS")
317 D APUSH(RIMTBL,"MEDSCODE")
318 D APUSH(RIMTBL,"MEDSNOCODE")
319 D APUSH(RIMTBL,"MEDSDATE")
320 D APUSH(RIMTBL,"MEDSNODATE")
321 D APUSH(RIMTBL,"ALERTS")
322 D APUSH(RIMTBL,"ALERTSCODE")
323 D APUSH(RIMTBL,"RESULTS")
324 D APUSH(RIMTBL,"RESULTSLN")
325 Q
326 ;
327APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
328 ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
329 ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
330 ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
331 I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
332 N USETBL
333 I '$D(@RIMBASE@("TABLES",PTBL)) D Q ; NO TABLE
334 . W "ERROR NO SUCH TABLE",!
335 S USETBL=@RIMBASE@("TABLES",PTBL)
336 S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
337 Q
338GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
339 ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
340 ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
341 ; IN SECTION "MEDS"
342 ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
343 ; PENDING FOR MED 2 FOR PATIENT 2
344 ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
345 ; RETURNED. RTN IS PASSED BY REFERENCE
346 ;
347 S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
348 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
349 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
350 I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION
351 . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
352 N ZZI,ZZS
353 S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
354 ; ZWR @ZZS@(1)
355 S RTN(0)=@ZZS@(0)
356 F ZZI=1:1:RTN(0) D ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
357 . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
358 . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
359 Q
360 ;
361PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
362 ;
363 N ZR
364 D GETPA(.ZR,DFN,ISEC,IVAR)
365 I $D(ZR(0)) D PARY^GPLXPATH("ZR")
366 E W "NOTHING RETURNED",!
367 Q
368 ;
369CAGET(RTN,IATTR) ;
370 ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
371 ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
372 ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
373 Q
374 ;
375PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
376 ;
377 I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
378 N ZLST
379 S LSTRTN(0)=0 ; DEFAULT RETURN NONE
380 S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
381 S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
382 N ZNC ; ZNC IS NUMBER OF CATEGORIES
383 S ZNC=@ZCBASE@(0)
384 I ZNC=0 Q ; NO CATEGORIES TO SEARCH
385 N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
386 S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
387 N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
388 F ZI=1:1:ZNC D ; FOR ALL CATEGORIES
389 . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
390 . I $P(ZATBL,"^",ZAP)'="" D ; CAT HAS ATTR
391 . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
392 . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
393 S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
394 S ZPAT=0 ; START AT FIRST PATIENT IN LIST
395 F S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT="" D ;
396 . S ZCNT=ZCNT+1
397 S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
398 Q
399 ;
400DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
401 ;
402 N ZR
403 D PCLST(.ZR,CATTR)
404 I ZR(0)=0 D Q ;
405 . W "NO PATIENTS RETURNED",!
406 E D ;
407 . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
408 . W "COUNT=",ZR(0),!
409 Q
410 ;
411RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
412 ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
413 ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
414 ; DFN IS THE PATIENT NUMBER.
415 ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
416 ; OR OTHER SECTIONS AS THEY ARE ADDED
417 ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
418 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
419 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
420 S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
421 N ZZGI
422 I WHICH="ALL" D ; VARIABLES FROM ALL SECTIONS
423 . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE" D ;
424 . . D ZGVWRK(ZZGI) ; DO EACH SECTION
425 . . W "DID ",ZZGI,!
426 E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
427 Q
428 ;
429ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
430 ;
431 N ZZGN ; NAME FOR SECTION VARIABLES
432 S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
433 I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
434 E D ; VARS EXIST
435 . N ZGVI
436 . F ZGVI=1:1:@ZZGN@(0) D ; FOR EACH MULTIPLE IN SECTION
437 . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
438 . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
439 . . S ZZGN2=$NA(@ZZGN@(ZGVI))
440 . . W ZZGN2,!,$O(@ZZGN2@("")),!
441 . . D H2ARY^GPLXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
442 . . ; D PARY^GPLXPATH("ZZGA")
443 . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
444 Q
445 ;
446DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
447 ; ALONG WITH SAMPLE VALUES.
448 ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
449 N GTMP
450 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
451 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
452 I '$D(IWHICH) S IWHICH="ALL"
453 D RPCGV(.GTMP,DFN,IWHICH)
454 D PARY^GPLXPATH("GTMP")
455 Q
456 ;
457RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
458 ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
459 ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
460 ;
461 I '$D(RWHICH) S RWHICH="ALL"
462 ;N R2TMP
463 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
464 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
465 D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
466 N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
467 F R2I=1:1:R2TMP(0) D ; FOR EVERY LINE OF THE ARRAY
468 . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
469 . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
470 . I $L(R2Y)<4 Q ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
471 . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
472 . I R2X[";" D ; THERES MULTIPLES
473 . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
474 . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
475 . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
476 . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
477 . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
478 . E D ; NO SUB-MULTIPLES
479 . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
480 . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
481 Q
482 ;
483RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
484 ;
485 N R2CTMP,R2CARY
486 D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
487 D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
488 D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
489 Q
490 ;
Note: See TracBrowser for help on using the repository browser.