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

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

added Immunizations to RIM variable analysis code.. changed global for
parms to TMP("C0CPARMS",$J)
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"
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" D ;
424 . . D ZGVWRK(ZZGI) ; DO EACH SECTION
425 E D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
426 Q
427 ;
428ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
429 ;
430 N ZZGN ; NAME FOR SECTION VARIABLES
431 S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
432 I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
433 E D ; VARS EXIST
434 . N ZGVI
435 . F ZGVI=1:1:@ZZGN@(0) D ; FOR EACH MULTIPLE IN SECTION
436 . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
437 . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
438 . . S ZZGN2=$NA(@ZZGN@(ZGVI))
439 . . W ZZGN2,!,$O(@ZZGN2@("")),!
440 . . D H2ARY^GPLXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
441 . . ; D PARY^GPLXPATH("ZZGA")
442 . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
443 Q
444 ;
445DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
446 ; ALONG WITH SAMPLE VALUES.
447 ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
448 N GTMP
449 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
450 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
451 I '$D(IWHICH) S IWHICH="ALL"
452 D RPCGV(.GTMP,DFN,IWHICH)
453 D PARY^GPLXPATH("GTMP")
454 Q
455 ;
456RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
457 ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
458 ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
459 ;
460 I '$D(RWHICH) S RWHICH="ALL"
461 ;N R2TMP
462 I '$D(^TMP("GPLRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
463 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
464 D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
465 N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
466 F R2I=1:1:R2TMP(0) D ; FOR EVERY LINE OF THE ARRAY
467 . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
468 . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
469 . I $L(R2Y)<4 Q ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
470 . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
471 . I R2X[";" D ; THERES MULTIPLES
472 . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
473 . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
474 . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
475 . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
476 . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
477 . E D ; NO SUB-MULTIPLES
478 . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
479 . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
480 Q
481 ;
482RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
483 ;
484 N R2CTMP,R2CARY
485 D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
486 D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
487 D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
488 Q
489 ;
Note: See TracBrowser for help on using the repository browser.