RORX021 ;BPOIFO/CLR - HCV DAA CANDIDATES REPORT ;26 May 2015 4:02 PM
;;1.5;CLINICAL CASE REGISTRIES;**17,21,26,31,33,34**;Feb 17, 2006;Build 45
;
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*26 JAN 2015 T KOPP Added FIB4 parameters set and header
; for FIB4 score. Remove treatment status.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
; identifiers.
;ROR*1.5*33 APR 2018 F TRAXLER Adding FUT_APPT as identifier.
;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN column.
;******************************************************************************
;
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the HEADER element
;
;;PATIENTS(#,NAME,LAST4,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PATIENTS(#,NAME,LAST4,AGE,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,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^RORX021",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** COMPILES THE "POTENTIAL DAA CANDIDATES" REPORT
; REPORT CODE: 021
;
; .RORTSK Task number and task parameters
;
; The ^TMP("RORX021",$J) global node is used by this function.
;
; ^TMP("RORX021",$J,
; "PAT",
; DFN, Patient descriptor
; ^01: Last 4 digits of SSN
; ^02: Patient name
; ^03: Treatment History (not used)
; ^04: National ICN
; ^05: FIB4 score
; ^06: Patient Care Team
; ^07: Primary Care Provider
; ^08: Age/DOB
; "LR",
; Category,
; Date(inverse) = Result
;
; "RX",
; Date(inverse),
; Generic Drug Name,
; Drug IEN,
; RX #,
; Count) = ""
;
; Return Values:
; <0 Error code
; 0 Ok
;
HCVDAA(RORTSK) ;
N RORLTST ; Closed root of the list of lab tests for the
; ; Lab search API
N RORREG ; Registry IEN
N RORSDT ; Pharmacy start date
N ROREDT ; Pharmacy end date
N RORXGRP ; List of drug groups
N RORXL ; Closed root of the drug list for the pharmacy
; ; search API
N RORLC ; sub-file and LOINC codes to search for FIB4
N ECNT,NSPT,RC,SFLAGS,TMP,BUF,RORDATA
N REPORT,PARAMS,ELEMENT ;XML parent variables
;
S (RORXL,RORLTST)="",(ECNT,RC)=0
K ^TMP("RORX021",$J)
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get and prepare the report parameters
D
. N Z
. S RORREG=$$PARAM^RORTSK01("REGIEN") ; Registry IEN
. S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORXSDT,.RORXEDT,.SFLAGS)
. I PARAMS<0 S RC=PARAMS Q
. S Z=0,RORDATA("IDLST")=""
. F S Z=$O(RORTSK("PARAMS","LRGRANGES","C",Z)) Q:'Z D
.. S RORDATA("IDLST")=RORDATA("IDLST")_$S(RORDATA("IDLST")'="":",",1:"")_Z
. K:RORDATA("IDLST")="" RORDATA("IDLST")
. I $D(RORDATA("IDLST")) D Q:RC<0
.. D LIVPARAM^RORX019(.RORDATA,.RORTSK,.RORLC)
.. ;--- Add lab results range parameters to output
.. S RC=$$PARAMS(PARAMS,.RORDATA,.RORTSK)
.. Q:RC<0
.. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"FIB4",$$OPTXT^RORXU002(.RORDATA),PARAMS)
.. I ELEMENT<0 S RC=ELEMENT Q
. Q:RC<0
. ;--- Get and store treatment history parameters
. M BUF=RORTSK("PARAMS","TREATMENT_HISTORY","A") Q:$D(BUF)<10
. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"TREATMENT_HISTORY",$$OPTXT^RORXU002(.BUF),PARAMS)
. I ELEMENT'>0 S RC=ELEMENT Q
. S TMP=""
. F S TMP=$O(BUF(TMP)) Q:TMP="" D Q:RC<0
. . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,BUF(TMP))
. ;--- Report header
. S RC=$$HEADER(REPORT) Q:RC<0
. ;--- Query the registry
. D TPPSETUP^RORTSK01(80)
. S RC=$$QUERY^RORX021A(REPORT,SFLAGS,.NSPT,.RORLC)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Store the results
. D TPPSETUP^RORTSK01(20)
. S RC=$$STORE^RORX021A(REPORT,NSPT)
. I RC Q:RC<0 S ECNT=ECNT+RC
;--- Cleanup
K ^TMP("RORX021",$J)
;
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;*****************************************************************************
;OUTPUT REPORT 'RANGE' PARAMETERS, SET UP REPORT ID LIST (EXTRINISIC FUNCTION)
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;*****************************************************************************
PARAMS(PARTAG,RORDATA,RORTSK) ; Currently, only FIB-4 is used for this report
N PARAMS,DESC,TMP,RC S RC=0
;--- Lab test ranges
S RORDATA("RANGE",4)=0 ;initialize FIB4 to 'no range passed in'
I $D(RORTSK("PARAMS","LRGRANGES","C",4)) D Q:RC<0 RC
. N ELEMENT,NODE,RTAG,RANGE
. S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
. S RTAG=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARTAG)
. S RANGE=0,DESC=$$RTEXT^RORX019A(4,.RORDATA,.RORTSK) ;get range description
. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",DESC,RTAG) ;add desc to output
. I ELEMENT<0 S RC=ELEMENT Q
. D ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",4)
. ;--- Process the range values
. S TMP=$G(@NODE@(4,"L"))
. I TMP'="" D S RANGE=1
.. D ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP) S RORDATA("RANGE",4)=1
.. S TMP=$G(@NODE@(4,"H"))
.. I TMP'="" D S RANGE=1
... D ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP) S RORDATA("RANGE",4)=1
.. I RANGE D ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
Q RC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX021 6474 printed Nov 22, 2024@16:55:08 Page 2
RORX021 ;BPOIFO/CLR - HCV DAA CANDIDATES REPORT ;26 May 2015 4:02 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**17,21,26,31,33,34**;Feb 17, 2006;Build 45
+2 ;
+3 ;******************************************************************************
+4 ; --- ROUTINE MODIFICATION LOG ---
+5 ;
+6 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+7 ;----------- ---------- ----------- ----------------------------------------
+8 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+9 ; additional identifier option selected
+10 ;ROR*1.5*26 JAN 2015 T KOPP Added FIB4 parameters set and header
+11 ; for FIB4 score. Remove treatment status.
+12 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
+13 ; identifiers.
+14 ;ROR*1.5*33 APR 2018 F TRAXLER Adding FUT_APPT as identifier.
+15 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN column.
+16 ;******************************************************************************
+17 ;
+18 QUIT
+19 ;
+20 ;***** OUTPUTS THE REPORT HEADER
+21 ;
+22 ; PARTAG Reference (IEN) to the parent tag
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; >0 IEN of the HEADER element
+27 ;
+1 ;;PATIENTS(#,NAME,LAST4,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+2 ;;PATIENTS(#,NAME,LAST4,AGE,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+3 ;;PATIENTS(#,NAME,LAST4,DOB,HCV_DATE,HCV,GT,FILL_DATE,FILL_MED,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+4 ;
+5 NEW HEADER,RC
+6 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+7 if HEADER<0
QUIT HEADER
+8 SET RC=$$TBLDEF^RORXU002("HEADER^RORX021",HEADER)
+9 QUIT $SELECT(RC<0:RC,1:HEADER)
+10 ;
+11 ;***** COMPILES THE "POTENTIAL DAA CANDIDATES" REPORT
+12 ; REPORT CODE: 021
+13 ;
+14 ; .RORTSK Task number and task parameters
+15 ;
+16 ; The ^TMP("RORX021",$J) global node is used by this function.
+17 ;
+18 ; ^TMP("RORX021",$J,
+19 ; "PAT",
+20 ; DFN, Patient descriptor
+21 ; ^01: Last 4 digits of SSN
+22 ; ^02: Patient name
+23 ; ^03: Treatment History (not used)
+24 ; ^04: National ICN
+25 ; ^05: FIB4 score
+26 ; ^06: Patient Care Team
+27 ; ^07: Primary Care Provider
+28 ; ^08: Age/DOB
+29 ; "LR",
+30 ; Category,
+31 ; Date(inverse) = Result
+32 ;
+33 ; "RX",
+34 ; Date(inverse),
+35 ; Generic Drug Name,
+36 ; Drug IEN,
+37 ; RX #,
+38 ; Count) = ""
+39 ;
+40 ; Return Values:
+41 ; <0 Error code
+42 ; 0 Ok
+43 ;
HCVDAA(RORTSK) ;
+1 ; Closed root of the list of lab tests for the
NEW RORLTST
+2 ; ; Lab search API
+3 ; Registry IEN
NEW RORREG
+4 ; Pharmacy start date
NEW RORSDT
+5 ; Pharmacy end date
NEW ROREDT
+6 ; List of drug groups
NEW RORXGRP
+7 ; Closed root of the drug list for the pharmacy
NEW RORXL
+8 ; ; search API
+9 ; sub-file and LOINC codes to search for FIB4
NEW RORLC
+10 NEW ECNT,NSPT,RC,SFLAGS,TMP,BUF,RORDATA
+11 ;XML parent variables
NEW REPORT,PARAMS,ELEMENT
+12 ;
+13 SET (RORXL,RORLTST)=""
SET (ECNT,RC)=0
+14 KILL ^TMP("RORX021",$JOB)
+15 ;--- Root node of the report
+16 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+17 if REPORT<0
QUIT REPORT
+18 ;
+19 ;--- Get and prepare the report parameters
+20 Begin DoDot:1
+21 NEW Z
+22 ; Registry IEN
SET RORREG=$$PARAM^RORTSK01("REGIEN")
+23 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORXSDT,.RORXEDT,.SFLAGS)
+24 IF PARAMS<0
SET RC=PARAMS
QUIT
+25 SET Z=0
SET RORDATA("IDLST")=""
+26 FOR
SET Z=$ORDER(RORTSK("PARAMS","LRGRANGES","C",Z))
if 'Z
QUIT
Begin DoDot:2
+27 SET RORDATA("IDLST")=RORDATA("IDLST")_$SELECT(RORDATA("IDLST")'="":",",1:"")_Z
End DoDot:2
+28 if RORDATA("IDLST")=""
KILL RORDATA("IDLST")
+29 IF $DATA(RORDATA("IDLST"))
Begin DoDot:2
+30 DO LIVPARAM^RORX019(.RORDATA,.RORTSK,.RORLC)
+31 ;--- Add lab results range parameters to output
+32 SET RC=$$PARAMS(PARAMS,.RORDATA,.RORTSK)
+33 if RC<0
QUIT
+34 SET ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"FIB4",$$OPTXT^RORXU002(.RORDATA),PARAMS)
+35 IF ELEMENT<0
SET RC=ELEMENT
QUIT
End DoDot:2
if RC<0
QUIT
+36 if RC<0
QUIT
+37 ;--- Get and store treatment history parameters
+38 MERGE BUF=RORTSK("PARAMS","TREATMENT_HISTORY","A")
if $DATA(BUF)<10
QUIT
+39 SET ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"TREATMENT_HISTORY",$$OPTXT^RORXU002(.BUF),PARAMS)
+40 IF ELEMENT'>0
SET RC=ELEMENT
QUIT
+41 SET TMP=""
+42 FOR
SET TMP=$ORDER(BUF(TMP))
if TMP=""
QUIT
Begin DoDot:2
+43 SET RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,BUF(TMP))
End DoDot:2
if RC<0
QUIT
+44 ;--- Report header
+45 SET RC=$$HEADER(REPORT)
if RC<0
QUIT
+46 ;--- Query the registry
+47 DO TPPSETUP^RORTSK01(80)
+48 SET RC=$$QUERY^RORX021A(REPORT,SFLAGS,.NSPT,.RORLC)
+49 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+50 ;--- Store the results
+51 DO TPPSETUP^RORTSK01(20)
+52 SET RC=$$STORE^RORX021A(REPORT,NSPT)
+53 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
+54 ;--- Cleanup
+55 KILL ^TMP("RORX021",$JOB)
+56 ;
+57 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+58 ;
+59 ;*****************************************************************************
+60 ;OUTPUT REPORT 'RANGE' PARAMETERS, SET UP REPORT ID LIST (EXTRINISIC FUNCTION)
+61 ;
+62 ; PARTAG Reference (IEN) to the parent tag
+63 ;
+64 ; Return Values:
+65 ; <0 Error code
+66 ; 0 Ok
+67 ;*****************************************************************************
PARAMS(PARTAG,RORDATA,RORTSK) ; Currently, only FIB-4 is used for this report
+1 NEW PARAMS,DESC,TMP,RC
SET RC=0
+2 ;--- Lab test ranges
+3 ;initialize FIB4 to 'no range passed in'
SET RORDATA("RANGE",4)=0
+4 IF $DATA(RORTSK("PARAMS","LRGRANGES","C",4))
Begin DoDot:1
+5 NEW ELEMENT,NODE,RTAG,RANGE
+6 SET NODE=$NAME(RORTSK("PARAMS","LRGRANGES","C"))
+7 SET RTAG=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARTAG)
+8 ;get range description
SET RANGE=0
SET DESC=$$RTEXT^RORX019A(4,.RORDATA,.RORTSK)
+9 ;add desc to output
SET ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",DESC,RTAG)
+10 IF ELEMENT<0
SET RC=ELEMENT
QUIT
+11 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",4)
+12 ;--- Process the range values
+13 SET TMP=$GET(@NODE@(4,"L"))
+14 IF TMP'=""
Begin DoDot:2
+15 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
SET RORDATA("RANGE",4)=1
+16 SET TMP=$GET(@NODE@(4,"H"))
+17 IF TMP'=""
Begin DoDot:3
+18 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
SET RORDATA("RANGE",4)=1
End DoDot:3
SET RANGE=1
+19 IF RANGE
DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
End DoDot:2
SET RANGE=1
End DoDot:1
if RC<0
QUIT RC
+20 QUIT RC
+21 ;
