Index: ccr/trunk/p/C0CRIMA.m
===================================================================
--- ccr/trunk/p/C0CRIMA.m	(revision 1331)
+++ ccr/trunk/p/C0CRIMA.m	(revision 1336)
@@ -1,533 +1,533 @@
-C0CRIMA	  ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-	;;1.0;C0C;;May 19, 2009;Build 38
-	;Copyright 2008,2009 George Lilly, University of Minnesota.
-	;Licensed under the terms of the GNU General Public License.
-	;See attached copy of the License.
-	;
-	;This program is free software; you can redistribute it and/or modify
-	;it under the terms of the GNU General Public License as published by
-	;the Free Software Foundation; either version 2 of the License, or
-	;(at your option) any later version.
-	;
-	;This program is distributed in the hope that it will be useful,
-	;but WITHOUT ANY WARRANTY; without even the implied warranty of
-	;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-	;GNU General Public License for more details.
-	;
-	;You should have received a copy of the GNU General Public License along
-	;with this program; if not, write to the Free Software Foundation, Inc.,
-	;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-	;
-	; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
-	; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
-	; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
-	; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
-	; CONVEYED VIA THE CCR OR CCD.
-	; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
-	;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
-	;    2. ARE THE DATA ELEMENTS TIME-BOUND
-	;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
-	;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
-	;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
-	;    .. AND OTHER FACTORS YET TO BE DETERMINED
-	;
-	;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
-	;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
-	;    CONVEYANCE TO THE RIM APPLICATION.
-	;
-	;
-ANALYZE(BEGDFN,DFNCNT,APARMS)	; RIM COHERANCE ANALYSIS ROUTINE
-	   ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
-	   ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
-	   ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
-	   ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
-	   ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
-	   ;
-	   N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
-	   N CCRGLO
-	   S C0CCHK=0 ; CHECKSUM FLAG
-	   D ASETUP ; SET UP VARIABLES AND GLOBALS
-	   D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
-	   I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
-	   S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
-	   S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
-	   I RIMDFN="" S RIMDFN=RESUME
-	   I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
-	   . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
-	   I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
-	   F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
-	   . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
-	   . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
-	   . W RIMDFN,!
-	   . ;
-	   . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
-	   . ;
-	   . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
-	   . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
-	   . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)
-	   . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-	   . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")
-	   . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-	   . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")
-	   . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D  ; ALERTS EXIST
-	   . . W "FOUND ALERT VARS",!
-	   . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")
-	   . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D  ; RESULTS EXIST
-	   . . W "FOUND RESULTS VARS",!
-	   . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")
-	   . S C0CCHK=0
-	   . I $$CHKSUM(RIMDFN) D  ; CHECKSUM HAS CHANGED
-	   . . W "CHECKSUM IS NEW OR HAS CHANGED",!
-	   . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
-	   . . S C0CCHK=1
-	   . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-	   . ;
-	   . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-	   . ;
-	   . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-	   . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-	   . ;
-	   . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-	   . ;
-	   . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-	   . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-	   . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-	   . ;
-	   . N CATNAME,CATTBL
-	   . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-	   . S CATNAME=""
-	   . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-	   . W "CATEGORY NAME: ",CATNAME,!
-	   . ;
-	   . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
-	   . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-	   . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-	   . ; AND WE SKIP IT
-	   . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-	   ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL"))
-	   Q
-	   ;
-SETATTR(SDFN)	; SET ATTRIBUTES BASED ON VARS
-	   N SBASE,SATTR
-	   S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-	   D APOST("SATTR","RIMTBL","HEADER")
-	   I $D(@SBASE@("PROBLEMS",1)) D  ;
-	   . D APOST("SATTR","RIMTBL","PROBLEMS")
-	   . ; W "POSTING PROBLEMS",!
-	   I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-	   I $D(@SBASE@("IMMUNE",1)) D  ;IMMUNIZATIONS PRESENT
-	   . D APOST("SATTR","RIMTBL","IMMUNE")
-	   . N ZR,ZI
-	   . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
-	   . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
-	   I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-	   . D APOST("SATTR","RIMTBL","MEDS")
-	   . N ZR,ZI
-	   . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-	   . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-	   . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-	   . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-	   . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-	   I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
-	   . D APOST("SATTR","RIMTBL","ALERTS")
-	   . N ZR,ZI
-	   . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
-	   . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-	   . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-	   . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
-	   I $D(@SBASE@("RESULTS",1)) D  ; IF THE PATIENT HAS LABS VARIABLES
-	   . D APOST("SATTR","RIMTBL","RESULTS")
-	   . N ZR,ZI
-	   . S ZR(0)=0 ; INITIALIZE TO NONE
-	   . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
-	   . ; D PARY^C0CXPATH("ZR") ;
-	   . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-	   . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-	   . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D  ; LOINC CODE CHECK
-	   . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
-	   ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-	   I $D(@SBASE@("PROCEDURES",1)) D  ;
-	   . D APOST("SATTR","RIMTBL","PROCEDURES")
-	   W "ATTRIBUTES: ",SATTR,!
-	   Q SATTR
-	   ;
-RESET	; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-	   K ^TMP("C0CRIM","RESUME")
-	   K ^TMP("C0CRIM")
-	   Q
-	   ;
-CLIST	; LIST THE CATEGORIES
-	   ;
-	   I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	   N CLBASE,CLNUM,ZI,CLIDX
-	   S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-	   S CLNUM=@CLBASE@(0)
-	   F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-	   . S CLIDX=@CLBASE@(ZI)
-	   . W "(",$P(@CLBASE@(CLIDX),"^",1)
-	   . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-	   . W CLIDX,!
-	   ; D PARY^C0CXPATH(CLBASE)
-	   Q
-	   ;
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR)	; ADD PATIENTS TO CATEGORIES
-	   ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-	   ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-	   ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-	   ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-	   ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-	   ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-	   ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-	   ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-	   ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-	   ; NUMBER IE CTBL_X(CDFN)=""
-	   ;
-	   ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-	   S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-	   W "CBASE: ",CCTBL,!
-	   ;
-	   I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-	   . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-	   . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-	   . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-	   . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-	   . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-	   . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-	   ;
-	   S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-	   S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-	   S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-	   ;
-	   S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-	   ;
-	   S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-	   W "PATS BASE: ",CPATLIST,!
-	   S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-	   ;
-	   Q
-	   ;
-CHKSUM(CKDFN)	; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
-	; 
-	S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
-	S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
-	S C0CI=""
-	F  S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI=""  D  ;FOR EACH DOMAIN
-	. ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
-	. S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
-	. I C0CI="HEADER" D  ; HAVE TO TAKE OUT THE "DATE GENERATED"
-	. . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-	. . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
-	. S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
-	. I C0CI="HEADER" D  ; PUT IT BACK
-	. . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
-	S C0CK="C0CCK" ;
-	S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
-	S CHKR=0 ; RESULT DEFAULT
-	I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D  ; OLD CHECKSUM EXISTS
-	. I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
-	E  S CHKR=1 ;CHECKSUM IS NEW
-	S @C0CCKB@(CKDFN,"ALL")=C0CALL
-	M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
-	;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
-	Q CHKR
-	;
-CCOUNT	; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-	   ;
-	   I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	   N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-	   S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-	   S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-	   S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-	   F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-	   . S ZCNT=0
-	   . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-	   . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-	   . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-	   . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-	   . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-	   . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-	   . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-	   . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-	   . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-	   . S ZTOT=ZTOT+ZCNT
-	   W "TOTAL: ",ZTOT,!
-	   Q
-	   ;
-CNTLST(INLST)	; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-	   ; INLST IS PASSED BY NAME
-	   N ZI,ZDX,ZCOUNT
-	   W INLST,!
-	   S ZCOUNT=0
-	   S ZDX=""
-	   F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-	   . S ZCOUNT=ZCOUNT+1
-	   . S ZDX=$O(@INLST@(ZDX))
-	   . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-	   Q ZCOUNT
-	   ;
-XCPAT(CPATCAT,CPATPARM)	; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
-	   ;
-	   I '$D(CPATPARM) S CPATPARM=""
-	   I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	   N ZI,ZJ,ZC,ZPATBASE
-	   S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-	   S ZI=""
-	   F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-	   . S ZI=$O(@ZPATBASE@(ZI))
-	   . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
-	   Q
-	   ;
-CPAT(CPATCAT)	; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-	   ;
-	   I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	   N ZI,ZJ,ZC,ZPATBASE
-	   S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-	   S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-	   S ZI=""
-	   F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-	   . S ZI=$O(@ZPATBASE@(ZI))
-	   . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-	   . W ZI," "
-	   . I ZC=10 D  ; NEW LINE
-	   . . S ZC=0
-	   . . W !
-	   Q
-	   ;
-PATC(DFN)	; DISPLAY THE CATEGORY FOR THIS PATIENT
-	   ;
-	   N ATTR S ATTR=""
-	   I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-	   . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-	   S ATTR=^TMP("C0CRIM","ATTR",DFN)
-	   I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-	   I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-	   . N CAT
-	   . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-	   . W CAT,": ",ATTR,!
-	   Q
-	   ;
-APUSH(AMAP,AVAL)	; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-	   ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-	   ; AND AMAP(N)=AVAL IS THE NTH AVAL
-	   ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-	   ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-	   ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-	   ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-	   ;
-	   I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-	   . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-	   S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-	   S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-	   S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-	   Q
-	   ;
-ASETUP	; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-	     I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
-	     I '$D(@RIMBASE) S @RIMBASE=""
-	     I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
-	     S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-	     Q
-	     ;
-AINIT	; INITIALIZE ATTRIBUTE TABLE
-	     I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	     K @RIMTBL
-	     D APUSH(RIMTBL,"EXTRACTED")
-	     D APUSH(RIMTBL,"NOTEXTRACTED")
-	     D APUSH(RIMTBL,"HEADER")
-	     D APUSH(RIMTBL,"NOPCP")
-	     D APUSH(RIMTBL,"PCP")
-	     D APUSH(RIMTBL,"PROBLEMS")
-	     D APUSH(RIMTBL,"PROBCODE")
-	     D APUSH(RIMTBL,"PROBNOCODE")
-	     D APUSH(RIMTBL,"PROBDATE")
-	     D APUSH(RIMTBL,"PROBNODATE")
-	     D APUSH(RIMTBL,"VITALS")
-	     D APUSH(RIMTBL,"VITALSCODE")
-	     D APUSH(RIMTBL,"VITALSNOCODE")
-	     D APUSH(RIMTBL,"VITALSDATE")
-	     D APUSH(RIMTBL,"VITALSNODATE")
-	     D APUSH(RIMTBL,"IMMUNE")
-	     D APUSH(RIMTBL,"IMMUNECODE")
-	     D APUSH(RIMTBL,"MEDS")
-	     D APUSH(RIMTBL,"MEDSCODE")
-	     D APUSH(RIMTBL,"MEDSNOCODE")
-	     D APUSH(RIMTBL,"MEDSDATE")
-	     D APUSH(RIMTBL,"MEDSNODATE")
-	     D APUSH(RIMTBL,"ALERTS")
-	     D APUSH(RIMTBL,"ALERTSCODE")
-	     D APUSH(RIMTBL,"RESULTS")
-	     D APUSH(RIMTBL,"RESULTSLN")
-	     D APUSH(RIMTBL,"PROCEDURES")
-	     D APUSH(RIMTBL,"ENCOUNTERS")
-	     D APUSH(RIMTBL,"NOTES")
-	     Q
-	     ;
-APOST(PRSLT,PTBL,PVAL)	; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-	   ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-	   ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-	   ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-	   I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-	   N USETBL
-	   I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-	   . W "ERROR NO SUCH TABLE",!
-	   S USETBL=@RIMBASE@("TABLES",PTBL)
-	   S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-	   Q
-GETPA(RTN,DFN,ISEC,IVAR)	; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-	   ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-	   ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-	   ; IN SECTION "MEDS"
-	   ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-	   ; PENDING FOR MED 2 FOR PATIENT 2
-	   ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-	   ; RETURNED. RTN IS PASSED BY REFERENCE
-	   ;
-	   S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-	   I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-	   S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-	   I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-	   . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-	   N ZZI,ZZS
-	   S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-	   ; ZWR @ZZS@(1)
-	   S RTN(0)=@ZZS@(0)
-	   F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-	   . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-	   . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-	   Q
-	   ;
-PATD(DFN,ISEC,IVAR)	; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-	   ;
-	   N ZR
-	   D GETPA(.ZR,DFN,ISEC,IVAR)
-	   I $D(ZR(0)) D PARY^C0CXPATH("ZR")
-	   E  W "NOTHING RETURNED",!
-	   Q
-	   ;
-CAGET(RTN,IATTR)	;
-	   ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-	   ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-	   ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-	   Q
-	   ;
-PCLST(LSTRTN,IATTR)	; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-	   ;
-	   I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-	   N ZLST
-	   S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
-	   S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-	   S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-	   N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-	   S ZNC=@ZCBASE@(0)
-	   I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-	   N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-	   S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-	   N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-	   F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-	   . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-	   . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-	   . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-	   . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-	   S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-	   S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-	   F  S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT=""  D  ;
-	   . S ZCNT=ZCNT+1
-	   S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-	   Q
-	   ;
-DCPAT(CATTR)	; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-	   ;
-	   ;N ZR
-	   D PCLST("ZR",CATTR)
-	   I ZR(0)=0 D  Q  ;
-	   . W "NO PATIENTS RETURNED",!
-	   E  D  ;
-	   . N ZI S ZI=0
-	   . F  S ZI=$O(ZR(ZI)) Q:ZI=""  D  ;
-	   . . W !,ZI
-	   . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
-	   . W !,"COUNT=",ZR(0)
-	   Q
-	   ;
-RPCGV(RTN,DFN,WHICH)	; RPC GET VARS
-	; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-	; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-	; DFN IS THE PATIENT NUMBER.
-	; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
-	; OR OTHER SECTIONS AS THEY ARE ADDED
-	; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-	I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-	S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-	S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-	N ZZGI
-	I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-	. F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D  ;
-	. . D ZGVWRK(ZZGI) ; DO EACH SECTION
-	. . I $G(DEBUG)'="" W "DID ",ZZGI,!
-	E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-	Q
-	;
-ZGVWRK(ZWHICH)	; DO ONE SECTION FOR RPCGV
-	   ;
-	   N ZZGN ; NAME FOR SECTION VARIABLES
-	   S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-	   ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-	   I $O(@ZZGN@(""),-1)=""  D  ;
-	   E  D  ; VARS EXIST
-	   . N ZGVI,ZGVN
-	   . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS
-	   . F ZGVI=1:1:ZGVN D  ; FOR EACH MULTIPLE IN SECTION
-	   . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-	   . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-	   . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-	   . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!
-	   . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
-	   . . ; D PARY^C0CXPATH("ZZGA")
-	   . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-	   Q
-	   ;
-DPATV(DFN,IWHICH)	; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
-	   ; ALONG WITH SAMPLE VALUES.
-	   ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
-	   N GTMP
-	   I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-	   . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-	   I '$D(IWHICH) S IWHICH="ALL"
-	   D RPCGV(.GTMP,DFN,IWHICH)
-	   D PARY^C0CXPATH("GTMP")
-	   Q
-	   ;
-RIM2RNF(R2RTN,DFN,RWHICH)	; CONVERTS RIM VARIABLES TO RNF2 FORMAT
-	; RETURN IN R2RTN, WHICH IS PASSED BY NAME
-	; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
-	;
-	I '$D(RWHICH) S RWHICH="ALL"
-	;N R2TMP
-	I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-	. D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-	D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
-	N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
-	F R2I=1:1:R2TMP(0) D  ; FOR EVERY LINE OF THE ARRAY
-	. S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
-	. S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
-	. I $L(R2Y)<4 Q  ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
-	. S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
-	. I R2X[";" D  ; THERES MULTIPLES
-	. . S R2X1=$P(R2X,";",1) ; FIRST INDEX
-	. . S R2X2=$P(R2X,";",2) ; SECOND INDEX
-	. . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
-	. . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
-	. . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
-	. E  D  ; NO SUB-MULTIPLES
-	. . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
-	. . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
-	Q
-	;
-RIM2CSV(DFN)	; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
-	;
-	N R2CTMP,R2CARY
-	D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
-	D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
-	D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
-	Q
-	;
+C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+ ;;1.0;C0C;;May 19, 2009;Build 38
+ ;Copyright 2008,2009 George Lilly, University of Minnesota.
+ ;Licensed under the terms of the GNU General Public License.
+ ;See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+ ; CONVEYED VIA THE CCR OR CCD.
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+ ;
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+ ;
+ ;
+ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+    ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
+    ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
+    ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
+    ;
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+    N CCRGLO
+    S C0CCHK=0 ; CHECKSUM FLAG
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+    I RIMDFN="" S RIMDFN=RESUME
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+    . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
+    I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+    . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
+    . W RIMDFN,!
+    . ;
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+    . ;
+    . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
+    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$O(^TMP("C0CCCR",$J,"PROBVALS",""),-1)
+    . I $D(^TMP("C0CCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("C0CCCR",$J,"VITALS")
+    . I $D(^TMP("C0CCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("C0CCCR",$J,"MEDMAP")
+    . I $D(^TMP("C0CCCR",$J,"ALERTS",1,"ALERTOBJECTID")) D  ; ALERTS EXIST
+    . . W "FOUND ALERT VARS",!
+    . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("C0CCCR",$J,"ALERTS")
+    . I $D(^TMP("C0CCCR",$J,"RESULTS",0)) D  ; RESULTS EXIST
+    . . W "FOUND RESULTS VARS",!
+    . . M @RIMBASE@("VARS",RIMDFN,"RESULTS")=^TMP("C0CCCR",$J,"RESULTS")
+    . S C0CCHK=0
+    . I $$CHKSUM(RIMDFN) D  ; CHECKSUM HAS CHANGED
+    . . W "CHECKSUM IS NEW OR HAS CHANGED",!
+    . . ;ZWR ^TMP("C0CRIM","CHKSUM",RIMDFN,*)
+    . . S C0CCHK=1
+    . K ^TMP("C0CCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+    . ;
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+    . ;
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+    . ;
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+    . ;
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+    . ;
+    . N CATNAME,CATTBL
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+    . S CATNAME=""
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+    . W "CATEGORY NAME: ",CATNAME,!
+    . ;
+    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
+    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
+    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
+    . ; AND WE SKIP IT
+    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+    ; D PARY^C0CXPATH(@RIMBASE@("ATTRTBL"))
+    Q
+    ;
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+    N SBASE,SATTR
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+    D APOST("SATTR","RIMTBL","HEADER")
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+    . ; W "POSTING PROBLEMS",!
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+    I $D(@SBASE@("IMMUNE",1)) D  ;IMMUNIZATIONS PRESENT
+    . D APOST("SATTR","RIMTBL","IMMUNE")
+    . N ZR,ZI
+    . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
+    . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
+    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
+    . D APOST("SATTR","RIMTBL","MEDS")
+    . N ZR,ZI
+    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
+    . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+    I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
+    . D APOST("SATTR","RIMTBL","ALERTS")
+    . N ZR,ZI
+    . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
+    I $D(@SBASE@("RESULTS",1)) D  ; IF THE PATIENT HAS LABS VARIABLES
+    . D APOST("SATTR","RIMTBL","RESULTS")
+    . N ZR,ZI
+    . S ZR(0)=0 ; INITIALIZE TO NONE
+    . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
+    . ; D PARY^C0CXPATH("ZR") ;
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+    . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D  ; LOINC CODE CHECK
+    . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
+    ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+    I $D(@SBASE@("PROCEDURES",1)) D  ;
+    . D APOST("SATTR","RIMTBL","PROCEDURES")
+    W "ATTRIBUTES: ",SATTR,!
+    Q SATTR
+    ;
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+    K ^TMP("C0CRIM","RESUME")
+    K ^TMP("C0CRIM")
+    Q
+    ;
+CLIST ; LIST THE CATEGORIES
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N CLBASE,CLNUM,ZI,CLIDX
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+    S CLNUM=@CLBASE@(0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+    . S CLIDX=@CLBASE@(ZI)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+    . W CLIDX,!
+    ; D PARY^C0CXPATH(CLBASE)
+    Q
+    ;
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+    ; NUMBER IE CTBL_X(CDFN)=""
+    ;
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+    W "CBASE: ",CCTBL,!
+    ;
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+    . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+    ;
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+    ;
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+    ;
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+    W "PATS BASE: ",CPATLIST,!
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+    ;
+    Q
+    ;
+CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
+ ; 
+ S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
+ S C0CGLB=$NA(^TMP("C0CRIM","VARS")) ;CCR VARIABLE BASE
+ S C0CI=""
+ F  S C0CI=$O(@C0CGLB@(CKDFN,C0CI)) Q:C0CI=""  D  ;FOR EACH DOMAIN
+ . ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
+ . S C0CJ=$NA(@C0CGLB@(CKDFN,C0CI))
+ . I C0CI="HEADER" D  ; HAVE TO TAKE OUT THE "DATE GENERATED"
+ . . S C0CDT=@C0CGLB@(CKDFN,C0CI,1,"DATETIME")
+ . . K @C0CGLB@(CKDFN,C0CI,1,"DATETIME")
+ . S C0CCK(C0CI)=$$CHKSUM^XUSESIG1(C0CJ)
+ . I C0CI="HEADER" D  ; PUT IT BACK
+ . . S @C0CGLB@(CKDFN,C0CI,1,"DATETIME")=C0CDT
+ S C0CK="C0CCK" ;
+ S C0CALL=$$CHKSUM^XUSESIG1(C0CK) ;CHECKSUM OF ALL DOMAIN CHECKSUMS
+ S CHKR=0 ; RESULT DEFAULT
+ I $D(^TMP("C0CRIM","CHKSUM",CKDFN,"ALL")) D  ; OLD CHECKSUM EXISTS
+ . I @C0CCKB@(CKDFN,"ALL")'=C0CALL S CHKR=1
+ E  S CHKR=1 ;CHECKSUM IS NEW
+ S @C0CCKB@(CKDFN,"ALL")=C0CALL
+ M @C0CCKB@(CKDFN,"DOMAIN")=C0CCK
+ ;ZWR ^TMP("C0CRIM","CHKSUM",CKDFN,*)
+ Q CHKR
+ ;
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+    . S ZCNT=0
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+    . S ZTOT=ZTOT+ZCNT
+    W "TOTAL: ",ZTOT,!
+    Q
+    ;
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+    ; INLST IS PASSED BY NAME
+    N ZI,ZDX,ZCOUNT
+    W INLST,!
+    S ZCOUNT=0
+    S ZDX=""
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+    . S ZCOUNT=ZCOUNT+1
+    . S ZDX=$O(@INLST@(ZDX))
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+    Q ZCOUNT
+    ;
+XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+    ;
+    I '$D(CPATPARM) S CPATPARM=""
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZC,ZPATBASE
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+    S ZI=""
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+    . S ZI=$O(@ZPATBASE@(ZI))
+    . D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
+    Q
+    ;
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZC,ZPATBASE
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+    S ZI=""
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+    . S ZI=$O(@ZPATBASE@(ZI))
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+    . W ZI," "
+    . I ZC=10 D  ; NEW LINE
+    . . S ZC=0
+    . . W !
+    Q
+    ;
+PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+    ;
+    N ATTR S ATTR=""
+    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
+    S ATTR=^TMP("C0CRIM","ATTR",DFN)
+    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
+    I $D(^TMP("C0CRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
+    . N CAT
+    . S CAT=$P(^TMP("C0CRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
+    . W CAT,": ",ATTR,!
+    Q
+    ;
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+    ;
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+    Q
+    ;
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
+      I '$D(@RIMBASE) S @RIMBASE=""
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("C0CRIM","RIMTBL","TABLE")) ; ATTR TABLE
+      S ^TMP("C0CRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+      Q
+      ;
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+      K @RIMTBL
+      D APUSH(RIMTBL,"EXTRACTED")
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+      D APUSH(RIMTBL,"HEADER")
+      D APUSH(RIMTBL,"NOPCP")
+      D APUSH(RIMTBL,"PCP")
+      D APUSH(RIMTBL,"PROBLEMS")
+      D APUSH(RIMTBL,"PROBCODE")
+      D APUSH(RIMTBL,"PROBNOCODE")
+      D APUSH(RIMTBL,"PROBDATE")
+      D APUSH(RIMTBL,"PROBNODATE")
+      D APUSH(RIMTBL,"VITALS")
+      D APUSH(RIMTBL,"VITALSCODE")
+      D APUSH(RIMTBL,"VITALSNOCODE")
+      D APUSH(RIMTBL,"VITALSDATE")
+      D APUSH(RIMTBL,"VITALSNODATE")
+      D APUSH(RIMTBL,"IMMUNE")
+      D APUSH(RIMTBL,"IMMUNECODE")
+      D APUSH(RIMTBL,"MEDS")
+      D APUSH(RIMTBL,"MEDSCODE")
+      D APUSH(RIMTBL,"MEDSNOCODE")
+      D APUSH(RIMTBL,"MEDSDATE")
+      D APUSH(RIMTBL,"MEDSNODATE")
+      D APUSH(RIMTBL,"ALERTS")
+      D APUSH(RIMTBL,"ALERTSCODE")
+      D APUSH(RIMTBL,"RESULTS")
+      D APUSH(RIMTBL,"RESULTSLN")
+      D APUSH(RIMTBL,"PROCEDURES")
+      D APUSH(RIMTBL,"ENCOUNTERS")
+      D APUSH(RIMTBL,"NOTES")
+      Q
+      ;
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+    N USETBL
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+    . W "ERROR NO SUCH TABLE",!
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+    Q
+GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
+    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
+    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
+    ; IN SECTION "MEDS"
+    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
+    ; PENDING FOR MED 2 FOR PATIENT 2
+    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
+    ; RETURNED. RTN IS PASSED BY REFERENCE
+    ;
+    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
+    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
+    N ZZI,ZZS
+    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
+    ; ZWR @ZZS@(1)
+    S RTN(0)=@ZZS@(0)
+    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
+    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
+    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
+    Q
+    ;
+PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
+    ;
+    N ZR
+    D GETPA(.ZR,DFN,ISEC,IVAR)
+    I $D(ZR(0)) D PARY^C0CXPATH("ZR")
+    E  W "NOTHING RETURNED",!
+    Q
+    ;
+CAGET(RTN,IATTR) ;
+    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
+    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
+    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
+    Q
+    ;
+PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
+    ;
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+    N ZLST
+    S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
+    S ZNC=@ZCBASE@(0)
+    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
+    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
+    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
+    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
+    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
+    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
+    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
+    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
+    . . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
+    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
+    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
+    F  S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT=""  D  ;
+    . S ZCNT=ZCNT+1
+    S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
+    Q
+    ;
+DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
+    ;
+    ;N ZR
+    D PCLST("ZR",CATTR)
+    I ZR(0)=0 D  Q  ;
+    . W "NO PATIENTS RETURNED",!
+    E  D  ;
+    . N ZI S ZI=0
+    . F  S ZI=$O(ZR(ZI)) Q:ZI=""  D  ;
+    . . W !,ZI
+    . ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
+    . W !,"COUNT=",ZR(0)
+    Q
+    ;
+RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
+ ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
+ ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
+ ; DFN IS THE PATIENT NUMBER.
+ ; WHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","IMMUNE"
+ ; OR OTHER SECTIONS AS THEY ARE ADDED
+ ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
+ I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+ S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+ S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
+ N ZZGI
+ I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
+ . F ZZGI="HEADER","PROBLEMS","VITALS","MEDS","ALERTS","RESULTS","IMMUNE","PROCEDURES" D  ;
+ . . D ZGVWRK(ZZGI) ; DO EACH SECTION
+ . . I $G(DEBUG)'="" W "DID ",ZZGI,!
+ E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
+ Q
+ ;
+ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
+    ;
+    N ZZGN ; NAME FOR SECTION VARIABLES
+    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
+    ;I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
+    I $O(@ZZGN@(""),-1)=""  D  ;
+    E  D  ; VARS EXIST
+    . N ZGVI,ZGVN
+    . S ZGVN=$O(@ZZGN@(""),-1) ;COUNT OF VARS
+    . F ZGVI=1:1:ZGVN D  ; FOR EACH MULTIPLE IN SECTION
+    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
+    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
+    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
+    . . I $G(DEBUG)'="" W ZZGN2,!,$O(@ZZGN2@("")),!
+    . . D H2ARY^C0CXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
+    . . ; D PARY^C0CXPATH("ZZGA")
+    . . D PUSHA^C0CXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
+    Q
+    ;
+DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
+    ; ALONG WITH SAMPLE VALUES.
+    ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
+    N GTMP
+    I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
+    I '$D(IWHICH) S IWHICH="ALL"
+    D RPCGV(.GTMP,DFN,IWHICH)
+    D PARY^C0CXPATH("GTMP")
+    Q
+    ;
+RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
+ ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
+ ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
+ ;
+ I '$D(RWHICH) S RWHICH="ALL"
+ ;N R2TMP
+ I '$D(^TMP("C0CRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+ . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
+ D RPCGV(.R2TMP,DFN,RWHICH) ; RETRIEVE ALL THE VARIABLES I AN ARRAY
+ N R2I,R2J,R2X,R2X1,R2X2,R2Y,R2Z
+ F R2I=1:1:R2TMP(0) D  ; FOR EVERY LINE OF THE ARRAY
+ . S R2X=$P(R2TMP(R2I),"^",1) ; OCCURANCE
+ . S R2Y=$P(R2TMP(R2I),"^",2) ; VARIABLE NAME
+ . I $L(R2Y)<4 Q  ; SKIP SHORT VARIABLES (THEY ARE FOR DEBUGGING)
+ . S R2Z=$P(R2TMP(R2I),"^",3) ; VALUE
+ . I R2X[";" D  ; THERES MULTIPLES
+ . . S R2X1=$P(R2X,";",1) ; FIRST INDEX
+ . . S R2X2=$P(R2X,";",2) ; SECOND INDEX
+ . . S R2J=R2Y_"["_R2X2_"]" ; BUILD THE VARIABLE NAME
+ . . S @R2RTN@("F",R2J,1)="" ; PUT VARIABLE NAME IN FIELD MAP
+ . . S @R2RTN@("V",R2X1,R2J,1)=R2Z ; PUT THE VALUE IN THE ARRAY
+ . E  D  ; NO SUB-MULTIPLES
+ . . S @R2RTN@("F",R2Y,1)="" ; PUT VARIABLE NAME IN FIELD MAP
+ . . S @R2RTN@("V",R2X,R2Y,1)=R2Z ; PUT THE VALUE IN THE ARRAY
+ Q
+ ;
+RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
+ ;
+ N R2CTMP,R2CARY
+ D RIM2RNF("R2CTMP",DFN) ; CONVERT VARIABLES TO RNF FORMAT
+ D RNF2CSV^C0CRNF("R2CARY","R2CTMP","NV") ; CONVERT RNF TO CSV FORMAT
+ D FILEOUT^C0CRNF("R2CARY","VARS-"_DFN_".csv")
+ Q
+ ;
