RORX003 ;HOIFO/SG,VAC - GENERAL UTILIZATION AND DEMOGRAPHICS ;4/7/09 2:06pm
;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,30,31**;Feb 17, 2006;Build 62
;
; This routine uses the following IAs:
;
; #10103 FMADD^XLFDT, FMDIFF^XLFDT, FMTE^XLFDT (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*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
;
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
;
;******************************************************************************
;******************************************************************************
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the HEADER element
;
N COLUMNS,HEADER,NAME,NOTES,TMP
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
D ADDVAL^RORTSK11(RORTSK,"AGE_BASE_DATE",RORAGEDT,NOTES)
;---
S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
Q:COLUMNS<0 COLUMNS
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
S RORFL798=".01",RORFLICR=""
;--- Required columns
F NAME="#","NAME" D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
;--- SSN or LAST4
S NAME=$S($$OPTCOL^RORXU006("SSN"):"SSN",1:"LAST4")
S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS) Q:TMP<0 TMP
D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
;--- Optional columns
F NAME="DOB","AGE","BIRTHSEX","RACE","ETHN","RISK","SELDT","CONFDT","UTIL","DOD" D
. Q:'$$OPTCOL^RORXU006(NAME)
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
; --- ICN if selected must be last column on report
I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNHDR^RORXU006(RORTSK,COLUMNS)
I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTHDR^RORXU006(RORTSK,COLUMNS)
I $$PARAM^RORTSK01("PATIENTS","PCP") D PCPHDR^RORXU006(RORTSK,COLUMNS)
;---
S:$$OPTCOL^RORXU006("CONFDT") RORFL798=RORFL798_";2"
S:$$OPTCOL^RORXU006("SELDT") RORFL798=RORFL798_";3.2"
Q HEADER
;
;***** COMPILES THE "GENERAL UTLIZATION AND DEMOGRAPHICS" REPORT
; REPORT CODE: 003
;
; .RORTSK Task number and task parameters
;
; Return Values:
; <0 Error code
; 0 Ok
;
UTLDMG(RORTSK) ;
N RORAGEDT ; Base date for age calculations
N RORDTE0 ; Beginning of the Date Entered "sliding window"
N ROREDT ; End date
N RORFL798 ; Fields to load from the file #798
N RORFLICR ; Fields to load from the file #799.4
N RORREG ; Registry IEN
N RORRISK ; Risk factor counters
N RORSDT ; Start date
N RORSUM ; Summary data
N RORUTIL ; Requested utilization types
N RORUCNT ; Utilization counters
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,PARAMS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE
N RCC,FLAG,DFN
;--- 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 PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS)
Q:PARAMS<0 PARAMS
;--- Default set of columns for the summary-only report
S XREFNODE=$NA(RORTSK("PARAMS","OPTIONAL_COLUMNS","C"))
I $$PARAM^RORTSK01("OPTIONS","SUMMARY") D
. F TMP="RACE","RISK","AGE","BIRTHSEX","UTIL" D
. . S @XREFNODE@(TMP)=""
S:$$OPTCOL^RORXU006("RACE") @XREFNODE@("ETHN")=""
;--- Construct the description of utilization types
I '$$PARAM^RORTSK01("UTIL_TYPES","ALL") D
. M RORUTIL=RORTSK("PARAMS","UTIL_TYPES","C")
E S RORUTIL("ALL")=1
S TMP=$$OPTXT^RORXU002(.RORUTIL,7980000.019)
D ADDVAL^RORTSK11(RORTSK,"UTIL_TYPES",TMP,PARAMS)
;
;=== Initialize constants and variables
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S XREFNODE=$NA(^RORDATA(798,"AC",RORREG)),ECNT=0
S TMP=$$FMDIFF^XLFDT(ROREDT,RORSDT)
S RORAGEDT=$$FMADD^XLFDT(RORSDT,TMP\2)
S RORDTE0=$P($$FMTE^XLFDT(DT,7),"/")-10 ; 10 year "sliding window"
;
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
;
D
. ;=== Report header
. S RC=$$HEADER(REPORT) Q:RC<0
. ;---
. S PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
. I PATIENTS<0 S RC=+PATIENTS Q
. D ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
. ;=== Browse through the registry records
. D TPPSETUP^RORTSK01(95)
. S (CNT,IEN,RC)=0
. F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
. . ;--- Calculate 'progress' for the GUI display
. . 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 DFN=$$PTIEN^RORUTL01(IEN) Q:DFN'>0
. . ;--- Check for patient list and quit if not in list
. . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",DFN)) Q
. . ;--- Check if the patient should be skipped
. . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
. . ;--- Check if the ICD Filter includes or excludes the patient
. . S RCC=0
. . I FLAG'="ALL" D
. . . S RCC=$$ICD^RORXU010(DFN)
. . 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,DFN,RORCDSTDT,RORCDENDT) Q
. . ;--- Process the registry record
. . S TMP=$$PATIENT^RORX003A(IENS,PATIENTS)
. . I TMP<0 S ECNT=ECNT+1 Q
. Q:RC<0
. ;
. ;=== Report summary
. D TPPSETUP^RORTSK01(5)
. S RC=$$SUMMARY^RORX003A(REPORT,PATIENTS) Q:RC<0
. ;
. ;=== Summary only
. S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
. D:'TMP UPDVAL^RORTSK11(RORTSK,PATIENTS,,,1)
;
;=== Cleanup
Q $S(RC<0:RC,ECNT>0:-43,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX003 7198 printed Dec 13, 2024@01:44:18 Page 2
RORX003 ;HOIFO/SG,VAC - GENERAL UTILIZATION AND DEMOGRAPHICS ;4/7/09 2:06pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,30,31**;Feb 17, 2006;Build 62
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10103 FMADD^XLFDT, FMDIFF^XLFDT, FMTE^XLFDT (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*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
+21 ;
+22 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
+23 ;
+24 ;******************************************************************************
+25 ;******************************************************************************
+26 QUIT
+27 ;
+28 ;***** OUTPUTS THE REPORT HEADER
+29 ;
+30 ; PARTAG Reference (IEN) to the parent tag
+31 ;
+32 ; Return Values:
+33 ; <0 Error code
+34 ; >0 IEN of the HEADER element
+35 ;
+1 NEW COLUMNS,HEADER,NAME,NOTES,TMP
+2 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+3 if HEADER<0
QUIT HEADER
+4 SET NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
+5 DO ADDVAL^RORTSK11(RORTSK,"AGE_BASE_DATE",RORAGEDT,NOTES)
+6 ;---
+7 SET COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
+8 if COLUMNS<0
QUIT COLUMNS
+9 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
+10 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
+11 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
+12 SET RORFL798=".01"
SET RORFLICR=""
+13 ;--- Required columns
+14 FOR NAME="#","NAME"
Begin DoDot:1
+15 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+16 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
End DoDot:1
+17 ;--- SSN or LAST4
+18 SET NAME=$SELECT($$OPTCOL^RORXU006("SSN"):"SSN",1:"LAST4")
+19 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
if TMP<0
QUIT TMP
+20 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
+21 ;--- Optional columns
+22 FOR NAME="DOB","AGE","BIRTHSEX","RACE","ETHN","RISK","SELDT","CONFDT","UTIL","DOD"
Begin DoDot:1
+23 if '$$OPTCOL^RORXU006(NAME)
QUIT
+24 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+25 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
End DoDot:1
+26 ; --- ICN if selected must be last column on report
+27 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ICNHDR^RORXU006(RORTSK,COLUMNS)
+28 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO PACTHDR^RORXU006(RORTSK,COLUMNS)
+29 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO PCPHDR^RORXU006(RORTSK,COLUMNS)
+30 ;---
+31 if $$OPTCOL^RORXU006("CONFDT")
SET RORFL798=RORFL798_";2"
+32 if $$OPTCOL^RORXU006("SELDT")
SET RORFL798=RORFL798_";3.2"
+33 QUIT HEADER
+34 ;
+35 ;***** COMPILES THE "GENERAL UTLIZATION AND DEMOGRAPHICS" REPORT
+36 ; REPORT CODE: 003
+37 ;
+38 ; .RORTSK Task number and task parameters
+39 ;
+40 ; Return Values:
+41 ; <0 Error code
+42 ; 0 Ok
+43 ;
UTLDMG(RORTSK) ;
+1 ; Base date for age calculations
NEW RORAGEDT
+2 ; Beginning of the Date Entered "sliding window"
NEW RORDTE0
+3 ; End date
NEW ROREDT
+4 ; Fields to load from the file #798
NEW RORFL798
+5 ; Fields to load from the file #799.4
NEW RORFLICR
+6 ; Registry IEN
NEW RORREG
+7 ; Risk factor counters
NEW RORRISK
+8 ; Start date
NEW RORSDT
+9 ; Summary data
NEW RORSUM
+10 ; Requested utilization types
NEW RORUTIL
+11 ; Utilization counters
NEW RORUCNT
+12 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+13 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+14 ; End date for clinic/division utilization search
NEW RORCDENDT
+15 ;
+16 NEW CNT,ECNT,IEN,IENS,PARAMS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE
+17 NEW RCC,FLAG,DFN
+18 ;--- Root node of the report
+19 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+20 if REPORT<0
QUIT REPORT
+21 ;
+22 ;=== Get and prepare the report parameters
+23 SET RORREG=$$PARAM^RORTSK01("REGIEN")
+24 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS)
+25 if PARAMS<0
QUIT PARAMS
+26 ;--- Default set of columns for the summary-only report
+27 SET XREFNODE=$NAME(RORTSK("PARAMS","OPTIONAL_COLUMNS","C"))
+28 IF $$PARAM^RORTSK01("OPTIONS","SUMMARY")
Begin DoDot:1
+29 FOR TMP="RACE","RISK","AGE","BIRTHSEX","UTIL"
Begin DoDot:2
+30 SET @XREFNODE@(TMP)=""
End DoDot:2
End DoDot:1
+31 if $$OPTCOL^RORXU006("RACE")
SET @XREFNODE@("ETHN")=""
+32 ;--- Construct the description of utilization types
+33 IF '$$PARAM^RORTSK01("UTIL_TYPES","ALL")
Begin DoDot:1
+34 MERGE RORUTIL=RORTSK("PARAMS","UTIL_TYPES","C")
End DoDot:1
+35 IF '$TEST
SET RORUTIL("ALL")=1
+36 SET TMP=$$OPTXT^RORXU002(.RORUTIL,7980000.019)
+37 DO ADDVAL^RORTSK11(RORTSK,"UTIL_TYPES",TMP,PARAMS)
+38 ;
+39 ;=== Initialize constants and variables
+40 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+41 SET XREFNODE=$NAME(^RORDATA(798,"AC",RORREG))
SET ECNT=0
+42 SET TMP=$$FMDIFF^XLFDT(ROREDT,RORSDT)
+43 SET RORAGEDT=$$FMADD^XLFDT(RORSDT,TMP\2)
+44 ; 10 year "sliding window"
SET RORDTE0=$PIECE($$FMTE^XLFDT(DT,7),"/")-10
+45 ;
+46 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+47 ;
+48 ;=== Set up Clinic/Division list parameters
+49 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+50 ;
+51 Begin DoDot:1
+52 ;=== Report header
+53 SET RC=$$HEADER(REPORT)
if RC<0
QUIT
+54 ;---
+55 SET PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+56 IF PATIENTS<0
SET RC=+PATIENTS
QUIT
+57 DO ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
+58 ;=== Browse through the registry records
+59 DO TPPSETUP^RORTSK01(95)
+60 SET (CNT,IEN,RC)=0
+61 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+62 ;--- Calculate 'progress' for the GUI display
+63 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+64 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+65 SET IENS=IEN_","
SET CNT=CNT+1
+66 ;-- Get patient DFN
+67 SET DFN=$$PTIEN^RORUTL01(IEN)
if DFN'>0
QUIT
+68 ;--- Check for patient list and quit if not in list
+69 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",DFN))
QUIT
+70 ;--- Check if the patient should be skipped
+71 if $$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
QUIT
+72 ;--- Check if the ICD Filter includes or excludes the patient
+73 SET RCC=0
+74 IF FLAG'="ALL"
Begin DoDot:3
+75 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:3
+76 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+77 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+78 ;--- End of ICD check.
+79 ;--- Check for Clinic or Division list and quit if not in list
+80 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT)
QUIT
+81 ;--- Process the registry record
+82 SET TMP=$$PATIENT^RORX003A(IENS,PATIENTS)
+83 IF TMP<0
SET ECNT=ECNT+1
QUIT
End DoDot:2
if RC<0
QUIT
+84 if RC<0
QUIT
+85 ;
+86 ;=== Report summary
+87 DO TPPSETUP^RORTSK01(5)
+88 SET RC=$$SUMMARY^RORX003A(REPORT,PATIENTS)
if RC<0
QUIT
+89 ;
+90 ;=== Summary only
+91 SET TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
+92 if 'TMP
DO UPDVAL^RORTSK11(RORTSK,PATIENTS,,,1)
End DoDot:1
+93 ;
+94 ;=== Cleanup
+95 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)