RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ;6/21/06 2:24pm
;;1.5;CLINICAL CASE REGISTRIES;**1,13,19,21,25,31,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #928 ACTIVE^GMPLUTL (controlled)
; #1554 POV^PXAPIIB (controlled)
; #1905 SELECTED^VSIT (controlled)
; #2977 GETFLDS^GMPLEDT3 (controlled)
; #3157 RPC^DGPTFAPI (supported)
; #3545 Access to the "AAD" cross-reference and the field 80 (private)
; #92 ^DGPT(IEN,0) (controlled)
; #5747 $$CODEN^ICDEX, $$CODEC^ICDEX, $$VSTD^ICDEX (controlled)
; #6130 PTFICD^DGPTFUT
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;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*21 SEP 2013 T KOPP Add Utilization date range to the report
; Add ICN to report, if requested
;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
; identifiers.
;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN values
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;**** STORES THE ICD CODE
;
; PATIEN Patient IEN (DFN)
; SOURCE ICD source code ("I", "O", "PB")
; [ICDIEN] IEN of the ICD descriptor in file #80
; DATE Date when the code was entered
; [ICD] ICD code
;
; Either the ICDIEN or the ICD parameter must be provided.
;
ICDSET(PATIEN,SOURCE,ICDIEN,DATE,ICD) ;
Q:DATE'>0
N TMP
S ICDIEN=+$G(ICDIEN)
I ICDIEN'>0 Q:$G(ICD)="" D Q:ICDIEN'>0
. S ICDIEN=+$$CODEN^ICDEX(ICD,80)
;---
Q:$$ICDGRCHK^RORXU008(.RORPTGRP,ICDIEN,RORICDL)
;---
S TMP=+$G(@RORTMP@("PAT",PATIEN,ICDIEN))
S:'TMP!(DATE<TMP) @RORTMP@("PAT",PATIEN,ICDIEN)=DATE_U_SOURCE
S ^(SOURCE)=$G(@RORTMP@("PAT",PATIEN,ICDIEN,SOURCE))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
Q
;
;***** SEARCHES FOR INPATIENT DIAGNOSES
;
; PATIEN Patient IEN (DFN)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
INPAT(PATIEN) ;
N ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,DIERR,TMP
S NODE=$NA(^DGPT("AAD",+PATIEN))
S RC=0
;--- Browse through the admissions
S ADMDT=ROREDT1
F S ADMDT=$O(@NODE@(ADMDT),-1) Q:ADMDT'>0 D Q:RC
. S IEN=""
. F S IEN=$O(@NODE@(ADMDT,IEN),-1) Q:IEN'>0 D Q:RC
. . Q:+$G(^DGPT(IEN,0))'=PATIEN
. . Q:$$PTF^RORXU001(IEN,"FP",,.DISDT)
. . ;--- Skip invalid and/or incomplete admissions
. . I DISDT'>0 D Q:TMP!(DISDT'>0)
. . . S TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
. . ;--- Check if any appropriate admissions are left
. . I DISDT<RORSDT S RC=1 Q
. . Q:DISDT'<ROREDT1
. . ;--- Load and process the admission data
. . K RORBUF D RPC^DGPTFAPI(.RORBUF,IEN)
. . I $G(RORBUF(0))<0 D Q
. . . D ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
. . S TMP=$P($G(RORBUF(1)),U,3)
. . D:TMP'="" ICDSET(PATIEN,"I",,DISDT,TMP) ; ICD1
. . D:$G(RORBUF(2))'="" ; ICD2 - ICD24
. . . F I=1:1:24 S TMP=$P(RORBUF(2),U,I) D:TMP'=""
. . . . D ICDSET(PATIEN,"I",,DISDT,TMP)
. . S TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,45,IEN)
. . D:TMP>0 ICDSET(PATIEN,"I",TMP,DISDT) ; PRINCIPAL DIAGNOSIS
;---
Q $S(RC<0:RC,1:0)
;
;***** SEARCHES FOR OUTPATIENT DIAGNOSES
;
; PATIEN Patient IEN (DFN)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
OUTPAT(PATIEN) ;
N DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
D SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
;--- Browse through the visits
S (VSIEN,RC)=0
F S VSIEN=$O(^TMP("VSIT",$J,VSIEN)) Q:VSIEN="" D Q:RC<0
. S TMP=+$O(^TMP("VSIT",$J,VSIEN,"")) Q:TMP'>0
. S DATE=$P($G(^TMP("VSIT",$J,VSIEN,TMP)),U) Q:DATE'>0
. ;--- Get a list of V POV records
. D POV^PXAPIIB(VSIEN,.RORVPLST)
. ;--- Process the records
. S (VPIEN,RC)=0
. F S VPIEN=$O(RORVPLST(VPIEN)) Q:VPIEN'>0 D Q:RC
. . S ICDIEN=+$P(RORVPLST(VPIEN),U)
. . D:ICDIEN>0 ICDSET(PATIEN,"O",ICDIEN,DATE)
Q $S(RC<0:RC,1:0)
;
;***** SEARCHES FOR PROBLEMS
;
; PATIEN Patient IEN (DFN)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
PROBLEM(PATIEN) ;
N DATE,GMPFLD,GMPORIG,GMPROV,GMPVAMC,ICDIEN,IEN,IS,RC,RORPLST,TMP
;--- Load a list of active problems
D ACTIVE^GMPLUTL(PATIEN,.RORPLST)
;--- Browse through the problems
S (GMPVAMC,GMPROV)=0
S (IS,RC)=0
F S IS=$O(RORPLST(IS)) Q:IS="" D Q:RC
. S IEN=+$G(RORPLST(IS,0)) Q:IEN'>0
. K GMPFLD,GMPORIG D GETFLDS^GMPLEDT3(IEN)
. S ICDIEN=+$G(GMPFLD(.01)) Q:ICDIEN'>0
. S DATE=$P($G(GMPFLD(.08)),U)
. D:(DATE'<RORSDT)&(DATE<ROREDT1) ICDSET(PATIEN,"PB",ICDIEN,DATE)
Q 0
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS) ;
N RORAPPTINFO ; Future appointmentdate_U_clinicname
N RORAPPT ; Future appointment date
N RORCLIN ; Future appointment clinic name
N RORDOD ; Date of death
N ROREDT1 ; Day after the end date
N RORLAST4 ; Last 4 digits of the current patient's SSN
N RORPNAME ; Name of the current patient
N RORICN ; ICN of patient (optional)
N RORPACT ; PACT of patient (optional)
N RORPCP ; PCP of patient (optional)
N RORPTGRP ; Temporary list of ICD groups
N RORPTN ; Number of patients in the registry
N RORCDLIST ; Flag to indicate whether a clinic or division list exists
N RORCDSTDT ; Start date for clinic/division utilization search
N RORCDENDT ; End date for clinic/division utilization search
;
N CNT,ECNT,IEN,IENS,PATIEN,RC,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE,AGE,AGETYPE
;--- Utilization date range
D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
. S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
S (CNT,ECNT,RC)=0
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
;
;--- Browse through the registry records
S IEN=0
F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S IENS=IEN_",",CNT=CNT+1
. ;--- Get patient DFN
. S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
. ;
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;
. ;--- Check for any utilization in the corresponding date range
. I $$PARAM^RORTSK01("PATIENTS","CAREONLY") D Q:'UTIL
. . K TMP S TMP("ALL")=1
. . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
. ;
. M RORPTGRP=RORIGRP("C")
. ;
. ;--- Inpatient codes
. S RC=$$INPAT(PATIEN)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;
. ;--- Outpatient codes
. S RC=$$OUTPAT(PATIEN)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;
. ;--- Problem list
. S RC=$$PROBLEM(PATIEN)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;
. ;--- Skip the patient if no data has been found
. Q:$D(@RORTMP@("PAT",PATIEN))<10
. ;--- No ICD from some groups
. I $D(RORPTGRP)>1 K @RORTMP@("PAT",PATIEN) Q
. ;
. ;--- Get the patient's data
. D VADEM^RORUTL05(PATIEN,1)
. S RORPNAME=VADM(1),RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1),RORLAST4="0000"
. I $$PARAM^RORTSK01("PATIENTS","ICN") S RORICN=$$ICN^RORUTL02(PATIEN)
. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
. S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. I $$PARAM^RORTSK01("PATIENTS","PACT") S RORPACT=$$PACT^RORUTL02(PATIEN)
. I $$PARAM^RORTSK01("PATIENTS","PCP") S RORPCP=$$PCP^RORUTL02(PATIEN)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D ;patch 34
. . S RORAPPTINFO=$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
. . S RORAPPT=$P(RORAPPTINFO,U,1),RORCLIN=$P(RORAPPTINFO,U,2)
. ;--- Calculate the patient's totals
. S RC=$$TOTALS(PATIEN)
. I RC Q:RC<0 S ECNT=ECNT+RC
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** SORTS THE RESULTS AND COMPILES THE TOTALS
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
SORT() ;
N ICDIEN,TMP,TNC,TNDC
;---
S ICDIEN=0,(TNC,TNDC)=0
F S ICDIEN=$O(@RORTMP@("ICD",ICDIEN)) Q:ICDIEN'>0 D
. S TNC=TNC+$G(@RORTMP@("ICD",ICDIEN,"C"))
. S TNDC=TNDC+1
S @RORTMP@("ICD")=TNC_U_TNDC
;---
Q 0
;
;***** CALCULATES INTERMEDIATE TOTALS
;
; PATIEN Patient IEN (DFN)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
TOTALS(PATIEN) ;
N CNT,ICD,ICDIEN,ICDVST,PNODE,RC,TMP
S PNODE=$NA(@RORTMP@("PAT",PATIEN))
S @PNODE=RORLAST4_U_RORPNAME_U_RORDOD_U_$G(RORICN)_U_$G(RORPACT)_U_$G(RORPCP)_U_AGE_U_$G(RORAPPT)_U_$G(RORCLIN)
S ^("PAT")=$G(@RORTMP@("PAT"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
;
S ICDIEN=0
F S ICDIEN=$O(@PNODE@(ICDIEN)) Q:ICDIEN'>0 D
. S ICD=$P($G(@RORTMP@("ICD",ICDIEN)),U)
. I ICD="" D
. . S ICD=$$CODEC^ICDEX(80,ICDIEN)
. . S ICDVST=$$VSTD^ICDEX(ICDIEN)
. . S:ICD="" ICD="UNKN"
. . S:ICDVST="" ICDVST="Unknown ("_ICDIEN_")"
. . S @RORTMP@("ICD",ICDIEN)=ICD_U_ICDVST
. ;---
. S CNT=0
. F TMP="I","O","PB" S CNT=CNT+$G(@PNODE@(ICDIEN,TMP))
. S @PNODE@(ICDIEN,"C")=CNT
. S ^("C")=$G(@RORTMP@("ICD",ICDIEN,"C"))+CNT ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
. S ^("P")=$G(@RORTMP@("ICD",ICDIEN,"P"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX013A 11129 printed Sep 23, 2025@19:20:38 Page 2
RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ;6/21/06 2:24pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,13,19,21,25,31,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #928 ACTIVE^GMPLUTL (controlled)
+6 ; #1554 POV^PXAPIIB (controlled)
+7 ; #1905 SELECTED^VSIT (controlled)
+8 ; #2977 GETFLDS^GMPLEDT3 (controlled)
+9 ; #3157 RPC^DGPTFAPI (supported)
+10 ; #3545 Access to the "AAD" cross-reference and the field 80 (private)
+11 ; #92 ^DGPT(IEN,0) (controlled)
+12 ; #5747 $$CODEN^ICDEX, $$CODEC^ICDEX, $$VSTD^ICDEX (controlled)
+13 ; #6130 PTFICD^DGPTFUT
+14 ;
+15 ;******************************************************************************
+16 ;******************************************************************************
+17 ; --- ROUTINE MODIFICATION LOG ---
+18 ;
+19 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+20 ;----------- ---------- ----------- ----------------------------------------
+21 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+22 ; clinics, or divisions for the report.
+23 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+24 ;ROR*1.5*21 SEP 2013 T KOPP Add Utilization date range to the report
+25 ; Add ICN to report, if requested
+26 ;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
+27 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
+28 ; identifiers.
+29 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN values
+30 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+31 ;******************************************************************************
+32 ;******************************************************************************
+33 QUIT
+34 ;
+35 ;**** STORES THE ICD CODE
+36 ;
+37 ; PATIEN Patient IEN (DFN)
+38 ; SOURCE ICD source code ("I", "O", "PB")
+39 ; [ICDIEN] IEN of the ICD descriptor in file #80
+40 ; DATE Date when the code was entered
+41 ; [ICD] ICD code
+42 ;
+43 ; Either the ICDIEN or the ICD parameter must be provided.
+44 ;
ICDSET(PATIEN,SOURCE,ICDIEN,DATE,ICD) ;
+1 if DATE'>0
QUIT
+2 NEW TMP
+3 SET ICDIEN=+$GET(ICDIEN)
+4 IF ICDIEN'>0
if $GET(ICD)=""
QUIT
Begin DoDot:1
+5 SET ICDIEN=+$$CODEN^ICDEX(ICD,80)
End DoDot:1
if ICDIEN'>0
QUIT
+6 ;---
+7 if $$ICDGRCHK^RORXU008(.RORPTGRP,ICDIEN,RORICDL)
QUIT
+8 ;---
+9 SET TMP=+$GET(@RORTMP@("PAT",PATIEN,ICDIEN))
+10 if 'TMP!(DATE<TMP)
SET @RORTMP@("PAT",PATIEN,ICDIEN)=DATE_U_SOURCE
+11 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
SET ^(SOURCE)=$GET(@RORTMP@("PAT",PATIEN,ICDIEN,SOURCE))+1
+12 QUIT
+13 ;
+14 ;***** SEARCHES FOR INPATIENT DIAGNOSES
+15 ;
+16 ; PATIEN Patient IEN (DFN)
+17 ;
+18 ; Return Values:
+19 ; <0 Error code
+20 ; 0 Ok
+21 ; >0 Number of non-fatal errors
+22 ;
INPAT(PATIEN) ;
+1 NEW ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,DIERR,TMP
+2 SET NODE=$NAME(^DGPT("AAD",+PATIEN))
+3 SET RC=0
+4 ;--- Browse through the admissions
+5 SET ADMDT=ROREDT1
+6 FOR
SET ADMDT=$ORDER(@NODE@(ADMDT),-1)
if ADMDT'>0
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(@NODE@(ADMDT,IEN),-1)
if IEN'>0
QUIT
Begin DoDot:2
+9 if +$GET(^DGPT(IEN,0))'=PATIEN
QUIT
+10 if $$PTF^RORXU001(IEN,"FP",,.DISDT)
QUIT
+11 ;--- Skip invalid and/or incomplete admissions
+12 IF DISDT'>0
Begin DoDot:3
+13 SET TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
End DoDot:3
if TMP!(DISDT'>0)
QUIT
+14 ;--- Check if any appropriate admissions are left
+15 IF DISDT<RORSDT
SET RC=1
QUIT
+16 if DISDT'<ROREDT1
QUIT
+17 ;--- Load and process the admission data
+18 KILL RORBUF
DO RPC^DGPTFAPI(.RORBUF,IEN)
+19 IF $GET(RORBUF(0))<0
Begin DoDot:3
+20 DO ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
End DoDot:3
QUIT
+21 SET TMP=$PIECE($GET(RORBUF(1)),U,3)
+22 ; ICD1
if TMP'=""
DO ICDSET(PATIEN,"I",,DISDT,TMP)
+23 ; ICD2 - ICD24
if $GET(RORBUF(2))'=""
Begin DoDot:3
+24 FOR I=1:1:24
SET TMP=$PIECE(RORBUF(2),U,I)
if TMP'=""
Begin DoDot:4
+25 DO ICDSET(PATIEN,"I",,DISDT,TMP)
End DoDot:4
End DoDot:3
+26 SET TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
+27 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,45,IEN)
+28 ; PRINCIPAL DIAGNOSIS
if TMP>0
DO ICDSET(PATIEN,"I",TMP,DISDT)
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+29 ;---
+30 QUIT $SELECT(RC<0:RC,1:0)
+31 ;
+32 ;***** SEARCHES FOR OUTPATIENT DIAGNOSES
+33 ;
+34 ; PATIEN Patient IEN (DFN)
+35 ;
+36 ; Return Values:
+37 ; <0 Error code
+38 ; 0 Ok
+39 ; >0 Number of non-fatal errors
+40 ;
OUTPAT(PATIEN) ;
+1 NEW DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
+2 DO SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
+3 ;--- Browse through the visits
+4 SET (VSIEN,RC)=0
+5 FOR
SET VSIEN=$ORDER(^TMP("VSIT",$JOB,VSIEN))
if VSIEN=""
QUIT
Begin DoDot:1
+6 SET TMP=+$ORDER(^TMP("VSIT",$JOB,VSIEN,""))
if TMP'>0
QUIT
+7 SET DATE=$PIECE($GET(^TMP("VSIT",$JOB,VSIEN,TMP)),U)
if DATE'>0
QUIT
+8 ;--- Get a list of V POV records
+9 DO POV^PXAPIIB(VSIEN,.RORVPLST)
+10 ;--- Process the records
+11 SET (VPIEN,RC)=0
+12 FOR
SET VPIEN=$ORDER(RORVPLST(VPIEN))
if VPIEN'>0
QUIT
Begin DoDot:2
+13 SET ICDIEN=+$PIECE(RORVPLST(VPIEN),U)
+14 if ICDIEN>0
DO ICDSET(PATIEN,"O",ICDIEN,DATE)
End DoDot:2
if RC
QUIT
End DoDot:1
if RC<0
QUIT
+15 QUIT $SELECT(RC<0:RC,1:0)
+16 ;
+17 ;***** SEARCHES FOR PROBLEMS
+18 ;
+19 ; PATIEN Patient IEN (DFN)
+20 ;
+21 ; Return Values:
+22 ; <0 Error code
+23 ; 0 Ok
+24 ; >0 Number of non-fatal errors
+25 ;
PROBLEM(PATIEN) ;
+1 NEW DATE,GMPFLD,GMPORIG,GMPROV,GMPVAMC,ICDIEN,IEN,IS,RC,RORPLST,TMP
+2 ;--- Load a list of active problems
+3 DO ACTIVE^GMPLUTL(PATIEN,.RORPLST)
+4 ;--- Browse through the problems
+5 SET (GMPVAMC,GMPROV)=0
+6 SET (IS,RC)=0
+7 FOR
SET IS=$ORDER(RORPLST(IS))
if IS=""
QUIT
Begin DoDot:1
+8 SET IEN=+$GET(RORPLST(IS,0))
if IEN'>0
QUIT
+9 KILL GMPFLD,GMPORIG
DO GETFLDS^GMPLEDT3(IEN)
+10 SET ICDIEN=+$GET(GMPFLD(.01))
if ICDIEN'>0
QUIT
+11 SET DATE=$PIECE($GET(GMPFLD(.08)),U)
+12 if (DATE'<RORSDT)&(DATE<ROREDT1)
DO ICDSET(PATIEN,"PB",ICDIEN,DATE)
End DoDot:1
if RC
QUIT
+13 QUIT 0
+14 ;
+15 ;***** QUERIES THE REGISTRY
+16 ;
+17 ; FLAGS Flags for the $$SKIP^RORXU005
+18 ;
+19 ; Return Values:
+20 ; <0 Error code
+21 ; 0 Ok
+22 ; >0 Number of non-fatal errors
+23 ;
QUERY(FLAGS) ;
+1 ; Future appointmentdate_U_clinicname
NEW RORAPPTINFO
+2 ; Future appointment date
NEW RORAPPT
+3 ; Future appointment clinic name
NEW RORCLIN
+4 ; Date of death
NEW RORDOD
+5 ; Day after the end date
NEW ROREDT1
+6 ; Last 4 digits of the current patient's SSN
NEW RORLAST4
+7 ; Name of the current patient
NEW RORPNAME
+8 ; ICN of patient (optional)
NEW RORICN
+9 ; PACT of patient (optional)
NEW RORPACT
+10 ; PCP of patient (optional)
NEW RORPCP
+11 ; Temporary list of ICD groups
NEW RORPTGRP
+12 ; Number of patients in the registry
NEW RORPTN
+13 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+14 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+15 ; End date for clinic/division utilization search
NEW RORCDENDT
+16 ;
+17 NEW CNT,ECNT,IEN,IENS,PATIEN,RC,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE,AGE,AGETYPE
+18 ;--- Utilization date range
+19 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+20 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+21 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
+22 ;--- Combined date range
+23 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
+24 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
End DoDot:1
+25 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+26 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+27 SET ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
+28 SET (CNT,ECNT,RC)=0
+29 ;
+30 ;=== Set up Clinic/Division list parameters
+31 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+32 ;
+33 ;--- Browse through the registry records
+34 SET IEN=0
+35 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+36 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+37 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+38 SET IENS=IEN_","
SET CNT=CNT+1
+39 ;--- Get patient DFN
+40 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+41 ;check for patient list and quit if not on list
+42 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+43 ;--- Check if the patient should be skipped
+44 if $$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
QUIT
+45 ;
+46 ;--- Check for Clinic or Division list and quit if not in list
+47 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+48 ;
+49 ;--- Check for any utilization in the corresponding date range
+50 IF $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:2
+51 KILL TMP
SET TMP("ALL")=1
+52 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
End DoDot:2
if 'UTIL
QUIT
+53 ;
+54 MERGE RORPTGRP=RORIGRP("C")
+55 ;
+56 ;--- Inpatient codes
+57 SET RC=$$INPAT(PATIEN)
+58 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+59 ;
+60 ;--- Outpatient codes
+61 SET RC=$$OUTPAT(PATIEN)
+62 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+63 ;
+64 ;--- Problem list
+65 SET RC=$$PROBLEM(PATIEN)
+66 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+67 ;
+68 ;--- Skip the patient if no data has been found
+69 if $DATA(@RORTMP@("PAT",PATIEN))<10
QUIT
+70 ;--- No ICD from some groups
+71 IF $DATA(RORPTGRP)>1
KILL @RORTMP@("PAT",PATIEN)
QUIT
+72 ;
+73 ;--- Get the patient's data
+74 DO VADEM^RORUTL05(PATIEN,1)
+75 SET RORPNAME=VADM(1)
SET RORDOD=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
SET RORLAST4="0000"
+76 IF $$PARAM^RORTSK01("PATIENTS","ICN")
SET RORICN=$$ICN^RORUTL02(PATIEN)
+77 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+78 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+79 IF $$PARAM^RORTSK01("PATIENTS","PACT")
SET RORPACT=$$PACT^RORUTL02(PATIEN)
+80 IF $$PARAM^RORTSK01("PATIENTS","PCP")
SET RORPCP=$$PCP^RORUTL02(PATIEN)
+81 ;patch 34
IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+82 SET RORAPPTINFO=$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
+83 SET RORAPPT=$PIECE(RORAPPTINFO,U,1)
SET RORCLIN=$PIECE(RORAPPTINFO,U,2)
End DoDot:2
+84 ;--- Calculate the patient's totals
+85 SET RC=$$TOTALS(PATIEN)
+86 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
if RC<0
QUIT
+87 ;---
+88 QUIT $SELECT(RC<0:RC,1:ECNT)
+89 ;
+90 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
+91 ;
+92 ; Return Values:
+93 ; <0 Error code
+94 ; 0 Ok
+95 ; >0 Number of non-fatal errors
+96 ;
SORT() ;
+1 NEW ICDIEN,TMP,TNC,TNDC
+2 ;---
+3 SET ICDIEN=0
SET (TNC,TNDC)=0
+4 FOR
SET ICDIEN=$ORDER(@RORTMP@("ICD",ICDIEN))
if ICDIEN'>0
QUIT
Begin DoDot:1
+5 SET TNC=TNC+$GET(@RORTMP@("ICD",ICDIEN,"C"))
+6 SET TNDC=TNDC+1
End DoDot:1
+7 SET @RORTMP@("ICD")=TNC_U_TNDC
+8 ;---
+9 QUIT 0
+10 ;
+11 ;***** CALCULATES INTERMEDIATE TOTALS
+12 ;
+13 ; PATIEN Patient IEN (DFN)
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Ok
+18 ; >0 Number of non-fatal errors
+19 ;
TOTALS(PATIEN) ;
+1 NEW CNT,ICD,ICDIEN,ICDVST,PNODE,RC,TMP
+2 SET PNODE=$NAME(@RORTMP@("PAT",PATIEN))
+3 SET @PNODE=RORLAST4_U_RORPNAME_U_RORDOD_U_$GET(RORICN)_U_$GET(RORPACT)_U_$GET(RORPCP)_U_AGE_U_$GET(RORAPPT)_U_$GET(RORCLIN)
+4 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
SET ^("PAT")=$GET(@RORTMP@("PAT"))+1
+5 ;
+6 SET ICDIEN=0
+7 FOR
SET ICDIEN=$ORDER(@PNODE@(ICDIEN))
if ICDIEN'>0
QUIT
Begin DoDot:1
+8 SET ICD=$PIECE($GET(@RORTMP@("ICD",ICDIEN)),U)
+9 IF ICD=""
Begin DoDot:2
+10 SET ICD=$$CODEC^ICDEX(80,ICDIEN)
+11 SET ICDVST=$$VSTD^ICDEX(ICDIEN)
+12 if ICD=""
SET ICD="UNKN"
+13 if ICDVST=""
SET ICDVST="Unknown ("_ICDIEN_")"
+14 SET @RORTMP@("ICD",ICDIEN)=ICD_U_ICDVST
End DoDot:2
+15 ;---
+16 SET CNT=0
+17 FOR TMP="I","O","PB"
SET CNT=CNT+$GET(@PNODE@(ICDIEN,TMP))
+18 SET @PNODE@(ICDIEN,"C")=CNT
+19 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
SET ^("C")=$GET(@RORTMP@("ICD",ICDIEN,"C"))+CNT
+20 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
SET ^("P")=$GET(@RORTMP@("ICD",ICDIEN,"P"))+1
End DoDot:1
+21 QUIT 0
