VistA-ccr/p/C0CRIMA.m

524 lines
21 KiB
Mathematica
Raw Normal View History

2009-05-21 13:12:11 -04:00
C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
;;1.0;C0C;;May 19, 2009;
;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.
;
;
2009-05-21 13:12:11 -04:00
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
2009-01-30 13:33:38 -05:00
; APARMS ARE PARAMETERS TO BE USED IN THE EXTRACTION
; SEE C0CPARMS FOR SUPPORTED PARAMTERS
;
N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
N CCRGLO
2009-04-28 19:15:40 -04:00
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
2008-08-22 11:52:42 -04:00
I +RIMDFN=0 D Q ; AT THE END OF THE PATIENTS
. W "END OF PATIENT LIST, CALL RESET^C0CRIMA",!
2009-01-30 13:33:38 -05:00
I '$D(APARMS) S APARMS="" ; DEFAULT NO OVERRIDE PARMS
2008-08-22 11:52:42 -04:00
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
2008-10-28 20:14:30 -04:00
. . 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")
2009-04-28 19:15:40 -04:00
. S C0CCHK=0
2009-03-31 20:23:06 -04:00
. I $$CHKSUM(RIMDFN) D ; CHECKSUM HAS CHANGED
. . W "CHECKSUM IS NEW OR HAS CHANGED",!
2009-04-28 19:15:40 -04:00
. . ;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
. ;
2008-08-24 18:36:41 -04:00
. ; 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,!
. ;
2009-03-15 20:35:00 -04:00
. F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
2008-09-05 13:30:17 -04:00
. ; 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
;
2009-05-21 13:12:11 -04:00
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
2008-10-28 20:14:30 -04:00
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
2008-10-28 20:34:04 -04:00
. . . 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")
2008-11-09 12:34:18 -05:00
. 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
2008-11-09 12:41:43 -05:00
. . . I $P(ZR(ZI),"^",2)="RESULTTESTCODINGSYSTEM" D ; LOINC CODE CHECK
. . . . I $P(ZR(ZI),"^",3)="LOINC" D APOST("SATTR","RIMTBL","RESULTSLN") ;
2008-10-28 20:14:30 -04:00
; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
W "ATTRIBUTES: ",SATTR,!
Q SATTR
;
2009-05-21 13:12:11 -04:00
RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
K ^TMP("C0CRIM","RESUME")
K ^TMP("C0CRIM")
Q
;
2009-05-21 13:12:11 -04:00
CLIST ; LIST THE CATEGORIES
2008-08-24 18:36:41 -04:00
;
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)
2008-08-24 18:36:41 -04:00
Q
;
2009-05-21 13:12:11 -04:00
CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
2008-08-24 18:36:41 -04:00
; 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
2008-08-24 18:36:41 -04:00
. 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,!
2008-08-25 12:06:14 -04:00
S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
2008-08-24 18:36:41 -04:00
;
Q
;
2009-05-21 13:12:11 -04:00
CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
2009-03-31 20:23:06 -04:00
;
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
2009-04-03 12:02:41 -04:00
. ;W "DFN:",CKDFN," DOMAIN:",C0CI,!
2009-03-31 20:23:06 -04:00
. 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
;
2009-05-21 13:12:11 -04:00
CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
2008-08-25 12:06:14 -04:00
;
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
;
2009-05-21 13:12:11 -04:00
CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
2008-08-25 12:06:14 -04:00
; 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
;
2009-05-21 13:12:11 -04:00
XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
2008-08-26 20:27:36 -04:00
;
2009-03-18 18:04:50 -04:00
I '$D(CPATPARM) S CPATPARM=""
2008-08-26 20:27:36 -04:00
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))
2009-03-18 18:04:50 -04:00
. D XPAT^C0CCCR(ZI,CPATPARM) ; EXPORT THE PATIENT TO A FILE
2008-08-26 20:27:36 -04:00
Q
;
2009-05-21 13:12:11 -04:00
CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
2008-08-26 20:27:36 -04:00
;
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
;
2009-05-21 13:12:11 -04:00
PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
;
N ATTR S ATTR=""
I '$D(^TMP("C0CRIM","ATTR",DFN)) D ; RIM VARS NOT PRESENT
2008-09-08 15:47:51 -04:00
. 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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
AINIT ; INITIALIZE ATTRIBUTE TABLE
I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
K @RIMTBL
2008-08-24 18:36:41 -04:00
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")
2008-10-28 20:14:30 -04:00
D APUSH(RIMTBL,"ALERTS")
D APUSH(RIMTBL,"ALERTSCODE")
D APUSH(RIMTBL,"RESULTS")
2008-11-09 12:41:43 -05:00
D APUSH(RIMTBL,"RESULTSLN")
Q
;
2009-05-21 13:12:11 -04:00
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
2008-08-22 11:52:42 -04:00
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
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
2008-10-04 13:03:02 -04:00
. D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
I '$D(IWHICH) S IWHICH="ALL"
D RPCGV(.GTMP,DFN,IWHICH)
D PARY^C0CXPATH("GTMP")
Q
2008-09-22 00:25:53 -04:00
;
2009-05-21 13:12:11 -04:00
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
;
2009-05-21 13:12:11 -04:00
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
;