RORX004 ;HOIFO/BH,SG,VAC - CLINIC FOLLOW UP ;4/7/09 2:06pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10061 2^VADPT (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*8 MAR 2010 V CARR Modified to add panel 180 to GUI. The
; function is to permit a filter on ICD9
; codes to Include or Exclude specific
; ICD9 codes. An extrinsic is called
; RORXU010 and it is evaluated on return
; as to whether or not to report the
; patient.
;ROR*1.5*13 DEC 2010 A SAUNDERS User can now select specific patients 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 Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;***** COMPILES THE "CLINIC FOLLOW UP" REPORT
; REPORT CODE: 004
;
; .RORTSK Task number and task parameters
;
; Return Values:
; <0 Error code
; 0 Ok
;
CLNFLWUP(RORTSK) ;
N ROREDT ; End date
N RORREG ; Registry IEN
N RORSDT ; Start date
N RORDLIST ; Flag to indicate if a division list exists
N RORDSTDT ; Start date for division utilization search
N RORDENDT ; End date for division utilization search
;
N CNT,ECNT,IEN,IENS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE,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 RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS)
Q:RC<0 RC
;
;--- Initialize constants and variables
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S ECNT=0,XREFNODE=$NA(^RORDATA(798,"AC",RORREG))
;
;=== Set up Division list parameters
I $D(RORTSK("PARAMS","DIVISIONS","C")) S RORDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORDSTDT,.RORDENDT)
;
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(100)
. S (CNT,IEN,RC)=0
. 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 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 for Division list and quit if not in list
. . I $D(RORTSK("PARAMS","DIVISIONS","C")),'$$CDUTIL^RORXU001(.RORTSK,DFN,RORDSTDT,RORDENDT) Q
. . ;--- Process the registry record
. . S TMP=$$PATIENT(IENS,PATIENTS)
. . I TMP<0 S ECNT=ECNT+1 Q
. Q:RC<0
;
;--- Cleanup
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
;;PATIENTS(#,NAME,LAST4,AGE,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;
N HEADER,RC
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX004",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 clinics
;patch 13: code from CLINLST has been incorporated into PARAMS^RORXU002
;S TMP=$$CLINLST^RORXU006(.RORTSK,PARAMS) ;removed in patch 13
;Q:TMP<0 TMP ;removed in patch 13
;---
Q PARAMS
;
;***** ADDS THE PATIENT DATA TO THE REPORT
;
; IENS IENS of the patient's record in the registry
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Skip the patient
;
PATIENT(IENS,PARTAG) ;
N CHK,CLINAIDS,DFN,IEN,RC,RCC,RORBUF,RORMSG,SEEN,TMP,VA,VADM,VAHOW,VAROOT,FLAG,PTAG,AGE,AGETYPE
S RC=0
S DFN=$$PTIEN^RORUTL01(+IENS)
;
;--- Evaluates patient if ICD filter is Include or Exclude
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER")),RCC=0
I FLAG'="ALL" D
.S RCC=$$ICD^RORXU010(DFN)
I (FLAG="INCLUDE")&(RCC=0) Q 1
I (FLAG="EXCLUDE")&(RCC=1) Q 1
;
;--- Only include patients that received utilization if care is true
I $$PARAM^RORTSK01("PATIENTS","CAREONLY") D Q:'TMP 1
. S CHK("ALL")=""
. S TMP=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.CHK)
;
;--- Select Seen/NotSeen patients
S SEEN=$$SEEN^RORXU001(RORSDT,ROREDT,DFN)
Q:'$$PARAM^RORTSK01("PATIENTS",$S(SEEN:"SEEN",1:"NOTSEEN")) 1
;
;--- Load the demographic data
D 2^VADPT
;
;--- The <PATIENT> tag
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
Q:PTAG<0 PTAG
;
;--- Patient Name
D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
;--- Last 4 digits of the SSN
S VA("BID")="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
;
;--- Patient age/DOB
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
;
;--- Date of Death
S TMP=$$DATE^RORXU002($P(VADM(6),U)\1)
D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
;--- Seen/Not Seen
D ADDVAL^RORTSK11(RORTSK,"SEEN",SEEN,PTAG,1)
;--- The latest date the patient was seen at any one of
;--- the given clinics
S TMP=$$LASTVSIT^RORXU001(DFN)\1
D ADDVAL^RORTSK11(RORTSK,"LSNDT",$$DATE^RORXU002(TMP),PTAG,1)
;
; ICN, if requested
I $$PARAM^RORTSK01("PATIENTS","ICN") D
. S TMP=$$ICN^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
;
; PACT, if requested
I $$PARAM^RORTSK01("PATIENTS","PACT") D
. S TMP=$$PACT^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"PACT",TMP,PTAG,1)
;
; PCP, if requested
I $$PARAM^RORTSK01("PATIENTS","PCP") D
. S TMP=$$PCP^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"PCP",TMP,PTAG,1)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX004 7847 printed Sep 23, 2025@19:20:19 Page 2
RORX004 ;HOIFO/BH,SG,VAC - CLINIC FOLLOW UP ;4/7/09 2:06pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10061 2^VADPT (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 add panel 180 to GUI. The
+14 ; function is to permit a filter on ICD9
+15 ; codes to Include or Exclude specific
+16 ; ICD9 codes. An extrinsic is called
+17 ; RORXU010 and it is evaluated on return
+18 ; as to whether or not to report the
+19 ; patient.
+20 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can now select specific patients or
+21 ; divisions for the report.
+22 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+23 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+24 ; requested.
+25 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
+26 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+27 ;******************************************************************************
+28 ;******************************************************************************
+29 QUIT
+30 ;
+31 ;***** COMPILES THE "CLINIC FOLLOW UP" REPORT
+32 ; REPORT CODE: 004
+33 ;
+34 ; .RORTSK Task number and task parameters
+35 ;
+36 ; Return Values:
+37 ; <0 Error code
+38 ; 0 Ok
+39 ;
CLNFLWUP(RORTSK) ;
+1 ; End date
NEW ROREDT
+2 ; Registry IEN
NEW RORREG
+3 ; Start date
NEW RORSDT
+4 ; Flag to indicate if a division list exists
NEW RORDLIST
+5 ; Start date for division utilization search
NEW RORDSTDT
+6 ; End date for division utilization search
NEW RORDENDT
+7 ;
+8 NEW CNT,ECNT,IEN,IENS,PATIENTS,RC,REPORT,RORPTN,SFLAGS,TMP,XREFNODE,DFN
+9 ;--- Root node of the report
+10 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+11 if REPORT<0
QUIT REPORT
+12 ;
+13 ;--- Get and prepare the report parameters
+14 SET RORREG=$$PARAM^RORTSK01("REGIEN")
+15 SET RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.SFLAGS)
+16 if RC<0
QUIT RC
+17 ;
+18 ;--- Initialize constants and variables
+19 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+20 SET ECNT=0
SET XREFNODE=$NAME(^RORDATA(798,"AC",RORREG))
+21 ;
+22 ;=== Set up Division list parameters
+23 IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))
SET RORDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORDSTDT,.RORDENDT)
+24 ;
+25 Begin DoDot:1
+26 ;--- Report header
+27 SET RC=$$HEADER(REPORT)
if RC<0
QUIT
+28 SET PATIENTS=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+29 IF PATIENTS<0
SET RC=+PATIENTS
QUIT
+30 DO ADDATTR^RORTSK11(RORTSK,PATIENTS,"TABLE","PATIENTS")
+31 ;
+32 ;--- Browse through the registry records
+33 DO TPPSETUP^RORTSK01(100)
+34 SET (CNT,IEN,RC)=0
+35 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+36 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+37 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+38 SET IENS=IEN_","
SET CNT=CNT+1
+39 ;--- Get patient DFN
+40 SET DFN=$$PTIEN^RORUTL01(IEN)
if DFN'>0
QUIT
+41 ;--- Check for patient list and quit if not in list
+42 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",DFN))
QUIT
+43 ;--- Check if the patient should be skipped
+44 if $$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
QUIT
+45 ;--- Check for Division list and quit if not in list
+46 IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))
IF '$$CDUTIL^RORXU001(.RORTSK,DFN,RORDSTDT,RORDENDT)
QUIT
+47 ;--- Process the registry record
+48 SET TMP=$$PATIENT(IENS,PATIENTS)
+49 IF TMP<0
SET ECNT=ECNT+1
QUIT
End DoDot:2
if RC<0
QUIT
+50 if RC<0
QUIT
End DoDot:1
+51 ;
+52 ;--- Cleanup
+53 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+54 ;
+55 ;***** OUTPUTS THE REPORT HEADER
+56 ;
+57 ; PARTAG Reference (IEN) to the parent tag
+58 ;
+59 ; Return Values:
+60 ; <0 Error code
+61 ; 0 Ok
+62 ;
+1 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+2 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+3 ;;PATIENTS(#,NAME,LAST4,DOD,SEEN,LSNDT,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+4 ;
+5 NEW HEADER,RC
+6 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+7 if HEADER<0
QUIT HEADER
+8 SET RC=$$TBLDEF^RORXU002("HEADER^RORX004",HEADER)
+9 QUIT $SELECT(RC<0:RC,1:HEADER)
+10 ;
+11 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
+12 ;
+13 ; PARTAG Reference (IEN) to the parent tag
+14 ;
+15 ; [.STDT] Start and end dates of the report
+16 ; [.ENDT] are returned via these parameters
+17 ;
+18 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
+19 ; returned via this parameter
+20 ;
+21 ; Return Values:
+22 ; <0 Error code
+23 ; >0 IEN of the PARAMETERS element
+24 ;
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 clinics
+5 ;patch 13: code from CLINLST has been incorporated into PARAMS^RORXU002
+6 ;S TMP=$$CLINLST^RORXU006(.RORTSK,PARAMS) ;removed in patch 13
+7 ;Q:TMP<0 TMP ;removed in patch 13
+8 ;---
+9 QUIT PARAMS
+10 ;
+11 ;***** ADDS THE PATIENT DATA TO THE REPORT
+12 ;
+13 ; IENS IENS of the patient's record in the registry
+14 ; PARTAG Reference (IEN) to the parent tag
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ; >0 Skip the patient
+20 ;
PATIENT(IENS,PARTAG) ;
+1 NEW CHK,CLINAIDS,DFN,IEN,RC,RCC,RORBUF,RORMSG,SEEN,TMP,VA,VADM,VAHOW,VAROOT,FLAG,PTAG,AGE,AGETYPE
+2 SET RC=0
+3 SET DFN=$$PTIEN^RORUTL01(+IENS)
+4 ;
+5 ;--- Evaluates patient if ICD filter is Include or Exclude
+6 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
SET RCC=0
+7 IF FLAG'="ALL"
Begin DoDot:1
+8 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:1
+9 IF (FLAG="INCLUDE")&(RCC=0)
QUIT 1
+10 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT 1
+11 ;
+12 ;--- Only include patients that received utilization if care is true
+13 IF $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+14 SET CHK("ALL")=""
+15 SET TMP=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.CHK)
End DoDot:1
if 'TMP
QUIT 1
+16 ;
+17 ;--- Select Seen/NotSeen patients
+18 SET SEEN=$$SEEN^RORXU001(RORSDT,ROREDT,DFN)
+19 if '$$PARAM^RORTSK01("PATIENTS",$SELECT(SEEN
QUIT 1
+20 ;
+21 ;--- Load the demographic data
+22 DO 2^VADPT
+23 ;
+24 ;--- The <PATIENT> tag
+25 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
+26 if PTAG<0
QUIT PTAG
+27 ;
+28 ;--- Patient Name
+29 DO ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
+30 ;--- Last 4 digits of the SSN
+31 SET VA("BID")="0000"
DO ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
+32 ;
+33 ;--- Patient age/DOB
+34 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:1
+35 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+36 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
End DoDot:1
+37 ;
+38 ;--- Date of Death
+39 SET TMP=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
+40 DO ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
+41 ;--- Seen/Not Seen
+42 DO ADDVAL^RORTSK11(RORTSK,"SEEN",SEEN,PTAG,1)
+43 ;--- The latest date the patient was seen at any one of
+44 ;--- the given clinics
+45 SET TMP=$$LASTVSIT^RORXU001(DFN)\1
+46 DO ADDVAL^RORTSK11(RORTSK,"LSNDT",$$DATE^RORXU002(TMP),PTAG,1)
+47 ;
+48 ; ICN, if requested
+49 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:1
+50 SET TMP=$$ICN^RORUTL02(DFN)
+51 DO ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
End DoDot:1
+52 ;
+53 ; PACT, if requested
+54 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:1
+55 SET TMP=$$PACT^RORUTL02(DFN)
+56 DO ADDVAL^RORTSK11(RORTSK,"PACT",TMP,PTAG,1)
End DoDot:1
+57 ;
+58 ; PCP, if requested
+59 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:1
+60 SET TMP=$$PCP^RORUTL02(DFN)
+61 DO ADDVAL^RORTSK11(RORTSK,"PCP",TMP,PTAG,1)
End DoDot:1
+62 QUIT 0
