Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX003

RORX003.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10103 FMADD^XLFDT, FMDIFF^XLFDT, FMTE^XLFDT (supported)
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
  1. ; 'include' or 'exclude'.
  1. ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
  1. ; clinics, or divisions for the report.
  1. ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
  1. ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
  1. ; additional identifier option selected
  1. ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
  1. ;
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** OUTPUTS THE REPORT HEADER
  1. ;
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; >0 IEN of the HEADER element
  1. ;
  1. N COLUMNS,HEADER,NAME,NOTES,TMP
  1. S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
  1. Q:HEADER<0 HEADER
  1. S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
  1. D ADDVAL^RORTSK11(RORTSK,"AGE_BASE_DATE",RORAGEDT,NOTES)
  1. ;---
  1. S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
  1. Q:COLUMNS<0 COLUMNS
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
  1. S RORFL798=".01",RORFLICR=""
  1. ;--- Required columns
  1. F NAME="#","NAME" D
  1. . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
  1. . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
  1. ;--- SSN or LAST4
  1. S NAME=$S($$OPTCOL^RORXU006("SSN"):"SSN",1:"LAST4")
  1. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS) Q:TMP<0 TMP
  1. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
  1. ;--- Optional columns
  1. F NAME="DOB","AGE","BIRTHSEX","RACE","ETHN","RISK","SELDT","CONFDT","UTIL","DOD" D
  1. . Q:'$$OPTCOL^RORXU006(NAME)
  1. . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
  1. . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",NAME)
  1. ; --- ICN if selected must be last column on report
  1. I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNHDR^RORXU006(RORTSK,COLUMNS)
  1. I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTHDR^RORXU006(RORTSK,COLUMNS)
  1. I $$PARAM^RORTSK01("PATIENTS","PCP") D PCPHDR^RORXU006(RORTSK,COLUMNS)
  1. ;---
  1. S:$$OPTCOL^RORXU006("CONFDT") RORFL798=RORFL798_";2"
  1. S:$$OPTCOL^RORXU006("SELDT") RORFL798=RORFL798_";3.2"
  1. Q HEADER
  1. ;
  1. ;***** COMPILES THE "GENERAL UTLIZATION AND DEMOGRAPHICS" REPORT
  1. ; REPORT CODE: 003
  1. ;
  1. ; .RORTSK Task number and task parameters
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. UTLDMG(RORTSK) ;
  1. N RORAGEDT ; Base date for age calculations
  1. N RORDTE0 ; Beginning of the Date Entered "sliding window"
  1. N ROREDT ; End date
  1. N RORFL798 ; Fields to load from the file #798
  1. N RORFLICR ; Fields to load from the file #799.4
  1. N RORREG ; Registry IEN
  1. N RORRISK ; Risk factor counters
  1. N RORSDT ; Start date
  1. N RORSUM ; Summary data
  1. N RORUTIL ; Requested utilization types
  1. N RORUCNT ; Utilization counters
  1. N RORCDLIST ; Flag to indicate whether a clinic or division list exists
  1. N RORCDSTDT ; Start date for clinic/division utilization search
  1. N RORCDENDT ; End date for clinic/division utilization search
  1. ;
  1. N CNT,ECNT,IEN,IENS,PARAMS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE
  1. N RCC,FLAG,DFN
  1. ;--- Root node of the report
  1. S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
  1. Q:REPORT<0 REPORT
  1. ;
  1. ;=== Get and prepare the report parameters
  1. S RORREG=$$PARAM^RORTSK01("REGIEN")
  1. S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS)
  1. Q:PARAMS<0 PARAMS
  1. ;--- Default set of columns for the summary-only report
  1. S XREFNODE=$NA(RORTSK("PARAMS","OPTIONAL_COLUMNS","C"))
  1. I $$PARAM^RORTSK01("OPTIONS","SUMMARY") D
  1. . F TMP="RACE","RISK","AGE","BIRTHSEX","UTIL" D
  1. . . S @XREFNODE@(TMP)=""
  1. S:$$OPTCOL^RORXU006("RACE") @XREFNODE@("ETHN")=""
  1. ;--- Construct the description of utilization types
  1. I '$$PARAM^RORTSK01("UTIL_TYPES","ALL") D
  1. . M RORUTIL=RORTSK("PARAMS","UTIL_TYPES","C")
  1. E S RORUTIL("ALL")=1
  1. S TMP=$$OPTXT^RORXU002(.RORUTIL,7980000.019)
  1. D ADDVAL^RORTSK11(RORTSK,"UTIL_TYPES",TMP,PARAMS)
  1. ;
  1. ;=== Initialize constants and variables
  1. S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
  1. S XREFNODE=$NA(^RORDATA(798,"AC",RORREG)),ECNT=0
  1. S TMP=$$FMDIFF^XLFDT(ROREDT,RORSDT)
  1. S RORAGEDT=$$FMADD^XLFDT(RORSDT,TMP\2)
  1. S RORDTE0=$P($$FMTE^XLFDT(DT,7),"/")-10 ; 10 year "sliding window"
  1. ;
  1. S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1. ;
  1. ;=== Set up Clinic/Division list parameters
  1. S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
  1. ;
  1. D
  1. . ;=== Report header
  1. . S RC=$$HEADER(REPORT) Q:RC<0
  1. . ;---
  1. . S PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1. . I PATIENTS<0 S RC=+PATIENTS Q
  1. . D ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
  1. . ;=== Browse through the registry records
  1. . D TPPSETUP^RORTSK01(95)
  1. . S (CNT,IEN,RC)=0
  1. . F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
  1. . . ;--- Calculate 'progress' for the GUI display
  1. . . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
  1. . . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
  1. . . S IENS=IEN_",",CNT=CNT+1
  1. . . ;-- Get patient DFN
  1. . . S DFN=$$PTIEN^RORUTL01(IEN) Q:DFN'>0
  1. . . ;--- Check for patient list and quit if not in list
  1. . . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",DFN)) Q
  1. . . ;--- Check if the patient should be skipped
  1. . . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
  1. . . ;--- Check if the ICD Filter includes or excludes the patient
  1. . . S RCC=0
  1. . . I FLAG'="ALL" D
  1. . . . S RCC=$$ICD^RORXU010(DFN)
  1. . . I (FLAG="INCLUDE")&(RCC=0) Q
  1. . . I (FLAG="EXCLUDE")&(RCC=1) Q
  1. . . ;--- End of ICD check.
  1. . . ;--- Check for Clinic or Division list and quit if not in list
  1. . . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT) Q
  1. . . ;--- Process the registry record
  1. . . S TMP=$$PATIENT^RORX003A(IENS,PATIENTS)
  1. . . I TMP<0 S ECNT=ECNT+1 Q
  1. . Q:RC<0
  1. . ;
  1. . ;=== Report summary
  1. . D TPPSETUP^RORTSK01(5)
  1. . S RC=$$SUMMARY^RORX003A(REPORT,PATIENTS) Q:RC<0
  1. . ;
  1. . ;=== Summary only
  1. . S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
  1. . D:'TMP UPDVAL^RORTSK11(RORTSK,PATIENTS,,,1)
  1. ;
  1. ;=== Cleanup
  1. Q $S(RC<0:RC,ECNT>0:-43,1:0)