RORX007A ;HOIFO/BH,SG,VAC - RADIOLOGY UTILIZATION (OVERFLOW) ;4/7/09 2:07pm
;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,31**;Feb 17, 2006;Build 62
;
; This routine uses the following IAs:
;
; #2043 EN1^RAO7PC1 (supported)
;
;******************************************************************************
;******************************************************************************
; --- 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 K GUPTA Support for ICD-10 Coding System
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;
;******************************************************************************
;******************************************************************************
Q
;
;***** APPENDS MODIFIERS TO THE CPT CODE
;
; CPT CPT code
;
; NODE Closed root of the exam data node returned
; by the EN1^RAO7PC1
;
CPTMOD(CPT,NODE) ;
N CPM,RORIM
S RORIM=""
F S RORIM=$O(@NODE@("CMOD",RORIM)) Q:RORIM="" D
. S CPM=$P($G(@NODE@("CMOD",RORIM)),U)
. S:CPM'="" CPT=CPT_"-"_CPM
Q CPT
;
;***** LOADS AND PROCESSES THE RADIOLOGY DATA
;
; DFN Patient IEN (in file #2)
;
; Return Values:
; <0 Error code
; 0 Ok
;
GETDATA(DFN) ;
N CPT,EXAMID,NODE,PRNAME,RORBUF
;--- Get the data
D EN1^RAO7PC1(DFN,RORSDT,ROREDT,999999)
;data returned from radiology/nuclear medicine API in ^TMP($J,"RAE1"
Q:'$D(^TMP($J,"RAE1",DFN)) 0
;
;--- Process the data
S EXAMID=""
F S EXAMID=$O(^TMP($J,"RAE1",DFN,EXAMID)) Q:EXAMID="" D
. S NODE=$NA(^TMP($J,"RAE1",DFN,EXAMID))
. S RORBUF=$G(@NODE),CPT=$$CPTMOD($P(RORBUF,U,10),NODE)
. ;--- Get Procedure Name
. S PRNAME=$E($P(RORBUF,U),1,30) Q:PRNAME=""
. S PRNAME=PRNAME_U_$S(CPT'="":CPT,1:" ")
. ;--- Increment the counters
. S ^(DFN)=$G(^TMP("RORX007",$J,"PROC",PRNAME,DFN))+1 ;naked reference: ^TMP("RORX007",$J,"PROC",PRNAME,DFN)
. S ^(PRNAME)=$G(^TMP("RORX007",$J,"PAT",DFN,PRNAME))+1 ;naked reference: ^TMP("RORX007",$J,"PROC",PRNAME,DFN,PRNAME)
;
;--- Cleanup
K ^TMP($J,"RAE1")
Q 0
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
;;PATIENTS(#,NAME,LAST4,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PATIENTS(#,NAME,LAST4,AGE,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PROCEDURES(#,NAME,CPT,PATIENTS,TOTAL)
;
N HEADER,RC
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX007A",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** OUTPUTS THE PARAMETERS TO THE REPORT
;
; PARTAG Reference (IEN) to the parent tag
;
; [.STDT] Start and end dates of the report
; [.ENDT] are returned via these parameters
;
; [.FLAGS] Flags for the $$SKIP^RORXU005 are
; returned via this parameter
;
; Return Values:
; <0 Error code
; >0 IEN of the PARAMETERS element
;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
N NAME,PARAMS,TMP
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
Q:PARAMS<0 PARAMS
;--- Additional parameters
F NAME="MAXUTNUM","MINRPNUM" D
. S TMP=$$PARAM^RORTSK01(NAME)
. D:TMP'="" ADDVAL^RORTSK11(RORTSK,NAME,TMP,PARAMS)
;---
Q PARAMS
;
;***** 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 CNT,ECNT,IEN,IENS,PATIEN,RC,RORMSG,TMP,XREFNODE
N RCC,FLAG
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
;
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
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
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
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 the 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 the patient against the ICD Filter
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;--- End of ICD check
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;--- Get the radiology data
. S RC=$$GETDATA(PATIEN)
. I RC S ECNT=ECNT+1 Q:RC<0
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** PLURAL/SINGULAR
SRPL(QNTY,WORD,SQ) ;
Q $S('$G(SQ):QNTY_" ",1:"")_$P(WORD,U,$S(QNTY=1:1,1:2))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX007A 6108 printed Apr 09, 2024@20:49:23 Page 2
RORX007A ;HOIFO/BH,SG,VAC - RADIOLOGY UTILIZATION (OVERFLOW) ;4/7/09 2:07pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,31**;Feb 17, 2006;Build 62
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2043 EN1^RAO7PC1 (supported)
+6 ;
+7 ;******************************************************************************
+8 ;******************************************************************************
+9 ; --- ROUTINE MODIFICATION LOG ---
+10 ;
+11 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+12 ;----------- ---------- ----------- ----------------------------------------
+13 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+14 ; 'include' or 'exclude'.
+15 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+16 ; clinics, or divisions for the report.
+17 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+18 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+19 ; additional identifier option selected
+20 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+21 ; identifiers.
+22 ;
+23 ;******************************************************************************
+24 ;******************************************************************************
+25 QUIT
+26 ;
+27 ;***** APPENDS MODIFIERS TO THE CPT CODE
+28 ;
+29 ; CPT CPT code
+30 ;
+31 ; NODE Closed root of the exam data node returned
+32 ; by the EN1^RAO7PC1
+33 ;
CPTMOD(CPT,NODE) ;
+1 NEW CPM,RORIM
+2 SET RORIM=""
+3 FOR
SET RORIM=$ORDER(@NODE@("CMOD",RORIM))
if RORIM=""
QUIT
Begin DoDot:1
+4 SET CPM=$PIECE($GET(@NODE@("CMOD",RORIM)),U)
+5 if CPM'=""
SET CPT=CPT_"-"_CPM
End DoDot:1
+6 QUIT CPT
+7 ;
+8 ;***** LOADS AND PROCESSES THE RADIOLOGY DATA
+9 ;
+10 ; DFN Patient IEN (in file #2)
+11 ;
+12 ; Return Values:
+13 ; <0 Error code
+14 ; 0 Ok
+15 ;
GETDATA(DFN) ;
+1 NEW CPT,EXAMID,NODE,PRNAME,RORBUF
+2 ;--- Get the data
+3 DO EN1^RAO7PC1(DFN,RORSDT,ROREDT,999999)
+4 ;data returned from radiology/nuclear medicine API in ^TMP($J,"RAE1"
+5 if '$DATA(^TMP($JOB,"RAE1",DFN))
QUIT 0
+6 ;
+7 ;--- Process the data
+8 SET EXAMID=""
+9 FOR
SET EXAMID=$ORDER(^TMP($JOB,"RAE1",DFN,EXAMID))
if EXAMID=""
QUIT
Begin DoDot:1
+10 SET NODE=$NAME(^TMP($JOB,"RAE1",DFN,EXAMID))
+11 SET RORBUF=$GET(@NODE)
SET CPT=$$CPTMOD($PIECE(RORBUF,U,10),NODE)
+12 ;--- Get Procedure Name
+13 SET PRNAME=$EXTRACT($PIECE(RORBUF,U),1,30)
if PRNAME=""
QUIT
+14 SET PRNAME=PRNAME_U_$SELECT(CPT'="":CPT,1:" ")
+15 ;--- Increment the counters
+16 ;naked reference: ^TMP("RORX007",$J,"PROC",PRNAME,DFN)
SET ^(DFN)=$GET(^TMP("RORX007",$JOB,"PROC",PRNAME,DFN))+1
+17 ;naked reference: ^TMP("RORX007",$J,"PROC",PRNAME,DFN,PRNAME)
SET ^(PRNAME)=$GET(^TMP("RORX007",$JOB,"PAT",DFN,PRNAME))+1
End DoDot:1
+18 ;
+19 ;--- Cleanup
+20 KILL ^TMP($JOB,"RAE1")
+21 QUIT 0
+22 ;
+23 ;***** OUTPUTS THE REPORT HEADER
+24 ;
+25 ; PARTAG Reference (IEN) to the parent tag
+26 ;
+27 ; Return Values:
+28 ; <0 Error code
+29 ; 0 Ok
+30 ;
+1 ;;PATIENTS(#,NAME,LAST4,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+2 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+3 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,TOTAL,UNIQUE,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+4 ;;PROCEDURES(#,NAME,CPT,PATIENTS,TOTAL)
+5 ;
+6 NEW HEADER,RC
+7 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+8 if HEADER<0
QUIT HEADER
+9 SET RC=$$TBLDEF^RORXU002("HEADER^RORX007A",HEADER)
+10 QUIT $SELECT(RC<0:RC,1:HEADER)
+11 ;
+12 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
+13 ;
+14 ; PARTAG Reference (IEN) to the parent tag
+15 ;
+16 ; [.STDT] Start and end dates of the report
+17 ; [.ENDT] are returned via these parameters
+18 ;
+19 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
+20 ; returned via this parameter
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; >0 IEN of the PARAMETERS element
+25 ;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
+1 NEW NAME,PARAMS,TMP
+2 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
+3 if PARAMS<0
QUIT PARAMS
+4 ;--- Additional parameters
+5 FOR NAME="MAXUTNUM","MINRPNUM"
Begin DoDot:1
+6 SET TMP=$$PARAM^RORTSK01(NAME)
+7 if TMP'=""
DO ADDVAL^RORTSK11(RORTSK,NAME,TMP,PARAMS)
End DoDot:1
+8 ;---
+9 QUIT PARAMS
+10 ;
+11 ;***** QUERIES THE REGISTRY
+12 ;
+13 ; FLAGS Flags for the $$SKIP^RORXU005
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Ok
+18 ; >0 Number of non-fatal errors
+19 ;
QUERY(FLAGS) ;
+1 NEW CNT,ECNT,IEN,IENS,PATIEN,RC,RORMSG,TMP,XREFNODE
+2 NEW RCC,FLAG
+3 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+4 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+5 ; End date for clinic/division utilization search
NEW RORCDENDT
+6 ;
+7 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+8 SET (CNT,ECNT,RC)=0
+9 ;=== Set up Clinic/Division list parameters
+10 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+11 ;
+12 ;--- Browse through the registry records
+13 SET IEN=0
+14 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+15 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+16 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+17 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+18 SET IENS=IEN_","
SET CNT=CNT+1
+19 ;--- Get the patient DFN
+20 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+21 ;--- Check for patient list and quit if not on list
+22 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+23 ;--- Check if the patient should be skipped
+24 if $$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
QUIT
+25 ;--- Check the patient against the ICD Filter
+26 SET RCC=0
+27 IF FLAG'="ALL"
Begin DoDot:2
+28 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+29 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+30 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+31 ;--- End of ICD check
+32 ;--- Check for Clinic or Division list and quit if not in list
+33 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+34 ;--- Get the radiology data
+35 SET RC=$$GETDATA(PATIEN)
+36 IF RC
SET ECNT=ECNT+1
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT
+37 ;---
+38 QUIT $SELECT(RC<0:RC,1:ECNT)
+39 ;
+40 ;***** PLURAL/SINGULAR
SRPL(QNTY,WORD,SQ) ;
+1 QUIT $SELECT('$GET(SQ):QNTY_" ",1:"")_$PIECE(WORD,U,$SELECT(QNTY=1:1,1:2))
