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

Last change on this file since 430 was 430, checked in by George Lilly, 12 years ago

checksum processing

File size: 21.2 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    . I $$CHKSUM(RIMDFN) D  ; CHECKSUM HAS CHANGED
78    . . W "CHECKSUM IS NEW OR HAS CHANGED",!
79    . . ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
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    . ;
99    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
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    W "ATTRIBUTES: ",SATTR,!
147    Q SATTR
148    ;
149RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
150    K ^TMP("C0CRIM","RESUME")
151    K ^TMP("C0CRIM")
152    Q
153    ;
154CLIST ; LIST THE CATEGORIES
155    ;
156    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
157    N CLBASE,CLNUM,ZI,CLIDX
158    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
159    S CLNUM=@CLBASE@(0)
160    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
161    . S CLIDX=@CLBASE@(ZI)
162    . W "(",$P(@CLBASE@(CLIDX),"^",1)
163    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
164    . W CLIDX,!
165    ; D PARY^C0CXPATH(CLBASE)
166    Q
167    ;
168CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
169    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
170    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
171    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
172    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
173    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
174    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
175    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
176    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
177    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
178    ; NUMBER IE CTBL_X(CDFN)=""
179    ;
180    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
181    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
182    W "CBASE: ",CCTBL,!
183    ;
184    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
185    . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
186    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
187    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
188    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
189    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
190    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
191    ;
192    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
193    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
194    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
195    ;
196    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
197    ;
198    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
199    W "PATS BASE: ",CPATLIST,!
200    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
201    ;
202    Q
203    ;
204CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
205 ;
206 S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
207 S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
208 S C0CI=""
209 F  S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI=""  D  ;FOR EACH DOMAIN
210 . ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
211 . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
212 . I C0CI="HEADER" D  ; HAVE TO TAKE OUT THE "DATE GENERATED"
213 . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
214 . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
215 . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
216 . I C0CI="HEADER" D  ; PUT IT BACK
217 . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
218 S C0CK="C0CCK" ;
219 S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
220 S CHKR=0 ; RESULT DEFAULT
221 I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D  ; OLD CHECKSUM EXISTS
222 . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
223 E  S CHKR=1 ;CHECKSUM IS NEW
224 S @C0CCKB@(CKDFN,"ALL")=C0CALL
225 M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
226 ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
227 Q CHKR
228 ;
229CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
230    ;
231    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
232    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
233    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
234    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
235    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
236    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
237    . S ZCNT=0
238    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
239    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
240    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
241    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
242    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
243    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
244    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
245    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
246    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
247    . S ZTOT=ZTOT+ZCNT
248    W "TOTAL: ",ZTOT,!
249    Q
250    ;
251CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
252    ; INLST IS PASSED BY NAME
253    N ZI,ZDX,ZCOUNT
254    W INLST,!
255    S ZCOUNT=0
256    S ZDX=""
257    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
258    . S ZCOUNT=ZCOUNT+1
259    . S ZDX=$O(@INLST@(ZDX))
260    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
261    Q ZCOUNT
262    ;
263XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
264    ;
265    I '$D(CPATPARM) S CPATPARM=""
266    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
267    N ZI,ZJ,ZC,ZPATBASE
268    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
269    S ZI=""
270    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
271    . S ZI=$O(@ZPATBASE@(ZI))
272    . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
273    Q
274    ;
275CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
276    ;
277    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
278    N ZI,ZJ,ZC,ZPATBASE
279    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
280    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
281    S ZI=""
282    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
283    . S ZI=$O(@ZPATBASE@(ZI))
284    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
285    . W ZI," "
286    . I ZC=10 D  ; NEW LINE
287    . . S ZC=0
288    . . W !
289    Q
290    ;
291PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
292    ;
293    N ATTR S ATTR=""
294    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
295    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
296    S ATTR=^TMP("C0CRIM","ATTR",DFN)
297    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
298    I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
299    . N CAT
300    . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
301    . W CAT,": ",ATTR,!
302    Q
303    ;
304APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
305    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
306    ; AND AMAP(N)=AVAL IS THE NTH AVAL
307    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
308    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
309    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
310    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
311    ;
312    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
313    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
314    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
315    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
316    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
317    Q
318    ;
319ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
320      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
321      I '$D(@RIMBASE) S @RIMBASE=""
322      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
323      S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
324      Q
325      ;
326AINIT ; INITIALIZE ATTRIBUTE TABLE
327      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
328      K @RIMTBL
329      D APUSH(RIMTBL,"EXTRACTED")
330      D APUSH(RIMTBL,"NOTEXTRACTED")
331      D APUSH(RIMTBL,"HEADER")
332      D APUSH(RIMTBL,"NOPCP")
333      D APUSH(RIMTBL,"PCP")
334      D APUSH(RIMTBL,"PROBLEMS")
335      D APUSH(RIMTBL,"PROBCODE")
336      D APUSH(RIMTBL,"PROBNOCODE")
337      D APUSH(RIMTBL,"PROBDATE")
338      D APUSH(RIMTBL,"PROBNODATE")
339      D APUSH(RIMTBL,"VITALS")
340      D APUSH(RIMTBL,"VITALSCODE")
341      D APUSH(RIMTBL,"VITALSNOCODE")
342      D APUSH(RIMTBL,"VITALSDATE")
343      D APUSH(RIMTBL,"VITALSNODATE")
344      D APUSH(RIMTBL,"IMMUNE")
345      D APUSH(RIMTBL,"IMMUNECODE")
346      D APUSH(RIMTBL,"MEDS")
347      D APUSH(RIMTBL,"MEDSCODE")
348      D APUSH(RIMTBL,"MEDSNOCODE")
349      D APUSH(RIMTBL,"MEDSDATE")
350      D APUSH(RIMTBL,"MEDSNODATE")
351      D APUSH(RIMTBL,"ALERTS")
352      D APUSH(RIMTBL,"ALERTSCODE")
353      D APUSH(RIMTBL,"RESULTS")
354      D APUSH(RIMTBL,"RESULTSLN")
355      Q
356      ;
357APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
358    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
359    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
360    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
361    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
362    N USETBL
363    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
364    . W "ERROR NO SUCH TABLE",!
365    S USETBL=@RIMBASE@("TABLES",PTBL)
366    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
367    Q
368GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
369    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
370    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
371    ; IN SECTION "MEDS"
372    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
373    ; PENDING FOR MED 2 FOR PATIENT 2
374    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
375    ; RETURNED. RTN IS PASSED BY REFERENCE
376    ;
377    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
378    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
379    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
380    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
381    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
382    N ZZI,ZZS
383    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
384    ; ZWR @ZZS@(1)
385    S RTN(0)=@ZZS@(0)
386    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
387    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
388    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
389    Q
390    ;
391PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
392    ;
393    N ZR
394    D GETPA(.ZR,DFN,ISEC,IVAR)
395    I $D(ZR(0)) D PARY^C0CXPATH("ZR")
396    E  W "NOTHING RETURNED",!
397    Q
398    ;
399CAGET(RTN,IATTR) ;
400    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
401    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
402    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
403    Q
404    ;
405PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
406    ;
407    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
408    N ZLST
409    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
410    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
411    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
412    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
413    S ZNC=@ZCBASE@(0)
414    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
415    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
416    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
417    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
418    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
419    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
420    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
421    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
422    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
423    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
424    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
425    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
426    . S ZCNT=ZCNT+1
427    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
428    Q
429    ;
430DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
431    ;
432    N ZR
433    D PCLST(.ZR,CATTR)
434    I ZR(0)=0 D  Q  ;
435    . W "NO PATIENTS RETURNED",!
436    E  D  ;
437    . D PARY^C0CXPATH("ZR") ; PRINT ARRAY
438    . W "COUNT=",ZR(0),!
439    Q
440    ;
441RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
442 ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
443 ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
444 ; DFN IS THE PATIENT NUMBER.
445 ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
446 ; OR OTHER SECTIONS AS THEY ARE ADDED
447 ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
448 I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
449 S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
450 S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
451 N ZZGI
452 I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
453 . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE" D  ;
454 . . D ZGVWRK(ZZGI) ; DO EACH SECTION
455 . . W "DID ",ZZGI,!
456 E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
457 Q
458 ;
459ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
460    ;
461    N ZZGN ; NAME FOR SECTION VARIABLES
462    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
463    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
464    E  D  ; VARS EXIST
465    . N ZGVI
466    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
467    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
468    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
469    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
470    . . W ZZGN2,!,$O(@ZZGN2@("")),!
471    . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
472    . . ; D PARY^C0CXPATH("ZZGA")
473    . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
474    Q
475    ;
476DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
477    ; ALONG WITH SAMPLE VALUES.
478    ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
479    N GTMP
480    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
481    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
482    I '$D(IWHICH) S IWHICH="ALL"
483    D RPCGV(.GTMP,DFN,IWHICH)
484    D PARY^C0CXPATH("GTMP")
485    Q
486    ;
487RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
488 ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
489 ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
490 ;
491 I '$D(RWHICH) S RWHICH="ALL"
492 ;N R2TMP
493 I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
494 . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
495 D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
496 N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
497 F R2I=1:1:R2TMP(0) D  ; FOR EVERY LINE OF THE ARRAY
498 . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
499 . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
500 . I $L(R2Y)<4 Q  ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
501 . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
502 . I R2X[";" D  ; THERES MULTIPLES
503 . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
504 . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
505 . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
506 . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
507 . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
508 . E  D  ; NO SUB-MULTIPLES
509 . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
510 . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
511 Q
512 ;
513RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
514 ;
515 N R2CTMP,R2CARY
516 D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
517 D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
518 D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
519 Q
520 ;
Note: See TracBrowser for help on using the repository browser.