source: ccr/trunk/p/C0CRIMA.m@ 410

Last change on this file since 410 was 399, checked in by Sam Habiel, 16 years ago

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