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

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

name spacing the package to C0C ... removing all GPL references
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^CCRSYS(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.