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

Last change on this file since 1753 was 1586, checked in by Sam Habiel, 12 years ago

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