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

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

batch processing release

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