RORX015 ;HOIFO/SG - PROCEDURES REPORT ;6/23/06 1:36pm
;;1.5;CLINICAL CASE REGISTRIES;**1,19,21,31,34**;Feb 17, 2006;Build 45
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as report column if
; additional identifier option selected
;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
;******************************************************************************
;******************************************************************************
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the HEADER element
;
;;PROCLST(#,PROCODE,PROCNAME,NP,NC,SOURCE)
;;PROCEDURES(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PROCEDURES(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PROCEDURES(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;
N HEADER,RC
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX015",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 PARAMS,TMP
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
Q:PARAMS<0 PARAMS
;--- Process the list of ICD codes
I $$PARAM^RORTSK01("PATIENTS","INPATIENT") D Q:TMP<0 TMP
. S TMP=$$ICDLST^RORXU008(.RORTSK,PARAMS,.RORICDL,.RORIGRP)
;--- Process the list of CPT codes
I $$PARAM^RORTSK01("PATIENTS","OUTPATIENT") D Q:TMP<0 TMP
. S TMP=$$CPTLST^RORXU006(.RORTSK,PARAMS)
;---
Q PARAMS
;
;***** COMPILES THE "PROCEDURES" REPORT
; REPORT CODE: 015
;
; .RORTSK Task number and task parameters
;
; @RORTMP@(
;
; "PAT", Number of patients
; DFN, Descriptor
; ^01: Last 4 digits of SSN
; ^02: Name
; ^03: Date of Death
; ^04: National ICN
; ^05: Age/DOB
; ^06: PACT
; ^07: PCP
; ^08: Future Appt.
; ^09: Future clinic
; "I",
; ICDIEN, Earliest Code Descriptor
; ^01: Date
; "C") Quantity
; "O",
; CPTIEN, Earliest Code Descriptor
; ^01: Date
; "C") Quantity
;
; "PROC", Totals
; ^01: Number of procedure codes
; ^02: Number of different codes
; "B",
; ProcName,
; Source,
; IEN) ""
; "I",
; ICDIEN, Procedure Descriptor
; ^01: Code
; ^02: Short description (current version)
; "C") Quantity
; "P") Number of unique patients
; "O",
; CPTIEN, Procedure Descriptor
; ^01: Code
; ^02: Short description (current version)
; "C") Quantity
; "P") Number of unique patients
;
; Return Values:
; <0 Error code
; 0 Ok
;
PROCLST(RORTSK) ;
N RORPROC ; Procedures mode (-1|1)
N ROREDT ; End date
N RORICDL ; Prepared list of ICD codes
N RORIGRP ; List of ICD groups
N RORREG ; Registry IEN
N RORSDT ; Start date
N RORTMP ; Closed root of the temporary buffer
;
N ECNT,RC,REPORT,SFLAGS,TMP
S (ECNT,RC)=0,(RORICDL,RORTMP)=""
;
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get and prepare the report parameters
S RORREG=$$PARAM^RORTSK01("REGIEN")
S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS) Q:RC<0 RC
S RORPROC=$$RPTMODE("PROC")
;
;--- Report header
S RC=$$HEADER(REPORT) Q:RC<0 RC
S RORTMP=$$ALLOC^RORTMP()
D
. ;--- Query the registry
. D TPPSETUP^RORTSK01(70)
. S RC=$$QUERY^RORX015A(SFLAGS)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Sort the data
. D TPPSETUP^RORTSK01(10)
. S RC=$$SORT^RORX015A()
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Store the results
. D TPPSETUP^RORTSK01(20)
. S RC=$$STORE^RORX015C(REPORT)
. I RC Q:RC<0 S ECNT=ECNT+RC
;
;--- Cleanup
D FREE^RORTMP(RORTMP),FREE^RORTMP(RORICDL)
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;***** DETERMINES THE REPORT MODE FOR PROCEDURES
;
; NAME Base name of the attribute ("PROC")
;
; Return Values:
; <0 "Did Not"
; 0 Not selected
; >0 "Did"
RPTMODE(NAME) ;
Q:$$PARAM^RORTSK01("PATIENTS",NAME) 1 ; "Did"
Q:$$PARAM^RORTSK01("PATIENTS","NO"_NAME) -1 ; "Did Not"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX015 6314 printed Sep 23, 2025@19:20:42 Page 2
RORX015 ;HOIFO/SG - PROCEDURES REPORT ;6/23/06 1:36pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,19,21,31,34**;Feb 17, 2006;Build 45
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+10 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as report column if
+11 ; additional identifier option selected
+12 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+13 ; identifiers.
+14 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN
+15 ;******************************************************************************
+16 ;******************************************************************************
+17 QUIT
+18 ;
+19 ;***** OUTPUTS THE REPORT HEADER
+20 ;
+21 ; PARTAG Reference (IEN) to the parent tag
+22 ;
+23 ; Return Values:
+24 ; <0 Error code
+25 ; >0 IEN of the HEADER element
+26 ;
+1 ;;PROCLST(#,PROCODE,PROCNAME,NP,NC,SOURCE)
+2 ;;PROCEDURES(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+3 ;;PROCEDURES(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+4 ;;PROCEDURES(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PROCODE,PROCNAME,DATE,SOURCE)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+5 ;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+6 ;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+7 ;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+8 ;
+9 NEW HEADER,RC
+10 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+11 if HEADER<0
QUIT HEADER
+12 SET RC=$$TBLDEF^RORXU002("HEADER^RORX015",HEADER)
+13 QUIT $SELECT(RC<0:RC,1:HEADER)
+14 ;
+15 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
+16 ;
+17 ; PARTAG Reference (IEN) to the parent tag
+18 ;
+19 ; [.STDT] Start and end dates of the report
+20 ; [.ENDT] are returned via these parameters
+21 ;
+22 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
+23 ; returned via this parameter
+24 ;
+25 ; Return Values:
+26 ; <0 Error code
+27 ; >0 IEN of the PARAMETERS element
+28 ;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
+1 NEW PARAMS,TMP
+2 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
+3 if PARAMS<0
QUIT PARAMS
+4 ;--- Process the list of ICD codes
+5 IF $$PARAM^RORTSK01("PATIENTS","INPATIENT")
Begin DoDot:1
+6 SET TMP=$$ICDLST^RORXU008(.RORTSK,PARAMS,.RORICDL,.RORIGRP)
End DoDot:1
if TMP<0
QUIT TMP
+7 ;--- Process the list of CPT codes
+8 IF $$PARAM^RORTSK01("PATIENTS","OUTPATIENT")
Begin DoDot:1
+9 SET TMP=$$CPTLST^RORXU006(.RORTSK,PARAMS)
End DoDot:1
if TMP<0
QUIT TMP
+10 ;---
+11 QUIT PARAMS
+12 ;
+13 ;***** COMPILES THE "PROCEDURES" REPORT
+14 ; REPORT CODE: 015
+15 ;
+16 ; .RORTSK Task number and task parameters
+17 ;
+18 ; @RORTMP@(
+19 ;
+20 ; "PAT", Number of patients
+21 ; DFN, Descriptor
+22 ; ^01: Last 4 digits of SSN
+23 ; ^02: Name
+24 ; ^03: Date of Death
+25 ; ^04: National ICN
+26 ; ^05: Age/DOB
+27 ; ^06: PACT
+28 ; ^07: PCP
+29 ; ^08: Future Appt.
+30 ; ^09: Future clinic
+31 ; "I",
+32 ; ICDIEN, Earliest Code Descriptor
+33 ; ^01: Date
+34 ; "C") Quantity
+35 ; "O",
+36 ; CPTIEN, Earliest Code Descriptor
+37 ; ^01: Date
+38 ; "C") Quantity
+39 ;
+40 ; "PROC", Totals
+41 ; ^01: Number of procedure codes
+42 ; ^02: Number of different codes
+43 ; "B",
+44 ; ProcName,
+45 ; Source,
+46 ; IEN) ""
+47 ; "I",
+48 ; ICDIEN, Procedure Descriptor
+49 ; ^01: Code
+50 ; ^02: Short description (current version)
+51 ; "C") Quantity
+52 ; "P") Number of unique patients
+53 ; "O",
+54 ; CPTIEN, Procedure Descriptor
+55 ; ^01: Code
+56 ; ^02: Short description (current version)
+57 ; "C") Quantity
+58 ; "P") Number of unique patients
+59 ;
+60 ; Return Values:
+61 ; <0 Error code
+62 ; 0 Ok
+63 ;
PROCLST(RORTSK) ;
+1 ; Procedures mode (-1|1)
NEW RORPROC
+2 ; End date
NEW ROREDT
+3 ; Prepared list of ICD codes
NEW RORICDL
+4 ; List of ICD groups
NEW RORIGRP
+5 ; Registry IEN
NEW RORREG
+6 ; Start date
NEW RORSDT
+7 ; Closed root of the temporary buffer
NEW RORTMP
+8 ;
+9 NEW ECNT,RC,REPORT,SFLAGS,TMP
+10 SET (ECNT,RC)=0
SET (RORICDL,RORTMP)=""
+11 ;
+12 ;--- Root node of the report
+13 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+14 if REPORT<0
QUIT REPORT
+15 ;
+16 ;--- Get and prepare the report parameters
+17 SET RORREG=$$PARAM^RORTSK01("REGIEN")
+18 SET RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS)
if RC<0
QUIT RC
+19 SET RORPROC=$$RPTMODE("PROC")
+20 ;
+21 ;--- Report header
+22 SET RC=$$HEADER(REPORT)
if RC<0
QUIT RC
+23 SET RORTMP=$$ALLOC^RORTMP()
+24 Begin DoDot:1
+25 ;--- Query the registry
+26 DO TPPSETUP^RORTSK01(70)
+27 SET RC=$$QUERY^RORX015A(SFLAGS)
+28 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+29 ;--- Sort the data
+30 DO TPPSETUP^RORTSK01(10)
+31 SET RC=$$SORT^RORX015A()
+32 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+33 ;--- Store the results
+34 DO TPPSETUP^RORTSK01(20)
+35 SET RC=$$STORE^RORX015C(REPORT)
+36 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
+37 ;
+38 ;--- Cleanup
+39 DO FREE^RORTMP(RORTMP)
DO FREE^RORTMP(RORICDL)
+40 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+41 ;
+42 ;***** DETERMINES THE REPORT MODE FOR PROCEDURES
+43 ;
+44 ; NAME Base name of the attribute ("PROC")
+45 ;
+46 ; Return Values:
+47 ; <0 "Did Not"
+48 ; 0 Not selected
+49 ; >0 "Did"
RPTMODE(NAME) ;
+1 ; "Did"
if $$PARAM^RORTSK01("PATIENTS",NAME)
QUIT 1
+2 ; "Did Not"
if $$PARAM^RORTSK01("PATIENTS","NO"_NAME)
QUIT -1
+3 QUIT 0
