Changeset 1204 for ccr/trunk/p/C0CRIMA.m


Ignore:
Timestamp:
Jun 23, 2011, 3:01:41 PM (13 years ago)
Author:
George Lilly
Message:

updates for MU Certification

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CRIMA.m

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