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


Ignore:
Timestamp:
Jul 15, 2011, 4:47:06 PM (13 years ago)
Author:
George Lilly
Message:

removed tabs after certification

File:
1 edited

Legend:

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

    r1204 r1206  
    1 C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
    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         ;
    39 ANALYZE(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            ;
    110 SETATTR(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            ;
    154 RESET   ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
    155            K ^TMP("C0CRIM","RESUME")
    156            K ^TMP("C0CRIM")
    157            Q
    158            ;
    159 CLIST   ; 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            ;
    173 CPUSH(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            ;
    209 CHKSUM(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         ;
    234 CCOUNT  ; 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            ;
    256 CNTLST(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            ;
    268 XCPAT(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            ;
    280 CPAT(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            ;
    296 PATC(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            ;
    309 APUSH(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            ;
    324 ASETUP  ; 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              ;
    331 AINIT   ; 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              ;
    365 APOST(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
    376 GETPA(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            ;
    399 PATD(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            ;
    407 CAGET(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            ;
    413 PCLST(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=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            ;
    438 DCPAT(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            . 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            ;
    452 RPCGV(RTN,DFN,WHICH)    ; RPC GET VARS
    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         ;
    470 ZGVWRK(ZWHICH)  ; DO ONE SECTION FOR RPCGV
    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            ;
    489 DPATV(DFN,IWHICH)       ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
    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            ;
    500 RIM2RNF(R2RTN,DFN,RWHICH)       ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
    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         ;
    526 RIM2CSV(DFN)    ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
    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         ;
     1C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
     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 ;
     39ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
     40    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
     41    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
     42    ; USE RESET^C0CRIMA TO RESET TO TOP OF PATIENT LIST
     43    ; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
     44    ; SEE C0CPARMS FOR SUPPORTED PARAMTERS
     45    ;
     46    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
     47    N CCRGLO
     48    S C0CCHK=0 ; CHECKSUM FLAG
     49    D ASETUP ; SET UP VARIABLES AND GLOBALS
     50    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
     51    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
     52    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
     53    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
     54    I RIMDFN="" S RIMDFN=RESUME
     55    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
     56    . W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
     57    I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
     58    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
     59    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
     60    . D CCRRPC^C0CCCR(.CCRGLO,RIMDFN,APARMS,"CCR") ;PROCESS THE CCR
     61    . W RIMDFN,!
     62    . ;
     63    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
     64    . ;
     65    . I $D(^TMP("C0CCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
     66    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("C0CCCR",$J,"PROBVALS")
     67    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=$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    ;
     110SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
     111    N SBASE,SATTR
     112    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
     113    D APOST("SATTR","RIMTBL","HEADER")
     114    I $D(@SBASE@("PROBLEMS",1)) D  ;
     115    . D APOST("SATTR","RIMTBL","PROBLEMS")
     116    . ; W "POSTING PROBLEMS",!
     117    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
     118    I $D(@SBASE@("IMMUNE",1)) D  ;IMMUNIZATIONS PRESENT
     119    . D APOST("SATTR","RIMTBL","IMMUNE")
     120    . N ZR,ZI
     121    . D GETPA(.ZR,SDFN,"IMMUNE","IMMUNEPRODUCTCODE")
     122    . I ZR(0)>0 D APOST("SATTR","RIMTBL","IMMUNECODE") ;IMMUNIZATION CODES
     123    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
     124    . D APOST("SATTR","RIMTBL","MEDS")
     125    . N ZR,ZI
     126    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
     127    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
     128    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
     129    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
     130    . ; D PATD^C0CRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
     131    I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
     132    . D APOST("SATTR","RIMTBL","ALERTS")
     133    . N ZR,ZI
     134    . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
     135    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
     136    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
     137    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
     138    I $D(@SBASE@("RESULTS",1)) D  ; IF THE PATIENT HAS LABS VARIABLES
     139    . D APOST("SATTR","RIMTBL","RESULTS")
     140    . N ZR,ZI
     141    . S ZR(0)=0 ; INITIALIZE TO NONE
     142    . D RPCGV(.ZR,SDFN,"RESULTS") ;CHECK FOR LABS CODES
     143    . ; D PARY^C0CXPATH("ZR") ;
     144    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
     145    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
     146    . . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D  ; LOINC CODE CHECK
     147    . . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
     148    ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
     149    I $D(@SBASE@("PROCEDURES",1)) D  ;
     150    . D APOST("SATTR","RIMTBL","PROCEDURES")
     151    W "ATTRIBUTES: ",SATTR,!
     152    Q SATTR
     153    ;
     154RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
     155    K ^TMP("C0CRIM","RESUME")
     156    K ^TMP("C0CRIM")
     157    Q
     158    ;
     159CLIST ; 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    ;
     173CPUSH(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    ;
     209CHKSUM(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 ;
     234CCOUNT ; 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    ;
     256CNTLST(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    ;
     268XCPAT(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    ;
     280CPAT(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    ;
     296PATC(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    ;
     309APUSH(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    ;
     324ASETUP ; 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      ;
     331AINIT ; 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      ;
     365APOST(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
     376GETPA(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    ;
     399PATD(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    ;
     407CAGET(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    ;
     413PCLST(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=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    ;
     438DCPAT(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    . 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    ;
     452RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
     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 ;
     470ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
     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    ;
     489DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
     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    ;
     500RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
     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 ;
     526RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
     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.