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  Sep 23, 2025@19:20:17                                                                                                                                                                                                     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)