RORX021A ;BPOIFO/CLR - HCV DAA CANDIDATES(QUERY & STORE) ;7/15/11 3:37pm
;;1.5;CLINICAL CASE REGISTRIES;**17,19,21,27,26,31,33,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10103 FMADD^XLFDT (supported)
; #10035 Direct read of the DOD field of the file #2 (supported)
; #10000 C^%DTC (supported)
; #10103 $$TRIM^XLFSTR (supported)
; #10103 $$UP^XLFSTR (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 JUN 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*27 FEB 2015 T KOPP Remove requirement to skip patient in
; report if they received Boceprevir or
; Telaprevir, removed requirement that
; only genotype 1 is included on the
; report.
;ROR*1.5*26 MAR 2015 T KOPP Added FIB-4 as report column if FIB-4
; range option selected (STORE), calculate
; FIB-4 score if parameter selected.
; Remove treatment status column.
;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 additional identifier.
;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN column.
;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
I CAT'="HepC GT",(CAT'="HepC Quant"),(CAT'="HepC Qual") Q 1
;=== Mark values as quantitative, qualitative or responded to treatment
;--- HCVQT=quant,HCVQL=qual,HCVOK=cured
I CAT="HepC Quant"!(CAT="HepC Qual") D Q:TMP 1
. S TMP=0
. S VAL=$$UP^XLFSTR(VAL) ;convert to upper case
. S VAL=$TR(VAL," ") ;strip out all spaces
. I VAL["POS" S SUB="HCVQL" Q
. I $E(VAL,1,1)="P" S SUB="HCVQL" Q
. I VAL["NEG" S SUB="HCVOK" Q
. I VAL["NO" S SUB="HCVOK" Q
. I $E(VAL,1,1)="N" S SUB="HCVOK" Q
. I VAL["COMMENT"!(VAL["CANC")!(VAL["DNR")!(VAL["TNP") S TMP=1 Q
. I +VAL=VAL,VAL<51 S TMP=1 Q ;skip abnormally low values
. I $$NUMERIC^RORUTL05($TR(VAL," >,GT")) S SUB="HCVQT" Q
. I $$NUMERIC^RORUTL05($TR(VAL," <,LT")) S SUB="HCVOK" Q
. S TMP=1
S SUB=$S(CAT="HepC GT":"GT",1:SUB)
;--- Store the result
S @ROR8DST@(SUB,DATE)=$P(RESULT(1),U,3)
Q 0
;
;***** QUERIES THE REGISTRY
; REPORT Parent IEN of report
; FLAGS Flags for the $$SKIP^RORXU005
; .NSPT Number of selected patients is returned here
; .RORLC sub-file and LOINC codes to search for FIB4
;
; Return Values:
; <0 Fatal error
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(REPORT,FLAGS,NSPT,RORLC) ;
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 RORXCDT ; User selected cut off date for registry meds
N RORTS ; User selected treatment status categories
N RORXEDT ; RX end date
N RORXSDT ; RX start date
N RORTH ; Patient treatment status (EXP=experienced, NAIVE=naive)
;
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
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S (CNT,ECNT,NSPT,RC)=0,(UTEDT,UTSDT)=0
;=== 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
;--- Set up Treatment status parameters
F TMP="NAIVE","EXP","EXP_DAYS" D
. S RORTS(TMP)=$$PARAM^RORTSK01("TREATMENT_HISTORY",TMP)
;--- Lab parameters
S RORLDST("RORCB")="$$LTSCB^RORX021A"
;--- 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^RORX021A" ;call back routine
;--- RX cut off date (inverse)/shift cut off back one day
N X1,X2,X S X2=-(+RORTS("EXP_DAYS")+1),X1=DT D C^%DTC S RORXCDT=99999999-X
;--- 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 Labs 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 labs and meds
. S SKIP=1,UTIL=0
. D I RC<0 S ECNT=ECNT+1,RC=0 Q
. . S RORLDST=$NA(^TMP("RORX021",$J,"PAT",PATIEN,"LR"))
. . S RC=$$LTSEARCH^RORUTL10(PATIEN,+RORREG,.RORLDST,,LTSDT,LTEDT)
. . Q:RC'>0
. . ;=== Skip if patient no longer has HCV
. . S ROR1=+$O(@RORLDST@("HCVOK","")),ROR2=+$O(@RORLDST@("HCVQL","")),ROR3=(+$O(@RORLDST@("HCVQT","")))
. . I ROR1>0 D Q:SKIP=1
. . . ;--- Skip if date of most recent HCV test is normal
. . . I (ROR1<ROR2),(ROR1<ROR3) S SKIP=1 Q
. . . I (ROR1<ROR2),(ROR3=0) S SKIP=1 Q
. . . I (ROR1<ROR3),(ROR2=0) S SKIP=1 Q
. . . ;--- Skip if no qual or quant test
. . . I ROR2+ROR3=0 S SKIP=1 Q
. . . S SKIP=0
. . ;--- Check if patient should be skipped because of user selected Treatment status
. . S RORXDST=$NA(^TMP("RORX021",$J,"PAT",PATIEN,"RX"))
. . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RORXEDT)
. . Q:RC<0 ;error occurred
. . I $G(RORXDST("SKIP")) S SKIP=1 K RORXDST("SKIP") Q ;skip if taking DAA meds
. . I RC>0,'+RORTS("EXP") S SKIP=1 Q ; skip naive patients
. . I RC=0,'+RORTS("NAIVE") S SKIP=1 Q ;skip experienced patients
. . I RC>0,$O(@RORXDST@(RORXCDT),-1) S SKIP=1 Q ;skip if patient has meds after cutoff
. . ;--- Include patient
. . S RORTH=$S(RC>0:"EXP",RC=0:"NAIVE",1:"")
. . S SKIP=0
. ;--- 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 patient if FIB4 range has been selected and score does not match parameters
. I 'SKIP,$G(RORDATA("IDLST")) D
. . N OK
. . S OK=$$CALCFIB^RORX019A(PATIEN,"",.RORDATA,IEN,.RORLC)
. . I OK<0 S SKIP=1 Q
. . I '$$INRANGE^RORX019(.RORDATA) S SKIP=1 Q ;exclude patient from report if ANY score is out of range
. . I '$$SKIP^RORX019(.RORDATA) S SKIP=1 ;exclude patient from report with null scores
. ;--- Skip the patient if not all selection criteria have been met
. I SKIP K ^TMP("RORX021",$J,"PAT",PATIEN) Q
. ;
. ;--- Get and store the patient's data last4^name^treatment status^ICN^FIB-4 score^PACT^PCP^AGE/DOB
. D VADEM^RORUTL05(PATIEN,1) S VA("BID")="0000"
. S TMP=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
. S ^TMP("RORX021",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_RORTH_U_TMP_U_$G(RORDATA("SCORE",4))
. 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=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
. S ^TMP("RORX021",$J,"PAT",PATIEN)=^TMP("RORX021",$J,"PAT",PATIEN)_U_TMP
. S TMP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
. S ^TMP("RORX021",$J,"PAT",PATIEN)=^TMP("RORX021",$J,"PAT",PATIEN)_U_TMP_U_AGE
. S TMP=$S($$PARAM^RORTSK01("OPTIONS","FUT_APPT"):$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT")),1:"")
. S ^TMP("RORX021",$J,"PAT",PATIEN)=^TMP("RORX021",$J,"PAT",PATIEN)_U_$P(TMP,U)_U_$P(TMP,U,2)
. 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
;
;
; .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,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 RXCNT=RXCNT+1
. S @ROR8DST@((99999999-OFD),DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
E D ;--- Outpatient
. S OFD=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
. Q:(OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
. S RXCNT=RXCNT+1
. S @ROR8DST@((99999999-OFD),DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
;--- 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,TMP=99999999-TMP D
. . . S @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
Q 0
;***** 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 fill date
N RORLBG ;lab test type (GT, HCVQT,HCVQL)
N RORLVAL ;lab value
N RORRX ;med name
N RORSTNAM ;
N RORLDST
N RORXDST
N RORICN
N RORFIB4
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,AGE,AGETYPE
N GT,HCVQT,HCV,HCVQL,RORAPPT,RORCLIN
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("RORX021",$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("RORX021",$J,"PAT",DFN))
. ;--- Patient's data
. S TMP=$G(@NODE)
. S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),THIST=$P(TMP,U,3),RORICN=$P(TMP,U,4),RORFIB4=$P(TMP,U,5)
. S RORPACT=$P(TMP,U,6),RORPCP=$P(TMP,U,7),AGE=$P(TMP,U,8),RORAPPT=$P(TMP,U,9),RORCLIN=$P(TMP,U,10)
. ;--- get lab results
. S RORLDST=$NA(^TMP("RORX021",$J,"PAT",DFN,"LR"))
. S RORXDST=$NA(^TMP("RORX021",$J,"PAT",DFN,"RX"))
. ;--- Gets most recent result for HepC Qual, HepC Quant and GT
. ; HCVQT=date of most recent quanitative test^result
. ; HCVQL=date of most recent qualitative test^result
. ; GT=date of most recent GT test^result
. K HCVQT,HCVQL,GT
. F RORLBG="HCVQT","HCVQL","GT" D
. . S NODE=RORLBG,@NODE="^"
. . S RORFDT=$O(@RORLDST@(RORLBG,""))
. . Q:RORFDT=""
. . S RORLVAL=$G(@RORLDST@(RORLBG,RORFDT))
. . S RORFDT=9999999-RORFDT
. . S RORFDT=RORFDT\1 ;strip time
. . S @NODE=(RORFDT)_U_RORLVAL
. ;--- get most recent registry med if experienced
. ;--- if more than one med give preference to INTERFERON
. S RORFDT=$O(@RORXDST@("")),RORRX=""
. I THIST="EXP" D
. . S RORSTNAM="",RORRX=""
. . F S RORSTNAM=$O(@RORXDST@(RORFDT,RORSTNAM)) Q:RORSTNAM="" D
. . . S RORRX=$S(RORRX="":RORSTNAM,RORRX["INTERFERON":RORRX,1:RORSTNAM)
. . S RORFDT=99999999-RORFDT
. . S RORFDT=RORFDT\1
. S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,RORBODY,,DFN)
. ;--- give preference to quant result over qual result
. S HCV=$S(+$G(HCVQL)>+$G(HCVQT):HCVQL,$G(HCVQT):HCVQT,1:"")
. ;--- store
. D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,PTAG,2)
. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
. ; I $G(RORDATA("LIST"))'["4" D ADDVAL^RORTSK11(RORTSK,"STATUS",THIST,PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"HCV_DATE",$P(HCV,U),PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"HCV",$P(HCV,U,2),PTAG,3)
. D ADDVAL^RORTSK11(RORTSK,"GT",$P(GT,U,2),PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"FILL_DATE",RORFDT,PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"FILL_MED",RORRX,PTAG,1)
. I $G(RORDATA("IDLST"))'="" D
. . S:RORDATA("IDLST")["4" TMP=$$ADDVAL^RORTSK11(RORTSK,"FIB4",RORFIB4,PTAG,3)
. 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)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,PTAG,1)
. . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,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[HRORX021A 16508 printed Nov 22, 2024@16:55:09 Page 2
RORX021A ;BPOIFO/CLR - HCV DAA CANDIDATES(QUERY & STORE) ;7/15/11 3:37pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**17,19,21,27,26,31,33,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10103 FMADD^XLFDT (supported)
+6 ; #10035 Direct read of the DOD field of the file #2 (supported)
+7 ; #10000 C^%DTC (supported)
+8 ; #10103 $$TRIM^XLFSTR (supported)
+9 ; #10103 $$UP^XLFSTR (supported)
+10 ;
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ; --- ROUTINE MODIFICATION LOG ---
+14 ;
+15 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+16 ;----------- ---------- ----------- ----------------------------------------
+17 ;ROR*1.5*19 JUN 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*27 FEB 2015 T KOPP Remove requirement to skip patient in
+21 ; report if they received Boceprevir or
+22 ; Telaprevir, removed requirement that
+23 ; only genotype 1 is included on the
+24 ; report.
+25 ;ROR*1.5*26 MAR 2015 T KOPP Added FIB-4 as report column if FIB-4
+26 ; range option selected (STORE), calculate
+27 ; FIB-4 score if parameter selected.
+28 ; Remove treatment status column.
+29 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
+30 ; identifiers.
+31 ;ROR*1.5*33 APR 2018 F TRAXLER Adding FUT_APPT as additional identifier.
+32 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN column.
+33 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+34 ;******************************************************************************
+35 ;******************************************************************************
+36 QUIT
+37 ;
+38 ;***** LAB SEARCH CALLBACK
+39 ;
+40 ; .ROR8DST Reference to the ROR8DST parameter.
+41 ;
+42 ; INVDT IEN of the Lab test (inverted date)
+43 ;
+44 ; .RESULT Reference to a local variable, which contains
+45 ; the result (see the $$LTSEARCH^RORUTL10).
+46 ;
+47 ; Return Values:
+48 ; <0 Error code (the search will be aborted)
+49 ; 0 Ok
+50 ; 1 Skip this result
+51 ; 2 Skip this and all remaining results
+52 ;
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 IF CAT'="HepC GT"
IF (CAT'="HepC Quant")
IF (CAT'="HepC Qual")
QUIT 1
+9 ;=== Mark values as quantitative, qualitative or responded to treatment
+10 ;--- HCVQT=quant,HCVQL=qual,HCVOK=cured
+11 IF CAT="HepC Quant"!(CAT="HepC Qual")
Begin DoDot:1
+12 SET TMP=0
+13 ;convert to upper case
SET VAL=$$UP^XLFSTR(VAL)
+14 ;strip out all spaces
SET VAL=$TRANSLATE(VAL," ")
+15 IF VAL["POS"
SET SUB="HCVQL"
QUIT
+16 IF $EXTRACT(VAL,1,1)="P"
SET SUB="HCVQL"
QUIT
+17 IF VAL["NEG"
SET SUB="HCVOK"
QUIT
+18 IF VAL["NO"
SET SUB="HCVOK"
QUIT
+19 IF $EXTRACT(VAL,1,1)="N"
SET SUB="HCVOK"
QUIT
+20 IF VAL["COMMENT"!(VAL["CANC")!(VAL["DNR")!(VAL["TNP")
SET TMP=1
QUIT
+21 ;skip abnormally low values
IF +VAL=VAL
IF VAL<51
SET TMP=1
QUIT
+22 IF $$NUMERIC^RORUTL05($TRANSLATE(VAL," >,GT"))
SET SUB="HCVQT"
QUIT
+23 IF $$NUMERIC^RORUTL05($TRANSLATE(VAL," <,LT"))
SET SUB="HCVOK"
QUIT
+24 SET TMP=1
End DoDot:1
if TMP
QUIT 1
+25 SET SUB=$SELECT(CAT="HepC GT":"GT",1:SUB)
+26 ;--- Store the result
+27 SET @ROR8DST@(SUB,DATE)=$PIECE(RESULT(1),U,3)
+28 QUIT 0
+29 ;
+30 ;***** QUERIES THE REGISTRY
+31 ; REPORT Parent IEN of report
+32 ; FLAGS Flags for the $$SKIP^RORXU005
+33 ; .NSPT Number of selected patients is returned here
+34 ; .RORLC sub-file and LOINC codes to search for FIB4
+35 ;
+36 ; Return Values:
+37 ; <0 Fatal error
+38 ; 0 Ok
+39 ; >0 Number of non-fatal errors
+40 ;
QUERY(REPORT,FLAGS,NSPT,RORLC) ;
+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 ; User selected cut off date for registry meds
NEW RORXCDT
+8 ; User selected treatment status categories
NEW RORTS
+9 ; RX end date
NEW RORXEDT
+10 ; RX start date
NEW RORXSDT
+11 ; Patient treatment status (EXP=experienced, NAIVE=naive)
NEW RORTH
+12 ;
+13 NEW CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
+14 NEW RCC,FLAG,HCV,GT,ROR1,ROR2,ROR3
+15 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+16 SET (CNT,ECNT,NSPT,RC)=0
SET (UTEDT,UTSDT)=0
+17 ;=== Set up parameters
+18 ;--- Utilization date range
+19 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+20 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+21 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
End DoDot:1
+22 ;--- Number of patients in the registry
+23 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+24 ;--- Set up Treatment status parameters
+25 FOR TMP="NAIVE","EXP","EXP_DAYS"
Begin DoDot:1
+26 SET RORTS(TMP)=$$PARAM^RORTSK01("TREATMENT_HISTORY",TMP)
End DoDot:1
+27 ;--- Lab parameters
+28 SET RORLDST("RORCB")="$$LTSCB^RORX021A"
+29 ;--- Labs date range
+30 SET LTSDT=""
+31 SET LTEDT=DT
+32 ;--- Shift the Labs end date
+33 SET LTEDT=$$FMADD^XLFDT(LTEDT,1)
+34 ;== Pharm parameters
+35 ;only meds with generic name
SET RORXDST("GENERIC")=1
+36 ;call back routine
SET RORXDST("RORCB")="$$RXOCB^RORX021A"
+37 ;--- RX cut off date (inverse)/shift cut off back one day
+38 NEW X1,X2,X
SET X2=-(+RORTS("EXP_DAYS")+1)
SET X1=DT
DO C^%DTC
SET RORXCDT=99999999-X
+39 ;--- RX start and end dates
+40 ;start date 1/1/1900
SET RORXSDT=2000101
+41 SET RORXEDT=DT
+42 ;--- RX list of HepC registry drugs
+43 SET RORXL=$$ALLOC^RORTMP()
+44 SET RC=$$DRUGLIST^RORUTL16(RORXL,+RORREG)
+45 ;--- Shift the Labs end date
+46 SET RORXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
+47 ;--- Set up Clinic/Division list parameters date_range_3
+48 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+49 ;--- Set up ICD parameters
+50 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+51 ;=== Browse through the registry records
+52 SET IEN=0
+53 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+54 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+55 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+56 SET IENS=IEN_","
SET CNT=CNT+1
+57 ;--- Get patient DFN
+58 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+59 ;patient has died
IF +$PIECE($GET(^DPT(PATIEN,.35)),U)>0
QUIT
+60 ;--- Check if the patient should be skipped based on standard filters
+61 if $$SKIP^RORXU005(IEN,FLAGS,UTSDT,UTEDT)
QUIT
+62 ;--- Check if patient should be skipped because of ICD codes
+63 SET RCC=0
+64 IF FLAG'="ALL"
Begin DoDot:2
+65 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+66 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+67 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+68 ;
+69 ;--- Check if patient should be skipped because of Clinic or Division
+70 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+71 ;=== Check labs and meds
+72 SET SKIP=1
SET UTIL=0
+73 Begin DoDot:2
+74 SET RORLDST=$NAME(^TMP("RORX021",$JOB,"PAT",PATIEN,"LR"))
+75 SET RC=$$LTSEARCH^RORUTL10(PATIEN,+RORREG,.RORLDST,,LTSDT,LTEDT)
+76 if RC'>0
QUIT
+77 ;=== Skip if patient no longer has HCV
+78 SET ROR1=+$ORDER(@RORLDST@("HCVOK",""))
SET ROR2=+$ORDER(@RORLDST@("HCVQL",""))
SET ROR3=(+$ORDER(@RORLDST@("HCVQT","")))
+79 IF ROR1>0
Begin DoDot:3
+80 ;--- Skip if date of most recent HCV test is normal
+81 IF (ROR1<ROR2)
IF (ROR1<ROR3)
SET SKIP=1
QUIT
+82 IF (ROR1<ROR2)
IF (ROR3=0)
SET SKIP=1
QUIT
+83 IF (ROR1<ROR3)
IF (ROR2=0)
SET SKIP=1
QUIT
+84 ;--- Skip if no qual or quant test
+85 IF ROR2+ROR3=0
SET SKIP=1
QUIT
+86 SET SKIP=0
End DoDot:3
if SKIP=1
QUIT
+87 ;--- Check if patient should be skipped because of user selected Treatment status
+88 SET RORXDST=$NAME(^TMP("RORX021",$JOB,"PAT",PATIEN,"RX"))
+89 SET RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RORXEDT)
+90 ;error occurred
if RC<0
QUIT
+91 ;skip if taking DAA meds
IF $GET(RORXDST("SKIP"))
SET SKIP=1
KILL RORXDST("SKIP")
QUIT
+92 ; skip naive patients
IF RC>0
IF '+RORTS("EXP")
SET SKIP=1
QUIT
+93 ;skip experienced patients
IF RC=0
IF '+RORTS("NAIVE")
SET SKIP=1
QUIT
+94 ;skip if patient has meds after cutoff
IF RC>0
IF $ORDER(@RORXDST@(RORXCDT),-1)
SET SKIP=1
QUIT
+95 ;--- Include patient
+96 SET RORTH=$SELECT(RC>0:"EXP",RC=0:"NAIVE",1:"")
+97 SET SKIP=0
End DoDot:2
IF RC<0
SET ECNT=ECNT+1
SET RC=0
QUIT
+98 ;--- Check if patient should be skipped because no utilization in the corresponding date range
+99 IF 'SKIP
if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:2
+100 KILL TMP
SET TMP("ALL")=1
+101 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
+102 if 'UTIL
SET SKIP=1
End DoDot:2
+103 ;
+104 ; Skip patient if FIB4 range has been selected and score does not match parameters
+105 IF 'SKIP
IF $GET(RORDATA("IDLST"))
Begin DoDot:2
+106 NEW OK
+107 SET OK=$$CALCFIB^RORX019A(PATIEN,"",.RORDATA,IEN,.RORLC)
+108 IF OK<0
SET SKIP=1
QUIT
+109 ;exclude patient from report if ANY score is out of range
IF '$$INRANGE^RORX019(.RORDATA)
SET SKIP=1
QUIT
+110 ;exclude patient from report with null scores
IF '$$SKIP^RORX019(.RORDATA)
SET SKIP=1
End DoDot:2
+111 ;--- Skip the patient if not all selection criteria have been met
+112 IF SKIP
KILL ^TMP("RORX021",$JOB,"PAT",PATIEN)
QUIT
+113 ;
+114 ;--- Get and store the patient's data last4^name^treatment status^ICN^FIB-4 score^PACT^PCP^AGE/DOB
+115 DO VADEM^RORUTL05(PATIEN,1)
SET VA("BID")="0000"
+116 SET TMP=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+117 SET ^TMP("RORX021",$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_RORTH_U_TMP_U_$GET(RORDATA("SCORE",4))
+118 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:2
+119 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:2
+120 SET TMP=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
+121 SET ^TMP("RORX021",$JOB,"PAT",PATIEN)=^TMP("RORX021",$JOB,"PAT",PATIEN)_U_TMP
+122 SET TMP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
+123 SET ^TMP("RORX021",$JOB,"PAT",PATIEN)=^TMP("RORX021",$JOB,"PAT",PATIEN)_U_TMP_U_AGE
+124 SET TMP=$SELECT($$PARAM^RORTSK01("OPTIONS","FUT_APPT"):$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT")),1:"")
+125 SET ^TMP("RORX021",$JOB,"PAT",PATIEN)=^TMP("RORX021",$JOB,"PAT",PATIEN)_U_$PIECE(TMP,U)_U_$PIECE(TMP,U,2)
+126 ;increment count of selected patients
SET NSPT=NSPT+1
End DoDot:1
if RC<0
QUIT
+127 ;
+128 ;clean up drug list
DO FREE^RORTMP(RORXL)
+129 QUIT $SELECT(RC<0:RC,1:ECNT)
+130 ;
+131 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
+132 ;
+133 ;
+134 ; .ROR8DST Reference to the ROR8DST parameter.
+135 ;
+136 ;
+137 ; ORDER Order number (from condensed list)
+138 ;
+139 ; FLAGS Flags describing the order to be
+140 ; processed.
+141 ;
+142 ; DRUG Dispensed drug
+143 ; ^01: Drug IEN in file #50
+144 ; ^02: Drug name
+145 ;
+146 ; DATE Order date (issue date for outpatient
+147 ; drugs or start date for inpatient)
+148 ;
+149 ;Return Values:
+150 ; <0 Error code (the search will be aborted)
+151 ; 0 Ok
+152 ; 1 Skip this result
+153 ; 2 Skip this and all remaining results
+154 ;
RXOCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW DRUGIEN,DRUGNAME,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,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 SET RXCNT=RXCNT+1
+15 SET @ROR8DST@((99999999-OFD),DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
End DoDot:1
+16 ;--- Outpatient
IF '$TEST
Begin DoDot:1
+17 ; Original Fill Date
SET OFD=+$PIECE($GET(^TMP("PS",$JOB,"RXN",0)),U,6)
+18 if (OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
QUIT
+19 SET RXCNT=RXCNT+1
+20 SET @ROR8DST@((99999999-OFD),DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
End DoDot:1
+21 ;--- Refills and partials
+22 FOR RPSUB="REF","PAR"
Begin DoDot:1
+23 SET $PIECE(RXBUF,U)=$EXTRACT(RPSUB,1)
+24 SET IRP=0
+25 FOR
SET IRP=$ORDER(^TMP("PS",$JOB,RPSUB,IRP))
if IRP'>0
QUIT
Begin DoDot:2
+26 SET TMP=$GET(^TMP("PS",$JOB,RPSUB,IRP,0))
+27 IF TMP>0
SET RXCNT=RXCNT+1
SET TMP=99999999-TMP
Begin DoDot:3
+28 SET @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT 0
+30 ;***** STORES THE REPORT DATA
+31 ;
+32 ; REPORT IEN of the REPORT element
+33 ; NSPT Number of selected patients
+34 ;
+35 ; Return Values:
+36 ; <0 Error code
+37 ; 0 Ok
+38 ; >0 Number of non-fatal errors
+39 ;
STORE(REPORT,NSPT) ;
+1 ;med fill date
NEW RORFDT
+2 ;lab test type (GT, HCVQT,HCVQL)
NEW RORLBG
+3 ;lab value
NEW RORLVAL
+4 ;med name
NEW RORRX
+5 ;
NEW RORSTNAM
+6 NEW RORLDST
+7 NEW RORXDST
+8 NEW RORICN
+9 NEW RORFIB4
+10 NEW RORPACT
+11 NEW RORPCP
+12 ;parent iens
NEW RORBODY,PTAG
+13 NEW CNT,DATE,DFN,ECNT,IEN,LAST4,LTLST,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,THIST,AGE,AGETYPE
+14 NEW GT,HCVQT,HCV,HCVQL,RORAPPT,RORCLIN
+15 SET (ECNT,RC)=0
SET (LTLST,PTLST,RXLST)=-1
+16 ;--- Create 'patients' table
+17 SET RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+18 DO ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
+19 SET (CNT,DFN,PTCNT)=0
+20 FOR
SET DFN=$ORDER(^TMP("RORX021",$JOB,"PAT",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+21 SET TMP=$SELECT(NSPT>0:CNT/NSPT,1:"")
+22 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+23 SET CNT=CNT+1
SET NODE=$NAME(^TMP("RORX021",$JOB,"PAT",DFN))
+24 ;--- Patient's data
+25 SET TMP=$GET(@NODE)
+26 SET LAST4=$PIECE(TMP,U)
SET PTNAME=$PIECE(TMP,U,2)
SET THIST=$PIECE(TMP,U,3)
SET RORICN=$PIECE(TMP,U,4)
SET RORFIB4=$PIECE(TMP,U,5)
+27 SET RORPACT=$PIECE(TMP,U,6)
SET RORPCP=$PIECE(TMP,U,7)
SET AGE=$PIECE(TMP,U,8)
SET RORAPPT=$PIECE(TMP,U,9)
SET RORCLIN=$PIECE(TMP,U,10)
+28 ;--- get lab results
+29 SET RORLDST=$NAME(^TMP("RORX021",$JOB,"PAT",DFN,"LR"))
+30 SET RORXDST=$NAME(^TMP("RORX021",$JOB,"PAT",DFN,"RX"))
+31 ;--- Gets most recent result for HepC Qual, HepC Quant and GT
+32 ; HCVQT=date of most recent quanitative test^result
+33 ; HCVQL=date of most recent qualitative test^result
+34 ; GT=date of most recent GT test^result
+35 KILL HCVQT,HCVQL,GT
+36 FOR RORLBG="HCVQT","HCVQL","GT"
Begin DoDot:2
+37 SET NODE=RORLBG
SET @NODE="^"
+38 SET RORFDT=$ORDER(@RORLDST@(RORLBG,""))
+39 if RORFDT=""
QUIT
+40 SET RORLVAL=$GET(@RORLDST@(RORLBG,RORFDT))
+41 SET RORFDT=9999999-RORFDT
+42 ;strip time
SET RORFDT=RORFDT\1
+43 SET @NODE=(RORFDT)_U_RORLVAL
End DoDot:2
+44 ;--- get most recent registry med if experienced
+45 ;--- if more than one med give preference to INTERFERON
+46 SET RORFDT=$ORDER(@RORXDST@(""))
SET RORRX=""
+47 IF THIST="EXP"
Begin DoDot:2
+48 SET RORSTNAM=""
SET RORRX=""
+49 FOR
SET RORSTNAM=$ORDER(@RORXDST@(RORFDT,RORSTNAM))
if RORSTNAM=""
QUIT
Begin DoDot:3
+50 SET RORRX=$SELECT(RORRX="":RORSTNAM,RORRX["INTERFERON":RORRX,1:RORSTNAM)
End DoDot:3
+51 SET RORFDT=99999999-RORFDT
+52 SET RORFDT=RORFDT\1
End DoDot:2
+53 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,RORBODY,,DFN)
+54 ;--- give preference to quant result over qual result
+55 SET HCV=$SELECT(+$GET(HCVQL)>+$GET(HCVQT):HCVQL,$GET(HCVQT):HCVQT,1:"")
+56 ;--- store
+57 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,PTAG,1)
+58 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,PTAG,2)
+59 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:2
+60 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
End DoDot:2
+61 ; I $G(RORDATA("LIST"))'["4" D ADDVAL^RORTSK11(RORTSK,"STATUS",THIST,PTAG,1)
+62 DO ADDVAL^RORTSK11(RORTSK,"HCV_DATE",$PIECE(HCV,U),PTAG,1)
+63 DO ADDVAL^RORTSK11(RORTSK,"HCV",$PIECE(HCV,U,2),PTAG,3)
+64 DO ADDVAL^RORTSK11(RORTSK,"GT",$PIECE(GT,U,2),PTAG,1)
+65 DO ADDVAL^RORTSK11(RORTSK,"FILL_DATE",RORFDT,PTAG,1)
+66 DO ADDVAL^RORTSK11(RORTSK,"FILL_MED",RORRX,PTAG,1)
+67 IF $GET(RORDATA("IDLST"))'=""
Begin DoDot:2
+68 if RORDATA("IDLST")["4"
SET TMP=$$ADDVAL^RORTSK11(RORTSK,"FIB4",RORFIB4,PTAG,3)
End DoDot:2
+69 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",RORICN,PTAG,1)
+70 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",RORPACT,PTAG,1)
+71 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",RORPCP,PTAG,1)
+72 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+73 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,PTAG,1)
+74 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,PTAG,1)
End DoDot:2
+75 SET PTCNT=PTCNT+1
End DoDot:1
if RC<0
QUIT
+76 ;--- Inactivate the patient list tag if the list is empty
+77 if PTCNT'>0
DO UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
+78 ;---
+79 QUIT ECNT
