RORX023A ;ALB/TMK - HCV SUSTAINED VIROLOGIC RESPONSE REPORT(QUERY & STORE) ;7/15/11 3:37pm
;;1.5;CLINICAL CASE REGISTRIES;**24,27,31,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10103 FMADD^XLFDT (supported)
; #10104 UP^XLFSTR (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*24 JUN 2014 T KOPP New report
;ROR*1.5*27 FEB 2015 T KOPP Fix selection of SVR chg ">" to "<"
; at LTSCB+11 and pull SVR/NO SVR logic
; into callable function $$SVR
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
;******************************************************************************
;******************************************************************************
Q
;
;***** LAB SEARCH CALLBACK
;
; .ROR8DST Reference to the ROR8DST parameter.
;
; INVDT IEN of the Lab test (inverted date)
;
; .RESULT Reference to a local variable, which contains
; the result (see the $$LTSEARCH^RORUTL10).
;
; Return Values:
; <0 Error code (the search will be aborted)
; 0 Ok
; 1 Skip this result
; 2 Skip this and all remaining results
;
LTSCB(ROR8DST,INVDT,RESULT) ;
N DATE,IEN,NAME,RC,TMP,VAL,CAT,SUB
S IEN=+RESULT(2) Q:IEN'>0 1 ; IEN of the Lab test
S NAME=$P(RESULT(2),U,2) Q:NAME="" 1 ; Name of the test
S DATE=+$P(RESULT(1),U,1) Q:DATE'>0 1 ; Date of the test
S CAT=$P(RESULT(2),U,4) Q:CAT="" 1 ; Category(lab group) of the test
S VAL=$P(RESULT(1),U,3) Q:VAL="" 1 ; Result of the test
;--- Skip if test is not in lab groups HepC GT, Quant, or Qual
S TMP=0
I CAT'="HepC GT",(CAT'="HepC Quant"),(CAT'="HepC Qual") S TMP=1
I 'TMP,CAT'="HepC GT" D
. S TMP=$S($E(VAL)="<":0,VAL["NOT DETECT":0,VAL["NO HCV RNA":0,VAL["NO RNA":0,$E(VAL,1,3)="NEG":0,VAL["NEGATIVE":0,VAL["NO_HCV_RNA_DETECTED":0,VAL["TND":0,1:1)
I 'TMP,+VAL=VAL,VAL<51 S TMP=1 ;skip abnormally low values
I TMP Q 1
S SUB=$S(CAT="HepC GT":"GT",1:"HepC")
;--- Store the result
S @ROR8DST@(SUB,DATE)=VAL
Q 0
;
;***** QUERIES THE REGISTRY
; REPORT Parent IEN of report
; FLAGS Flags for the $$SKIP^RORXU005
; .NSPT Number of selected patients is returned here
;
; Return Values:
; <0 Fatal error
; 0 Ok
; >0 Number of non-fatal errors
;
; Assumes RORREG = the ien of the ROR REGISTER PARAMETERS entry in file 798.1 being processed
QUERY(REPORT,FLAGS,NSPT) ;
N RORLDST ; Descriptor for Lab search API
N RORPTN ; Number of patients in the registry
N RORXDST ; Descriptor for pharmacy search API
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 RORXEDT ; RX end date
N RORXSDT ; RX start date
;
N CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
N RCC,FLAG,HCV,GT,ROR1,ROR2,ROR3,RORX023,RORTAKN,RORXL
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S (CNT,ECNT,NSPT,RC)=0,(UTEDT,UTSDT)=0,RORX023=1
;=== Set up parameters
;--- Utilization date range
D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
. S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
;--- Number of patients in the registry
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
;--- Lab parameters
S RORLDST("RORCB")="$$LTSCB^RORX023A"
;--- Labs date range
S LTSDT=""
S LTEDT=DT
;--- Shift the Labs end date
S LTEDT=$$FMADD^XLFDT(LTEDT,1)
;== Pharm parameters
S RORXDST("GENERIC")=1 ;only meds with generic name
S RORXDST("RORCB")="$$RXOCB^RORX023A" ;call back routine
;--- RX start and end dates
S RORXSDT=2000101 ;start date 1/1/1900
S RORXEDT=DT
;--- RX list of HepC registry drugs
S RORXL=$$ALLOC^RORTMP()
S RC=$$DRUGLIST^RORUTL16(RORXL,+RORREG)
;--- Shift the RXs end date
S RORXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
;--- Set up Clinic/Division list parameters date_range_3
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
;--- Set up ICD parameters
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
;=== Browse through the registry records
S IEN=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 PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
. I +$P($G(^DPT(PATIEN,.35)),U)>0 Q ;patient has died
. ;--- Check if the patient should be skipped based on standard filters
. Q:$$SKIP^RORXU005(IEN,FLAGS,UTSDT,UTEDT)
. ;--- Check if patient should be skipped because of ICD codes
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;
. ;--- Check if patient should be skipped because of Clinic or Division
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;=== Check meds and labs
. ; Find last date HepC registry meds were taken, add 84 days to the date of the last med fill/refill plus the days supply
. ; Include in report if the patient has selected HepC Quant or HepC Qual lab results:
. ; Result either starts with a < -- OR -- includes the phrase "NOT DETECT" or "NO HCV RNA" or "NO RNA" or "NEGATIVE"
. ; -- OR -- starts "NEG" -- OR -- = "NO_HCV_RNA_DETECTED" or "TND".) and the last result was on or after 84 days past
. ; the last date registry med was taken calculated date.
. ;
. S SKIP=1,UTIL=0
. D I RC<0 S ECNT=ECNT+1,RC=0 Q
. . N RORCHK
. . S RORCHK=$$SVR(PATIEN,RORXSDT,RORXEDT,RORREG,RORXL,LTSDT,LTEDT,.RORLDST,.RORXDST),RC=RORCHK
. . I RORCHK<0 Q ;error
. . I RORCHK S SKIP=0 ; SVR criteria met - don't skip
. ;
. ;--- Check if patient should be skipped because no utilization in the corresponding date range
. I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. . K TMP S TMP("ALL")=1
. . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
. . S:'UTIL SKIP=1
. ;
. ;--- Skip the patient if not all selection criteria have been met
. I SKIP K ^TMP("RORX023",$J,"PAT",PATIEN) Q
. ;
. ;--- Get and store the patient's data last4^name
. D VADEM^RORUTL05(PATIEN,1) S VA("BID")="0000"
. S TMP=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
. S TMP=TMP_U_$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
. S TMP=TMP_U_$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
. . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. S ^TMP("RORX023",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_U_TMP_U_AGE
. S NSPT=NSPT+1 ;increment count of selected patients
;
D FREE^RORTMP(RORXL) ;clean up drug list
Q $S(RC<0:RC,1:ECNT)
;
;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
;
; Need to identify the
;
; .ROR8DST Reference to the ROR8DST parameter.
;
;
; ORDER Order number (from condensed list)
;
; FLAGS Flags describing the order to be
; processed.
;
; DRUG Dispensed drug
; ^01: Drug IEN in file #50
; ^02: Drug name
;
; DATE Order date (issue date for outpatient
; drugs or start date for inpatient)
;
;Return Values:
; <0 Error code (the search will be aborted)
; 0 Ok
; 1 Skip this result
; 2 Skip this and all remaining results
;
RXOCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
N DRUGIEN,DRUGNAME,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,RORDS,RORTAKEN,TMP
;--- Skip med if med does not have a generic name
I ROR8DST("GENERIC") D
. S DRUGIEN=+ROR8DST("RORXGEN"),DRUGNAME=$P(ROR8DST("RORXGEN"),U,2)
E Q 1
Q:(DRUGIEN'>0)!(DRUGNAME="") 1
;--- Process the order
S TMP=$G(^TMP("PS",$J,"RXN",0))
S RXNUM=$P(TMP,U) S:RXNUM="" RXNUM=" "
S RXCNT=0
;--- Original prescription
I ORDFLG["I" D ;--- Inpatient
. S OFD=$P($G(^TMP("PS",$J,0)),U,5) ; Start Date
. S RORDS=$P($G(^TMP("PS",$J,0)),U,7) ; Days supply
. S RORTAKEN=$$FMADD^XLFDT(OFD,+RORDS) ; Last date taken
. S RXCNT=RXCNT+1
. S @ROR8DST@(RORTAKEN)=""
E D ;--- Outpatient
. S OFD=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
. S RORDS=$P($G(^TMP("PS",$J,0)),U,7) ; Days supply
. S RORTAKEN=$$FMADD^XLFDT(OFD,+RORDS) ; Last date taken
. Q:(OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
. S RXCNT=RXCNT+1
. S @ROR8DST@(RORTAKEN)=""
;--- Refills and partials
F RPSUB="REF","PAR" D
. S $P(RXBUF,U)=$E(RPSUB,1)
. S IRP=0
. F S IRP=$O(^TMP("PS",$J,RPSUB,IRP)) Q:IRP'>0 D
. . S TMP=$G(^TMP("PS",$J,RPSUB,IRP,0))
. . I TMP>0 S RXCNT=RXCNT+1 D
. . . S RORDS=$P(TMP,U,2) ; Days supply
. . . S RORTAKEN=$$FMADD^XLFDT(+TMP,+RORDS) ; Last date taken
. . . S @ROR8DST@(RORTAKEN)=""
Q 0
;
;***** CHECKS FOR SVR CRITERIA MET
;PATIEN the ien of patient entry from PATIENT file (#2)
;RORREG the ien of the ROR REGISTER PARAMETERS entry in file 798.1 being processed
;RORXL Closed root of the array containing RX list of HepC registry drugs from call to $$DRUGLIST^RORUTL1
;RORXEDT RX end date
;RORXSDT RX start date
;LTSDT Labs start date
;LTEDT Labs end date
;RORLDST Descriptor for Lab search API
;RORXDST Descriptor for pharmacy search API
;
;=== SVR criteria 'rules'
; Find last date HepC registry meds were taken, add the days supply to the date of the last med fill/refill
; Include in report if the patient has selected HepC Quant or HepC Qual lab results:
; Result either starts with a < -- OR -- includes the phrase "NOT DETECT" or "NO HCV RNA" or "NO RNA" or "NEGATIVE"
; -- OR -- starts "NEG" -- OR -- = "NO_HCV_RNA_DETECTED" or "TND".) and the last result was on or after 84 days past
; the last date registry med was taken calculated date.
;
; Return Values:
; <0 Error code
; 0 SVR criteria not met
; 1 SVR criteria met
;
SVR(PATIEN,RORXSDT,RORXEDT,RORREG,RORXL,LTSDT,LTEDT,RORLDST,RORXDST) ;
N RC,RORLABDT,RORTAKN
; Get registry meds for patient
S RORXDST=$NA(^TMP("RORX023",$J,"PAT",PATIEN,"RX"))
S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RORXEDT)
I RC<0 Q RC ;error occurred
I $G(RORXDST("SKIP"))!'$O(@RORXDST@("")) K RORXDST("SKIP") Q 0 ;patient never took or still takes registry meds
;
S RORLDST=$NA(^TMP("RORX023",$J,"PAT",PATIEN,"LR"))
S RC=$$LTSEARCH^RORUTL10(PATIEN,+RORREG,.RORLDST,,LTSDT,LTEDT)
I RC<0 Q RC ;error
;=== SVR if patient has a qualifying lab test at least 84 days past the last med taken date
I '$O(@RORLDST@("HepC","")) Q 0 ; No lab result date
S RORLABDT=(9999999-$O(@RORLDST@("HepC","")))/1 ; Data stored inversely, reverse to normal and strip time
S RORTAKN=$O(@RORXDST@(" "),-1)
I 'RORTAKN Q 0 ; No last taken date
I RORLABDT<$$FMADD^XLFDT(RORTAKN,84) Q 0 ; No qualifying lab test at least 84 days past the last taken date
Q 1
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
; NSPT Number of selected patients
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(REPORT,NSPT) ;
N RORFDT ;med last taken date
N RORLBG ;lab test type (GT, HCV)
N RORLVAL ;lab value
N RORLDST
N RORXDST
N RORICN
N RORPACT
N RORPCP
N RORBODY,PTAG ;parent iens
N CNT,DATE,DFN,ECNT,IEN,LAST4,LTLST,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,THIST,AGETYPE,AGE
N GT,HCV,HCVHEPC
S (ECNT,RC)=0,(LTLST,PTLST,RXLST)=-1
;--- Create 'patients' table
S RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
D ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
S (CNT,DFN,PTCNT)=0
F S DFN=$O(^TMP("RORX023",$J,"PAT",DFN)) Q:DFN'>0 D Q:RC<0
. S TMP=$S(NSPT>0:CNT/NSPT,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1,NODE=$NA(^TMP("RORX023",$J,"PAT",DFN))
. ;--- Patient's data
. S TMP=$G(@NODE)
. S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),RORICN=$P(TMP,U,4),RORPACT=$P(TMP,U,5),RORPCP=$P(TMP,U,6),AGE=$P(TMP,U,7)
. ;--- get lab results
. S RORLDST=$NA(^TMP("RORX023",$J,"PAT",DFN,"LR"))
. S RORXDST=$NA(^TMP("RORX023",$J,"PAT",DFN,"RX"))
. ;--- Gets most recent result for Qualifying HepC and GT lab tests
. ; HEPC=date of most recent quanitative or qualitative test^result
. ; GT=date of most recent GT test^result
. K HEPC,GT
. F RORLBG="HepC","GT" D
. . S NODE=$$UP^XLFSTR(RORLBG),@NODE="^"
. . S RORFDT=$O(@RORLDST@(RORLBG,""))
. . Q:RORFDT=""
. . S RORLVAL=$G(@RORLDST@(RORLBG,RORFDT))
. . S RORFDT=(9999999-RORFDT)\1 ;strip time
. . S @NODE=(RORFDT)_U_RORLVAL
. S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,RORBODY,,DFN)
. S RORFDT=$O(@RORXDST@(""),-1)
. ;--- store
. D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,PTAG,2)
. ;--- Patient age/DOB
. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"HCV_DATE",$P(HEPC,U),PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"HCV",$P(HEPC,U,2),PTAG,3)
. D ADDVAL^RORTSK11(RORTSK,"GT",$P(GT,U,2),PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"LAST_TAKEN",RORFDT,PTAG,1)
. I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",RORICN,PTAG,1)
. I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",RORPACT,PTAG,1)
. I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",RORPCP,PTAG,1)
. S PTCNT=PTCNT+1
;--- Inactivate the patient list tag if the list is empty
D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
;---
Q ECNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX023A 14724 printed Sep 23, 2025@19:21 Page 2
RORX023A ;ALB/TMK - HCV SUSTAINED VIROLOGIC RESPONSE REPORT(QUERY & STORE) ;7/15/11 3:37pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**24,27,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10103 FMADD^XLFDT (supported)
+6 ; #10104 UP^XLFSTR (supported)
+7 ;
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*24 JUN 2014 T KOPP New report
+15 ;ROR*1.5*27 FEB 2015 T KOPP Fix selection of SVR chg ">" to "<"
+16 ; at LTSCB+11 and pull SVR/NO SVR logic
+17 ; into callable function $$SVR
+18 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+19 ; identifiers.
+20 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+21 ;******************************************************************************
+22 ;******************************************************************************
+23 QUIT
+24 ;
+25 ;***** LAB SEARCH CALLBACK
+26 ;
+27 ; .ROR8DST Reference to the ROR8DST parameter.
+28 ;
+29 ; INVDT IEN of the Lab test (inverted date)
+30 ;
+31 ; .RESULT Reference to a local variable, which contains
+32 ; the result (see the $$LTSEARCH^RORUTL10).
+33 ;
+34 ; Return Values:
+35 ; <0 Error code (the search will be aborted)
+36 ; 0 Ok
+37 ; 1 Skip this result
+38 ; 2 Skip this and all remaining results
+39 ;
LTSCB(ROR8DST,INVDT,RESULT) ;
+1 NEW DATE,IEN,NAME,RC,TMP,VAL,CAT,SUB
+2 ; IEN of the Lab test
SET IEN=+RESULT(2)
if IEN'>0
QUIT 1
+3 ; Name of the test
SET NAME=$PIECE(RESULT(2),U,2)
if NAME=""
QUIT 1
+4 ; Date of the test
SET DATE=+$PIECE(RESULT(1),U,1)
if DATE'>0
QUIT 1
+5 ; Category(lab group) of the test
SET CAT=$PIECE(RESULT(2),U,4)
if CAT=""
QUIT 1
+6 ; Result of the test
SET VAL=$PIECE(RESULT(1),U,3)
if VAL=""
QUIT 1
+7 ;--- Skip if test is not in lab groups HepC GT, Quant, or Qual
+8 SET TMP=0
+9 IF CAT'="HepC GT"
IF (CAT'="HepC Quant")
IF (CAT'="HepC Qual")
SET TMP=1
+10 IF 'TMP
IF CAT'="HepC GT"
Begin DoDot:1
+11 SET TMP=$SELECT($EXTRACT(VAL)="<":0,VAL["NOT DETECT":0,VAL["NO HCV RNA":0,VAL["NO RNA":0,$EXTRACT(VAL,1,3)="NEG":0,VAL["NEGATIVE":0,VAL["NO_HCV_RNA_DETECTED":0,VAL["TND":0,1:1)
End DoDot:1
+12 ;skip abnormally low values
IF 'TMP
IF +VAL=VAL
IF VAL<51
SET TMP=1
+13 IF TMP
QUIT 1
+14 SET SUB=$SELECT(CAT="HepC GT":"GT",1:"HepC")
+15 ;--- Store the result
+16 SET @ROR8DST@(SUB,DATE)=VAL
+17 QUIT 0
+18 ;
+19 ;***** QUERIES THE REGISTRY
+20 ; REPORT Parent IEN of report
+21 ; FLAGS Flags for the $$SKIP^RORXU005
+22 ; .NSPT Number of selected patients is returned here
+23 ;
+24 ; Return Values:
+25 ; <0 Fatal error
+26 ; 0 Ok
+27 ; >0 Number of non-fatal errors
+28 ;
+29 ; Assumes RORREG = the ien of the ROR REGISTER PARAMETERS entry in file 798.1 being processed
QUERY(REPORT,FLAGS,NSPT) ;
+1 ; Descriptor for Lab search API
NEW RORLDST
+2 ; Number of patients in the registry
NEW RORPTN
+3 ; Descriptor for pharmacy search API
NEW RORXDST
+4 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+5 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+6 ; End date for clinic/division utilization search
NEW RORCDENDT
+7 ; RX end date
NEW RORXEDT
+8 ; RX start date
NEW RORXSDT
+9 ;
+10 NEW CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
+11 NEW RCC,FLAG,HCV,GT,ROR1,ROR2,ROR3,RORX023,RORTAKN,RORXL
+12 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+13 SET (CNT,ECNT,NSPT,RC)=0
SET (UTEDT,UTSDT)=0
SET RORX023=1
+14 ;=== Set up parameters
+15 ;--- Utilization date range
+16 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+17 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+18 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
End DoDot:1
+19 ;--- Number of patients in the registry
+20 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+21 ;--- Lab parameters
+22 SET RORLDST("RORCB")="$$LTSCB^RORX023A"
+23 ;--- Labs date range
+24 SET LTSDT=""
+25 SET LTEDT=DT
+26 ;--- Shift the Labs end date
+27 SET LTEDT=$$FMADD^XLFDT(LTEDT,1)
+28 ;== Pharm parameters
+29 ;only meds with generic name
SET RORXDST("GENERIC")=1
+30 ;call back routine
SET RORXDST("RORCB")="$$RXOCB^RORX023A"
+31 ;--- RX start and end dates
+32 ;start date 1/1/1900
SET RORXSDT=2000101
+33 SET RORXEDT=DT
+34 ;--- RX list of HepC registry drugs
+35 SET RORXL=$$ALLOC^RORTMP()
+36 SET RC=$$DRUGLIST^RORUTL16(RORXL,+RORREG)
+37 ;--- Shift the RXs end date
+38 SET RORXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
+39 ;--- Set up Clinic/Division list parameters date_range_3
+40 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+41 ;--- Set up ICD parameters
+42 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+43 ;=== Browse through the registry records
+44 SET IEN=0
+45 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+46 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+47 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+48 SET IENS=IEN_","
SET CNT=CNT+1
+49 ;--- Get patient DFN
+50 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+51 ;patient has died
IF +$PIECE($GET(^DPT(PATIEN,.35)),U)>0
QUIT
+52 ;--- Check if the patient should be skipped based on standard filters
+53 if $$SKIP^RORXU005(IEN,FLAGS,UTSDT,UTEDT)
QUIT
+54 ;--- Check if patient should be skipped because of ICD codes
+55 SET RCC=0
+56 IF FLAG'="ALL"
Begin DoDot:2
+57 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+58 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+59 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+60 ;
+61 ;--- Check if patient should be skipped because of Clinic or Division
+62 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+63 ;=== Check meds and labs
+64 ; Find last date HepC registry meds were taken, add 84 days to the date of the last med fill/refill plus the days supply
+65 ; Include in report if the patient has selected HepC Quant or HepC Qual lab results:
+66 ; Result either starts with a < -- OR -- includes the phrase "NOT DETECT" or "NO HCV RNA" or "NO RNA" or "NEGATIVE"
+67 ; -- OR -- starts "NEG" -- OR -- = "NO_HCV_RNA_DETECTED" or "TND".) and the last result was on or after 84 days past
+68 ; the last date registry med was taken calculated date.
+69 ;
+70 SET SKIP=1
SET UTIL=0
+71 Begin DoDot:2
+72 NEW RORCHK
+73 SET RORCHK=$$SVR(PATIEN,RORXSDT,RORXEDT,RORREG,RORXL,LTSDT,LTEDT,.RORLDST,.RORXDST)
SET RC=RORCHK
+74 ;error
IF RORCHK<0
QUIT
+75 ; SVR criteria met - don't skip
IF RORCHK
SET SKIP=0
End DoDot:2
IF RC<0
SET ECNT=ECNT+1
SET RC=0
QUIT
+76 ;
+77 ;--- Check if patient should be skipped because no utilization in the corresponding date range
+78 IF 'SKIP
if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:2
+79 KILL TMP
SET TMP("ALL")=1
+80 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
+81 if 'UTIL
SET SKIP=1
End DoDot:2
+82 ;
+83 ;--- Skip the patient if not all selection criteria have been met
+84 IF SKIP
KILL ^TMP("RORX023",$JOB,"PAT",PATIEN)
QUIT
+85 ;
+86 ;--- Get and store the patient's data last4^name
+87 DO VADEM^RORUTL05(PATIEN,1)
SET VA("BID")="0000"
+88 SET TMP=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+89 SET TMP=TMP_U_$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
+90 SET TMP=TMP_U_$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
+91 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:2
+92 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:2
+93 SET ^TMP("RORX023",$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_U_TMP_U_AGE
+94 ;increment count of selected patients
SET NSPT=NSPT+1
End DoDot:1
if RC<0
QUIT
+95 ;
+96 ;clean up drug list
DO FREE^RORTMP(RORXL)
+97 QUIT $SELECT(RC<0:RC,1:ECNT)
+98 ;
+99 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
+100 ;
+101 ; Need to identify the
+102 ;
+103 ; .ROR8DST Reference to the ROR8DST parameter.
+104 ;
+105 ;
+106 ; ORDER Order number (from condensed list)
+107 ;
+108 ; FLAGS Flags describing the order to be
+109 ; processed.
+110 ;
+111 ; DRUG Dispensed drug
+112 ; ^01: Drug IEN in file #50
+113 ; ^02: Drug name
+114 ;
+115 ; DATE Order date (issue date for outpatient
+116 ; drugs or start date for inpatient)
+117 ;
+118 ;Return Values:
+119 ; <0 Error code (the search will be aborted)
+120 ; 0 Ok
+121 ; 1 Skip this result
+122 ; 2 Skip this and all remaining results
+123 ;
RXOCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW DRUGIEN,DRUGNAME,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,RORDS,RORTAKEN,TMP
+2 ;--- Skip med if med does not have a generic name
+3 IF ROR8DST("GENERIC")
Begin DoDot:1
+4 SET DRUGIEN=+ROR8DST("RORXGEN")
SET DRUGNAME=$PIECE(ROR8DST("RORXGEN"),U,2)
End DoDot:1
+5 IF '$TEST
QUIT 1
+6 if (DRUGIEN'>0)!(DRUGNAME="")
QUIT 1
+7 ;--- Process the order
+8 SET TMP=$GET(^TMP("PS",$JOB,"RXN",0))
+9 SET RXNUM=$PIECE(TMP,U)
if RXNUM=""
SET RXNUM=" "
+10 SET RXCNT=0
+11 ;--- Original prescription
+12 ;--- Inpatient
IF ORDFLG["I"
Begin DoDot:1
+13 ; Start Date
SET OFD=$PIECE($GET(^TMP("PS",$JOB,0)),U,5)
+14 ; Days supply
SET RORDS=$PIECE($GET(^TMP("PS",$JOB,0)),U,7)
+15 ; Last date taken
SET RORTAKEN=$$FMADD^XLFDT(OFD,+RORDS)
+16 SET RXCNT=RXCNT+1
+17 SET @ROR8DST@(RORTAKEN)=""
End DoDot:1
+18 ;--- Outpatient
IF '$TEST
Begin DoDot:1
+19 ; Original Fill Date
SET OFD=+$PIECE($GET(^TMP("PS",$JOB,"RXN",0)),U,6)
+20 ; Days supply
SET RORDS=$PIECE($GET(^TMP("PS",$JOB,0)),U,7)
+21 ; Last date taken
SET RORTAKEN=$$FMADD^XLFDT(OFD,+RORDS)
+22 if (OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
QUIT
+23 SET RXCNT=RXCNT+1
+24 SET @ROR8DST@(RORTAKEN)=""
End DoDot:1
+25 ;--- Refills and partials
+26 FOR RPSUB="REF","PAR"
Begin DoDot:1
+27 SET $PIECE(RXBUF,U)=$EXTRACT(RPSUB,1)
+28 SET IRP=0
+29 FOR
SET IRP=$ORDER(^TMP("PS",$JOB,RPSUB,IRP))
if IRP'>0
QUIT
Begin DoDot:2
+30 SET TMP=$GET(^TMP("PS",$JOB,RPSUB,IRP,0))
+31 IF TMP>0
SET RXCNT=RXCNT+1
Begin DoDot:3
+32 ; Days supply
SET RORDS=$PIECE(TMP,U,2)
+33 ; Last date taken
SET RORTAKEN=$$FMADD^XLFDT(+TMP,+RORDS)
+34 SET @ROR8DST@(RORTAKEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT 0
+36 ;
+37 ;***** CHECKS FOR SVR CRITERIA MET
+38 ;PATIEN the ien of patient entry from PATIENT file (#2)
+39 ;RORREG the ien of the ROR REGISTER PARAMETERS entry in file 798.1 being processed
+40 ;RORXL Closed root of the array containing RX list of HepC registry drugs from call to $$DRUGLIST^RORUTL1
+41 ;RORXEDT RX end date
+42 ;RORXSDT RX start date
+43 ;LTSDT Labs start date
+44 ;LTEDT Labs end date
+45 ;RORLDST Descriptor for Lab search API
+46 ;RORXDST Descriptor for pharmacy search API
+47 ;
+48 ;=== SVR criteria 'rules'
+49 ; Find last date HepC registry meds were taken, add the days supply to the date of the last med fill/refill
+50 ; Include in report if the patient has selected HepC Quant or HepC Qual lab results:
+51 ; Result either starts with a < -- OR -- includes the phrase "NOT DETECT" or "NO HCV RNA" or "NO RNA" or "NEGATIVE"
+52 ; -- OR -- starts "NEG" -- OR -- = "NO_HCV_RNA_DETECTED" or "TND".) and the last result was on or after 84 days past
+53 ; the last date registry med was taken calculated date.
+54 ;
+55 ; Return Values:
+56 ; <0 Error code
+57 ; 0 SVR criteria not met
+58 ; 1 SVR criteria met
+59 ;
SVR(PATIEN,RORXSDT,RORXEDT,RORREG,RORXL,LTSDT,LTEDT,RORLDST,RORXDST) ;
+1 NEW RC,RORLABDT,RORTAKN
+2 ; Get registry meds for patient
+3 SET RORXDST=$NAME(^TMP("RORX023",$JOB,"PAT",PATIEN,"RX"))
+4 SET RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RORXEDT)
+5 ;error occurred
IF RC<0
QUIT RC
+6 ;patient never took or still takes registry meds
IF $GET(RORXDST("SKIP"))!'$ORDER(@RORXDST@(""))
KILL RORXDST("SKIP")
QUIT 0
+7 ;
+8 SET RORLDST=$NAME(^TMP("RORX023",$JOB,"PAT",PATIEN,"LR"))
+9 SET RC=$$LTSEARCH^RORUTL10(PATIEN,+RORREG,.RORLDST,,LTSDT,LTEDT)
+10 ;error
IF RC<0
QUIT RC
+11 ;=== SVR if patient has a qualifying lab test at least 84 days past the last med taken date
+12 ; No lab result date
IF '$ORDER(@RORLDST@("HepC",""))
QUIT 0
+13 ; Data stored inversely, reverse to normal and strip time
SET RORLABDT=(9999999-$ORDER(@RORLDST@("HepC","")))/1
+14 SET RORTAKN=$ORDER(@RORXDST@(" "),-1)
+15 ; No last taken date
IF 'RORTAKN
QUIT 0
+16 ; No qualifying lab test at least 84 days past the last taken date
IF RORLABDT<$$FMADD^XLFDT(RORTAKN,84)
QUIT 0
+17 QUIT 1
+18 ;
+19 ;***** STORES THE REPORT DATA
+20 ;
+21 ; REPORT IEN of the REPORT element
+22 ; NSPT Number of selected patients
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; 0 Ok
+27 ; >0 Number of non-fatal errors
+28 ;
STORE(REPORT,NSPT) ;
+1 ;med last taken date
NEW RORFDT
+2 ;lab test type (GT, HCV)
NEW RORLBG
+3 ;lab value
NEW RORLVAL
+4 NEW RORLDST
+5 NEW RORXDST
+6 NEW RORICN
+7 NEW RORPACT
+8 NEW RORPCP
+9 ;parent iens
NEW RORBODY,PTAG
+10 NEW CNT,DATE,DFN,ECNT,IEN,LAST4,LTLST,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,THIST,AGETYPE,AGE
+11 NEW GT,HCV,HCVHEPC
+12 SET (ECNT,RC)=0
SET (LTLST,PTLST,RXLST)=-1
+13 ;--- Create 'patients' table
+14 SET RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+15 DO ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
+16 SET (CNT,DFN,PTCNT)=0
+17 FOR
SET DFN=$ORDER(^TMP("RORX023",$JOB,"PAT",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+18 SET TMP=$SELECT(NSPT>0:CNT/NSPT,1:"")
+19 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+20 SET CNT=CNT+1
SET NODE=$NAME(^TMP("RORX023",$JOB,"PAT",DFN))
+21 ;--- Patient's data
+22 SET TMP=$GET(@NODE)
+23 SET LAST4=$PIECE(TMP,U)
SET PTNAME=$PIECE(TMP,U,2)
SET RORICN=$PIECE(TMP,U,4)
SET RORPACT=$PIECE(TMP,U,5)
SET RORPCP=$PIECE(TMP,U,6)
SET AGE=$PIECE(TMP,U,7)
+24 ;--- get lab results
+25 SET RORLDST=$NAME(^TMP("RORX023",$JOB,"PAT",DFN,"LR"))
+26 SET RORXDST=$NAME(^TMP("RORX023",$JOB,"PAT",DFN,"RX"))
+27 ;--- Gets most recent result for Qualifying HepC and GT lab tests
+28 ; HEPC=date of most recent quanitative or qualitative test^result
+29 ; GT=date of most recent GT test^result
+30 KILL HEPC,GT
+31 FOR RORLBG="HepC","GT"
Begin DoDot:2
+32 SET NODE=$$UP^XLFSTR(RORLBG)
SET @NODE="^"
+33 SET RORFDT=$ORDER(@RORLDST@(RORLBG,""))
+34 if RORFDT=""
QUIT
+35 SET RORLVAL=$GET(@RORLDST@(RORLBG,RORFDT))
+36 ;strip time
SET RORFDT=(9999999-RORFDT)\1
+37 SET @NODE=(RORFDT)_U_RORLVAL
End DoDot:2
+38 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,RORBODY,,DFN)
+39 SET RORFDT=$ORDER(@RORXDST@(""),-1)
+40 ;--- store
+41 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,PTAG,1)
+42 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,PTAG,2)
+43 ;--- Patient age/DOB
+44 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:2
+45 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
End DoDot:2
+46 DO ADDVAL^RORTSK11(RORTSK,"HCV_DATE",$PIECE(HEPC,U),PTAG,1)
+47 DO ADDVAL^RORTSK11(RORTSK,"HCV",$PIECE(HEPC,U,2),PTAG,3)
+48 DO ADDVAL^RORTSK11(RORTSK,"GT",$PIECE(GT,U,2),PTAG,1)
+49 DO ADDVAL^RORTSK11(RORTSK,"LAST_TAKEN",RORFDT,PTAG,1)
+50 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",RORICN,PTAG,1)
+51 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",RORPACT,PTAG,1)
+52 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",RORPCP,PTAG,1)
+53 SET PTCNT=PTCNT+1
End DoDot:1
if RC<0
QUIT
+54 ;--- Inactivate the patient list tag if the list is empty
+55 if PTCNT'>0
DO UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
+56 ;---
+57 QUIT ECNT
