GPLRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08 ;;0.1;CCDCCR;nopatch;noreleasedate ;Copyright 2008 WorldVistA. 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) ; RIM COHERANCE ANALYSIS ROUTINE ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS ; TO RESUME AT NEXT PATIENT, USE BEGDFN="" ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST ; N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR N CCRGLO 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^GPLRIMA",! F RIMI=1:1:DFNCNT D Q:+RIMDFN=0 ; FOR DFNCNT NUMBER OF PATIENTS OR END . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR . W RIMDFN,! . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS . ; . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT . ; . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D ; PROBLEM VARS EXISTS . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS") . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D ; VITALS VARS EXISTS . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS") . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D ; MEDS VARS EXISTS . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS") . ; . ; 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 . ; . S RIMDFN=$O(^DPT(RIMDFN)) ; NEXT PATIENT S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL")) Q ; SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS N SBASE,SATTR S SBASE=$NA(@RIMBASE@("VARS",SDFN)) 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@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS") W "ATTRIBUTES: ",SATTR,! Q SATTR ; RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES K ^TMP("GPLRIM","RESUME") K ^TMP("GPLRIM") 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("GPLRIM")) I '$D(@RIMBASE) S @RIMBASE="" I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL")) ;BASE FOR ATTR TABLE S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; FOR COMMAND LINE PROCESSING Q ; AINIT ; INITIALIZE ATTRIBUTE TABLE I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS K @RIMTBL 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,"MEDS") D APUSH(RIMTBL,"MEDSCODE") D APUSH(RIMTBL,"MEDSNOCODE") D APUSH(RIMTBL,"MEDSDATE") D APUSH(RIMTBL,"MEDSNODATE") 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