RORXU010 ;HCOIFO/VC - REPORT MODIFICATON UTILITY ;4/16/09 2:54pm
;;1.5;CLINICAL CASE REGISTRIES;**8,19,25,29,31**;Feb 17, 2006;Build 62
;
;Routine builds the ^TMP($J,"RORFLTR" global array that includes
;ICD information from inpatient, outpatient and problem
;list data for the identified patient.
;
;The ICD information that is stored in the ^TMP($J,"RORFLTR"
;global array is then compared to ICD information stored in
;the RORTSK local array which is established by the calling
;report routine.
;
;This routine returns a status flag indicating whether the
;patient should being included on the calling report.
;
;Format is:
; ^TMP($J,"RORFLTR",PATIENT IEN,ICD FILE #,ICD IEN)=1
; ^TMP($J,"RORFLTR",PATIENT IEN,ICD FILE #,ICD IEN,"DATE",ICD Date)=""
;
;The inputs are:
; 1) PIEN - Patient's IEN in the registry file (required).
; Specifically ^RORDATA(798.4,PIEN) and in the
; patient file ^DPT(PIEN).
;
;The return code is:
; RC - Flag indicating if patient should be retained.
; 1 - Patient should be retained for report.
; 0 - Patient should NOT be retained for report.
;
;ICD information is obtained from 3 different packages:
; Registration package for patient inpatient diagnosis.
; Patient Care Encounter package for patient outpatient diagnosis.
; Problem List package for patient problem list diagnosis.
;
;This routine uses the following IAs:
;
;#92 ^DGPT( (controlled)
;#928 ACTIVE^GMPLUTL (controlled)
;#1554 POV^PXAPIIB (controlled)
;#1905 SELECTED^VSIT (controlled)
;#2977 GETFLDS^GMPLEDT3 (controlled)
;#3545 ^DGPT("AAD" (private)
;#6130 PTFICD^DGPTFUT
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
; 'include' or 'exclude'.
;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
; clinics, or divisions for the report.
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
;ROR*1.5*19 FEB 2012 J SCOTT Removed direct read of ^ICD9( global.
;ROR*1.5*19 FEB 2012 J SCOTT Changed the screening of ICD codes from
; external to internal values.
;ROR*1.5*19 FEB 2012 J SCOTT Removed obsolete REG parameter from
; ICD entry point.
;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
;ROR*1.5*29 APR 2016 T KOPP Add check for selected diagnosis date range
;
;******************************************************************************
;******************************************************************************
Q
;
ICD(PIEN) ;Determine if patient is retained for report based on ICD information.
;
K ^TMP($J,"RORFLTR",PIEN)
N PATIEN,RORICDIEN
S PATIEN=PIEN
;
;Gather INPATIENT ICD information from Registration package file #45 (PTF).
N DATE,DGPTREF,ICD1,ICD2,FLDLOC,RORIBUF,FLD
;
;Browse through each inpatient date.
S DATE=0
F S DATE=$O(^DGPT("AAD",PATIEN,DATE)) Q:DATE="" D
.;Browse through each PTF (#45) entry for an inpatient date.
.S DGPTREF=0
.F S DGPTREF=$O(^DGPT("AAD",PATIEN,DATE,DGPTREF)) Q:DGPTREF="" D
..;Extract ICD diagnosis codes.
..D PTFICD^DGPTFUT(701,DGPTREF,"",.RORIBUF)
..S FLD="" F S FLD=$O(RORIBUF(FLD)) Q:FLD="" I $G(RORIBUF(FLD)) D
... S ^TMP($J,"RORFLTR",PATIEN,80,+RORIBUF(FLD))=1
... S ^TMP($J,"RORFLTR",PATIEN,80,+RORIBUF(FLD),"DATE",+$P(RORIBUF,U,10))=""
;
;Gather OUTPATIENT ICD information from Patient Care Encounter package.
N VSIEN,TMP,RORVPLST,VPOVREF,VSDATE
;
;Get a list of all VISIT (#9000010) entries for the patient.
D SELECTED^VSIT(PATIEN)
;Browse through each returned VISIT entry.
S VSIEN=0
F S VSIEN=$O(^TMP("VSIT",$J,VSIEN)) Q:VSIEN="" D
.S TMP=+$O(^TMP("VSIT",$J,VSIEN,"")) Q:TMP'>0
.S VSDATE=+^TMP("VSIT",$J,VSIEN,TMP)
.;Get V POV (#9000010.07) entries for a specific VISIT entry.
.D POV^PXAPIIB(VSIEN,.RORVPLST)
.;Browse through each returned V POV entry.
.S VPOVREF=""
.F S VPOVREF=$O(RORVPLST(VPOVREF)) Q:VPOVREF="" D
..;Extract ICD diagnosis code.
..S RORICDIEN=$P(RORVPLST(VPOVREF),U,1)
..I RORICDIEN'="" D
...S ^TMP($J,"RORFLTR",PATIEN,80,RORICDIEN)=1
...S ^TMP($J,"RORFLTR",PATIEN,80,RORICDIEN,"DATE",VSDATE)=""
K ^TMP("VSIT",$J)
;
;Gather PROBLEM LIST ICD information from Problem List package.
N RORPLST,PLSTREF,GMPVAMC,GMPROV,PROBNUM
;
;Get a list of all PROBLEM (#9000011) entries for the patient.
D ACTIVE^GMPLUTL(PATIEN,.RORPLST)
S (GMPVAMC,GMPROV)=0
;Browse through each returned PROBLEM entry.
S PROBNUM=0
F S PROBNUM=$O(RORPLST(PROBNUM)) Q:PROBNUM="" D
.S PLSTREF=$G(RORPLST(PROBNUM,0))
.Q:PLSTREF'>0
.;Extract ICD diagnosis code.
.K GMPFLD,GMPORIG
.D GETFLDS^GMPLEDT3(PLSTREF)
.S RORICDIEN=$P($G(GMPFLD(.01)),U,1)
.I RORICDIEN'="" D
..S ^TMP($J,"RORFLTR",PATIEN,80,RORICDIEN)=1
..S ^TMP($J,"RORFLTR",PATIEN,80,RORICDIEN,"DATE",+$G(GMPFLD(.08)))=""
.K GMPFLD,GMPORIG
;
COMPARE ;Determine if patient should be retained or not.
;
;Compare ICD data gathered for patient in ^TMP($J,"RORFLTR"
;with ICD data in RORTSK local array that was established from
;the calling routine.
;
N A,B,C,DTOK,STOP,X,Y,Y1,RC
S A="PARAMS",B="ICDFILT",C="DATE_RANGE_5",RC=0
S X="",STOP="GO"
F S X=$O(RORTSK(A,B,"G",X)) Q:X="" Q:STOP="STOP" D
.S Y=""
.F S Y=$O(RORTSK(A,B,"G",X,"C",Y)) Q:Y="" Q:STOP="STOP" D
..I $D(^TMP($J,"RORFLTR",PATIEN,80,Y))>0 D
...S DTOK=0
...I $G(RORTSK(A,C,"A","START"))>0 D Q:'DTOK ;Check if diagnosis is within date range
....S Y1=$G(RORTSK(A,C,"A","START"))-.1 ; Start looking just before earliest start date
....S Y1=$O(^TMP($J,"RORFLTR",PATIEN,80,Y,"DATE",Y1)) ;First diagnosis date after start date ; This date must exist and be <= range end date
....I 'Y1!(Y1>$G(RORTSK(A,C,"A","END"))) Q ; Diagnosis is not within the date range - keep looking
....S DTOK=1
...S RC=1,STOP="STOP"
K ^TMP($J,"RORFLTR",PATIEN)
Q RC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU010 6605 printed Sep 23, 2025@19:21:12 Page 2
RORXU010 ;HCOIFO/VC - REPORT MODIFICATON UTILITY ;4/16/09 2:54pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,19,25,29,31**;Feb 17, 2006;Build 62
+2 ;
+3 ;Routine builds the ^TMP($J,"RORFLTR" global array that includes
+4 ;ICD information from inpatient, outpatient and problem
+5 ;list data for the identified patient.
+6 ;
+7 ;The ICD information that is stored in the ^TMP($J,"RORFLTR"
+8 ;global array is then compared to ICD information stored in
+9 ;the RORTSK local array which is established by the calling
+10 ;report routine.
+11 ;
+12 ;This routine returns a status flag indicating whether the
+13 ;patient should being included on the calling report.
+14 ;
+15 ;Format is:
+16 ; ^TMP($J,"RORFLTR",PATIENT IEN,ICD FILE #,ICD IEN)=1
+17 ; ^TMP($J,"RORFLTR",PATIENT IEN,ICD FILE #,ICD IEN,"DATE",ICD Date)=""
+18 ;
+19 ;The inputs are:
+20 ; 1) PIEN - Patient's IEN in the registry file (required).
+21 ; Specifically ^RORDATA(798.4,PIEN) and in the
+22 ; patient file ^DPT(PIEN).
+23 ;
+24 ;The return code is:
+25 ; RC - Flag indicating if patient should be retained.
+26 ; 1 - Patient should be retained for report.
+27 ; 0 - Patient should NOT be retained for report.
+28 ;
+29 ;ICD information is obtained from 3 different packages:
+30 ; Registration package for patient inpatient diagnosis.
+31 ; Patient Care Encounter package for patient outpatient diagnosis.
+32 ; Problem List package for patient problem list diagnosis.
+33 ;
+34 ;This routine uses the following IAs:
+35 ;
+36 ;#92 ^DGPT( (controlled)
+37 ;#928 ACTIVE^GMPLUTL (controlled)
+38 ;#1554 POV^PXAPIIB (controlled)
+39 ;#1905 SELECTED^VSIT (controlled)
+40 ;#2977 GETFLDS^GMPLEDT3 (controlled)
+41 ;#3545 ^DGPT("AAD" (private)
+42 ;#6130 PTFICD^DGPTFUT
+43 ;
+44 ;******************************************************************************
+45 ;******************************************************************************
+46 ; --- ROUTINE MODIFICATION LOG ---
+47 ;
+48 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+49 ;----------- ---------- ----------- ----------------------------------------
+50 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+51 ; 'include' or 'exclude'.
+52 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+53 ; clinics, or divisions for the report.
+54 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+55 ;ROR*1.5*19 FEB 2012 J SCOTT Removed direct read of ^ICD9( global.
+56 ;ROR*1.5*19 FEB 2012 J SCOTT Changed the screening of ICD codes from
+57 ; external to internal values.
+58 ;ROR*1.5*19 FEB 2012 J SCOTT Removed obsolete REG parameter from
+59 ; ICD entry point.
+60 ;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
+61 ;ROR*1.5*29 APR 2016 T KOPP Add check for selected diagnosis date range
+62 ;
+63 ;******************************************************************************
+64 ;******************************************************************************
+65 QUIT
+66 ;
ICD(PIEN) ;Determine if patient is retained for report based on ICD information.
+1 ;
+2 KILL ^TMP($JOB,"RORFLTR",PIEN)
+3 NEW PATIEN,RORICDIEN
+4 SET PATIEN=PIEN
+5 ;
+6 ;Gather INPATIENT ICD information from Registration package file #45 (PTF).
+7 NEW DATE,DGPTREF,ICD1,ICD2,FLDLOC,RORIBUF,FLD
+8 ;
+9 ;Browse through each inpatient date.
+10 SET DATE=0
+11 FOR
SET DATE=$ORDER(^DGPT("AAD",PATIEN,DATE))
if DATE=""
QUIT
Begin DoDot:1
+12 ;Browse through each PTF (#45) entry for an inpatient date.
+13 SET DGPTREF=0
+14 FOR
SET DGPTREF=$ORDER(^DGPT("AAD",PATIEN,DATE,DGPTREF))
if DGPTREF=""
QUIT
Begin DoDot:2
+15 ;Extract ICD diagnosis codes.
+16 DO PTFICD^DGPTFUT(701,DGPTREF,"",.RORIBUF)
+17 SET FLD=""
FOR
SET FLD=$ORDER(RORIBUF(FLD))
if FLD=""
QUIT
IF $GET(RORIBUF(FLD))
Begin DoDot:3
+18 SET ^TMP($JOB,"RORFLTR",PATIEN,80,+RORIBUF(FLD))=1
+19 SET ^TMP($JOB,"RORFLTR",PATIEN,80,+RORIBUF(FLD),"DATE",+$PIECE(RORIBUF,U,10))=""
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 ;Gather OUTPATIENT ICD information from Patient Care Encounter package.
+22 NEW VSIEN,TMP,RORVPLST,VPOVREF,VSDATE
+23 ;
+24 ;Get a list of all VISIT (#9000010) entries for the patient.
+25 DO SELECTED^VSIT(PATIEN)
+26 ;Browse through each returned VISIT entry.
+27 SET VSIEN=0
+28 FOR
SET VSIEN=$ORDER(^TMP("VSIT",$JOB,VSIEN))
if VSIEN=""
QUIT
Begin DoDot:1
+29 SET TMP=+$ORDER(^TMP("VSIT",$JOB,VSIEN,""))
if TMP'>0
QUIT
+30 SET VSDATE=+^TMP("VSIT",$JOB,VSIEN,TMP)
+31 ;Get V POV (#9000010.07) entries for a specific VISIT entry.
+32 DO POV^PXAPIIB(VSIEN,.RORVPLST)
+33 ;Browse through each returned V POV entry.
+34 SET VPOVREF=""
+35 FOR
SET VPOVREF=$ORDER(RORVPLST(VPOVREF))
if VPOVREF=""
QUIT
Begin DoDot:2
+36 ;Extract ICD diagnosis code.
+37 SET RORICDIEN=$PIECE(RORVPLST(VPOVREF),U,1)
+38 IF RORICDIEN'=""
Begin DoDot:3
+39 SET ^TMP($JOB,"RORFLTR",PATIEN,80,RORICDIEN)=1
+40 SET ^TMP($JOB,"RORFLTR",PATIEN,80,RORICDIEN,"DATE",VSDATE)=""
End DoDot:3
End DoDot:2
End DoDot:1
+41 KILL ^TMP("VSIT",$JOB)
+42 ;
+43 ;Gather PROBLEM LIST ICD information from Problem List package.
+44 NEW RORPLST,PLSTREF,GMPVAMC,GMPROV,PROBNUM
+45 ;
+46 ;Get a list of all PROBLEM (#9000011) entries for the patient.
+47 DO ACTIVE^GMPLUTL(PATIEN,.RORPLST)
+48 SET (GMPVAMC,GMPROV)=0
+49 ;Browse through each returned PROBLEM entry.
+50 SET PROBNUM=0
+51 FOR
SET PROBNUM=$ORDER(RORPLST(PROBNUM))
if PROBNUM=""
QUIT
Begin DoDot:1
+52 SET PLSTREF=$GET(RORPLST(PROBNUM,0))
+53 if PLSTREF'>0
QUIT
+54 ;Extract ICD diagnosis code.
+55 KILL GMPFLD,GMPORIG
+56 DO GETFLDS^GMPLEDT3(PLSTREF)
+57 SET RORICDIEN=$PIECE($GET(GMPFLD(.01)),U,1)
+58 IF RORICDIEN'=""
Begin DoDot:2
+59 SET ^TMP($JOB,"RORFLTR",PATIEN,80,RORICDIEN)=1
+60 SET ^TMP($JOB,"RORFLTR",PATIEN,80,RORICDIEN,"DATE",+$GET(GMPFLD(.08)))=""
End DoDot:2
+61 KILL GMPFLD,GMPORIG
End DoDot:1
+62 ;
COMPARE ;Determine if patient should be retained or not.
+1 ;
+2 ;Compare ICD data gathered for patient in ^TMP($J,"RORFLTR"
+3 ;with ICD data in RORTSK local array that was established from
+4 ;the calling routine.
+5 ;
+6 NEW A,B,C,DTOK,STOP,X,Y,Y1,RC
+7 SET A="PARAMS"
SET B="ICDFILT"
SET C="DATE_RANGE_5"
SET RC=0
+8 SET X=""
SET STOP="GO"
+9 FOR
SET X=$ORDER(RORTSK(A,B,"G",X))
if X=""
QUIT
if STOP="STOP"
QUIT
Begin DoDot:1
+10 SET Y=""
+11 FOR
SET Y=$ORDER(RORTSK(A,B,"G",X,"C",Y))
if Y=""
QUIT
if STOP="STOP"
QUIT
Begin DoDot:2
+12 IF $DATA(^TMP($JOB,"RORFLTR",PATIEN,80,Y))>0
Begin DoDot:3
+13 SET DTOK=0
+14 ;Check if diagnosis is within date range
IF $GET(RORTSK(A,C,"A","START"))>0
Begin DoDot:4
+15 ; Start looking just before earliest start date
SET Y1=$GET(RORTSK(A,C,"A","START"))-.1
+16 ;First diagnosis date after start date ; This date must exist and be <= range end date
SET Y1=$ORDER(^TMP($JOB,"RORFLTR",PATIEN,80,Y,"DATE",Y1))
+17 ; Diagnosis is not within the date range - keep looking
IF 'Y1!(Y1>$GET(RORTSK(A,C,"A","END")))
QUIT
+18 SET DTOK=1
End DoDot:4
if 'DTOK
QUIT
+19 SET RC=1
SET STOP="STOP"
End DoDot:3
End DoDot:2
End DoDot:1
+20 KILL ^TMP($JOB,"RORFLTR",PATIEN)
+21 QUIT RC
