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