RORX022A.m

RORX022A ;BPOIFO/CLR - LAB DAA MONITOR (CONT.) ; 22 Feb 2016  2:28 AM

 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,17,18,19,21,28,31,39**;Feb 17, 2006;Build 4

 ;

 ; This routine uses the following IAs:

 ;

 ; #10103 FMADD^XLFDT (supported)

 ; #10103 FMDIFF^XLFDT (supported)

 ; #10035 Direct read of the DOD field of the file #2

 ; #10000 C^%DTC (supported)

 ;   

 ;******************************************************************************

 ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION

 ;-----------  ----------  -----------  ----------------------------------------

 ;ROR*1.5*18   APR  2012   C RAY        Adds select patient panel

 ;ROR*1.5*19   JUN  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*28   APR  2016   T KOPP       Add select DAA/in house drug parameter

 ;                                      Change selection of Rx's from 2 specific

 ;                                       drugs to any drug assigned to the HEP C

 ;                                       registry plus local drugs defined for 

 ;                                       the registry.

 ;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) ;

 ;all lab tests

 N DATE,IEN,NAME,RC,TMP,VAL,WEEKS,DAYS,RAWDAYS

 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 VAL=$P(RESULT(1),U,3)    Q:VAL="" 1   ; Result of the test

 S DATE=+$P(RESULT(1),U,1)  Q:DATE'>0 1  ; Date of the test

 S RAWDAYS=$$FMDIFF^XLFDT(((9999999-DATE)\1),ROR8DST("DAA"))

 S WEEKS=RAWDAYS\7  ;Number of weeks

 S DAYS=RAWDAYS#7  ;Remainder in days

 S VAL=$$UP^XLFSTR(VAL)

 ;--- Skip value if test not performed

 I VAL["CANC"!(VAL["DNR")!(VAL["TNP") Q 1

 ;--- Skip value out of the result range

 I $D(RORLTRV(IEN))>1  S RC=1  D  Q:RC RC

 . S VAL=$$CLRNMVAL^RORUTL18($P(RESULT(1),U,3))

 . ;--- Skip a non-numeric result

 . Q:'$$NUMERIC^RORUTL05(VAL)

 . ;--- Check the range

 . I $G(RORLTRV(IEN,"L"))'=""  Q:VAL<RORLTRV(IEN,"L")

 . I $G(RORLTRV(IEN,"H"))'=""  Q:VAL>RORLTRV(IEN,"H")

 . S RC=0

 ;--- Store the result

 S @ROR8DST@(NAME,IEN,DATE)=($P(RESULT(1),U,3))_U_(+WEEKS_" weeks "_+DAYS_" days")

 Q 0

 ;

 ;***** QUERIES THE REGISTRY

 ;

 ; FLAGS         Flags for the $$SKIP^RORXU005

 ; RORTSK        Parameters passed by client

 ; .NSPT         Number of selected patients is returned here

 ;

 ; Return Values:

 ;       <0  Error code

 ;        0  Ok

 ;       >0  Number of non-fatal errors

 ;

QUERY(FLAGS,RORTSK,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 RORDAA        ; Date of patient's 1st DAA fill

 N RORXL         ; Location of drug list

 N RXSDT         ; RX start date

 N RXEDT         ; RX end date

 N RORICN        ; National ICN

 N RORPACT       ; Patient Care Team

 N RORPCP        ; Priamary Care Provider

 ;

 N CNT,ECNT,IEN,IENS,PATIEN,RC,SKIP,TMP,VA,VADM,XREFNODE

 N RCC,FLAG,DAASDT,DAAEDT,RORXSDT,RORDAACH,AGE,AGETYPE

 N LTEDT,LTSDT,LTWKDYS,LTWKS

 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))

 S (CNT,ECNT,NSPT,RC,RORCDLIST)=0

 ;--- Number of patients in the registry

 S RORPTN=$$REGSIZE^RORUTL02(+RORREG)  S:RORPTN<0 RORPTN=0

 ;--- Date range to search for DAA meds

 S DAASDT=$$PARAM^RORTSK01("DATE_RANGE_4","START")\1

 S DAAEDT=$$PARAM^RORTSK01("DATE_RANGE_4","END")\1

 ;--- set up LAB descriptors

 S LTWKS=$$PARAM^RORTSK01("WEEKS_AFTER")

 S LTWKDYS=LTWKS*7

 S LTMREC=$$PARAM^RORTSK01("WEEKS_AFTER","MOST_RECENT")

 S RORLDST("RORCB")="$$LTSCB^RORX022A"

 ;--- set up RX descriptors

 S RORXDST("RORCB")="$$RXOCB^RORX022A"

 S RORXDST("GENERIC")=1

 S RORXL=$$ALLOC^RORTMP()

 S RC=$$DRUGLIST^RORUTL16(RORXL,+RORREG,"DG")

 S RXSDT=3100101  ;based on compliance date PSN*4*293

 S RXEDT=$$FMADD^XLFDT(DAAEDT,1)

 ;--- Set up Clinic/Division list parameters

 I $D(RORTSK("PARAMS","CLINICS","C")) S RORCDLIST=1

 I $D(RORTSK("PARAMS","DIVISIONS","C")) S RORCDLIST=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 for patient list and quit if not on list  ;+18

 . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q

 . ;--- Check if the patient should be skipped

 . Q:$$SKIP^RORXU005(IEN,FLAGS)

 . ;--- 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 not on Clinic or Division list

 . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,DAASDT,DAAEDT) Q

 . ;--- Report specific filters

 . S SKIP=1

 . ;--- Check if patient should be skipped because no DAA fill

 . D  I RC<0  S ECNT=ECNT+1,RC=0  Q

 . . ;--- Search for 1st DAA fill date skip patient if not taking DAA

 . . S RORXDST("1STDAA")=1  ;set DAA flag

 . . D  I RC'>0 Q

 . . . N RORDAACH

 . . . S RORDAACH=$$PARAM^RORTSK01("OPTIONS","DAA_DRUGS")

 . . . S RORXDST=$$ALLOC^RORTMP()

 . . . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV"_$S(RORDAACH="C":"C",RORDAACH="I":"H",1:""),RXSDT,RXEDT)

 . . S SKIP=0

 . S RORDAA=$O(@RORXDST@(""))

 . I +RORDAA<DAASDT S SKIP=1  ;1st fill before daa start date

 . ;--- Skip the patient if not all search criteria have been met

 . I SKIP D FREE^RORTMP(RORXDST) Q

 . ;=== Store the patient's data

 . D VADEM^RORUTL05(PATIEN,1) S VA("BID")="0000"

 . D FREE^RORTMP(RORXDST)

 . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")

 . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")

 . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")

 . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")

 . S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")

 . S ^TMP("RORX022",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_RORDAA_U_RORICN_U_RORPACT_U_RORPCP_U_AGE

 . ;--- Get lab tests N weeks after 1st DAA fill

 . N X,X1,X2

 . S X1=RORDAA,X2=LTWKDYS D C^%DTC S LTEDT=X

 . S LTEDT=$$FMADD^XLFDT(LTEDT\1,1)

 . ;--- If baseline requested get all lab results

 . S LTSDT=$S(LTMREC=1:"",1:RORDAA)

 . S RORLDST("DAA")=RORDAA

 . D  Q:RC<0 

 . . S RORLDST=$NA(^TMP("RORX022",$J,"PAT",PATIEN,"LR"))

 . . S RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)

 . ;--- Get all registry med fills 60 days before 1st DAA fill

 . K RORXDST("1STDAA")  ;clear DAA flag

 . D  Q:RC<0

 . . N RORDAACH

 . . S RORXDST=$NA(^TMP("RORX022",$J,"PAT",PATIEN,"RX"))

 . . S X1=RORDAA,X2=-60 D C^%DTC S RORXSDT=X

 . . S RORXEDT=$$FMADD^XLFDT(DT,1)

 . . S RORDAACH=$$PARAM^RORTSK01("OPTIONS","DAA_DRUGS")

 . . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV"_$S(RORDAACH="C":"C",RORDAACH="I":"H",1:""),RORXSDT,RORXEDT)

 . S NSPT=NSPT+1

 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

 I ROR8DST("GENERIC")  D

 . S DRUGIEN=+ROR8DST("RORXGEN"),DRUGNAME=$P(ROR8DST("RORXGEN"),U,2)

 I DRUGIEN'>0!(DRUGNAME="") S DRUGIEN=+DRUG,DRUGNAME=$P(DRUG,U,2)

 Q:(DRUGIEN'>0)!(DRUGNAME="") 1

 ;--- if DAA flag set, skip med if not a DAA

 ;I +$G(ROR8DST("1STDAA")),(DRUGNAME'="BOCEPREVIR"),(DRUGNAME'="TELAPREVIR") Q 1

 S $P(RXBUF,U,5)=$P($G(^TMP("PS",$J,0)),U,7)  ; Days Supply

 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)\1         ; Start Date

 . S RXCNT=RXCNT+1

 . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF

 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@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF

 ;--- Refills and partials

 F RPSUB="REF","PAR"  D

 . 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))

 . . S $P(RXBUF,U,5)=$P(TMP,U,2)  ; Days Supply

 . . I TMP>0  S RXCNT=RXCNT+1  D

 . . . S @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF

 Q 0

 ;

 ;***** STORES THE REPORT DATA

 ;

 ; REPORT        IEN of the REPORT element

 ; RORTSK        Parameters passed by GUI

 ; NSPT          Number of selected patients

 ;

 ; Return Values:

 ;       <0  Error code

 ;        0  Ok

 ;       >0  Number of non-fatal errors

 ;

STORE(REPORT,RORTSK,NSPT) ;

 N CNT,DATE,DFN,DAA,ECNT,ICN,IEN,ITEM,LAST4,LTLST,NAME,NODE,PTCNT,PACT,PCP,PTLST,PTNAME,RC,RXLST,TMP,VAL,AGE,AGETYPE

 N DAAINV,LRMREC

 S (ECNT,RC)=0,(LTLST,PTLST,RXLST)=-1

 ;--- Force the "patient data" note in the output

 D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)

 S LRMREC=$$PARAM^RORTSK01("LABTESTS","MOST_RECENT")

 ;--- Create lab test list

 D  Q:LTLST<0 LTLST

 . S LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)

 . D ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")

 ;--- Create pharmacy list

 D  Q:RXLST<0 RXLST

 . S RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)

 . D ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")

 ;--- Loop through selected patients and store as XML

 S (CNT,DFN,PTCNT)=0

 S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")

 F  S DFN=$O(^TMP("RORX022",$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("RORX022",$J,"PAT",DFN))

 . ;--- Patient's data

 . S TMP=$G(@NODE)

 . S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),DAA=$P(TMP,U,3),ICN=$P(TMP,U,4),PACT=$P(TMP,U,5),PCP=$P(TMP,U,6),AGE=$P(TMP,U,7)

 . S PTCNT=PTCNT+1

 . ;--- List of Lab tests

 . S NAME="" K LTCNT

 . F  S NAME=$O(@NODE@("LR",NAME)) Q:NAME=""  D

 . . S IEN=""

 . . F  S IEN=$O(@NODE@("LR",NAME,IEN)) Q:IEN=""  D

 . . . S DATE="",DAAINV=9999999-DAA

 . . . F  S DATE=$O(@NODE@("LR",NAME,IEN,DATE)) Q:DATE=""!($G(LTCNT(NAME,IEN))=2)!((DATE>DAAINV)&'LTMREC)  D

 . . . . ;store results after or on DAA fill date

 . . . . I DATE'>DAAINV D  Q

 . . . . . I LRMREC,$G(LTCNT(NAME,IEN))=0 Q  ;quit if most recent

 . . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)

 . . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",((9999999-DATE)\1),ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)

 . . . . . S VAL=$G(@NODE@("LR",NAME,IEN,DATE))

 . . . . . S TMP=$S($$NUMERIC^RORUTL05($P(VAL,U)):3,1:1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"RESULT",$P(VAL,U),ITEM,TMP)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"WKS_LAB",$P(VAL,U,2),ITEM,1)

 . . . . . S LTCNT(NAME,IEN)=0

 . . . . ;store 2 baseline results if flag is set

 . . . . I LTMREC D

 . . . . . S LTCNT(NAME,IEN)=$S('$D(LTCNT(NAME,IEN)):1,1:LTCNT(NAME,IEN)+1)  ;count for each test

 . . . . . Q:LTCNT(NAME,IEN)>2  ;stop after 2 baseline results

 . . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)

 . . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)

 . . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"DAA_FILL",DAA,ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",((9999999-DATE)\1),ITEM,1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)

 . . . . . S VAL=$G(@NODE@("LR",NAME,IEN,DATE))

 . . . . . S TMP=$S($$NUMERIC^RORUTL05($P(VAL,U)):3,1:1)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"RESULT",$P(VAL,U),ITEM,TMP)

 . . . . . D ADDVAL^RORTSK11(RORTSK,"WKS_LAB","Baseline",ITEM,1)

 . ;--- List of drugs

 . S DATE=""

 . F  S DATE=$O(@NODE@("RX",DATE))  Q:DATE=""  D

 . . S NAME=""

 . . F  S NAME=$O(@NODE@("RX",DATE,NAME))  Q:NAME=""  D

 . . . S IEN=""

 . . . F  S IEN=$O(@NODE@("RX",DATE,NAME,IEN))  Q:IEN=""  D

 . . . . S RXNUM=""

 . . . . F  S RXNUM=$O(@NODE@("RX",DATE,NAME,IEN,RXNUM)) Q:RXNUM=""  D

 . . . . . S RXCNT=""

 . . . . . F  S RXCNT=$O(@NODE@("RX",DATE,NAME,IEN,RXNUM,RXCNT)) Q:RXCNT=""  S RXBUF=@NODE@("RX",DATE,NAME,IEN,RXNUM,RXCNT) D

 . . . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)

 . . . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)

 . . . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)

 . . . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)

 . . . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"DAA_FILL",DAA,ITEM,1)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"FILL_DATE",DATE\1,ITEM,1)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)

 . . . . . . D ADDVAL^RORTSK11(RORTSK,"DAYSPLY",$P(RXBUF,U,5),ITEM,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 ---RORX022A   15924     printed  Mar 13, 2025@20:49:38                                                                                                                                                                                                   Page 2

RORX022A  ;BPOIFO/CLR - LAB DAA MONITOR (CONT.) ; 22 Feb 2016  2:28 AM

 +1       ;;1.5;CLINICAL CASE REGISTRIES;**8,13,17,18,19,21,28,31,39**;Feb 17, 2006;Build 4

 +2       ;

 +3       ; This routine uses the following IAs:

 +4       ;

 +5       ; #10103 FMADD^XLFDT (supported)

 +6       ; #10103 FMDIFF^XLFDT (supported)

 +7       ; #10035 Direct read of the DOD field of the file #2

 +8       ; #10000 C^%DTC (supported)

 +9       ;   

 +10      ;******************************************************************************

 +11      ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION

 +12      ;-----------  ----------  -----------  ----------------------------------------

 +13      ;ROR*1.5*18   APR  2012   C RAY        Adds select patient panel

 +14      ;ROR*1.5*19   JUN  2012   K GUPTA      Support for ICD-10 Coding System

 +15      ;ROR*1.5*21   SEP  2013   T KOPP       Add ICN column if Additional Identifier

 +16      ;                                       requested.

 +17      ;ROR*1.5*28   APR  2016   T KOPP       Add select DAA/in house drug parameter

 +18      ;                                      Change selection of Rx's from 2 specific

 +19      ;                                       drugs to any drug assigned to the HEP C

 +20      ;                                       registry plus local drugs defined for 

 +21      ;                                       the registry.

 +22      ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT ,PCP,and AGE/DOB as additional

 +23      ;                                      identifiers.

 +24      ;ROR*1.5*39   JUN 2021    F TRAXLER    Replace real SSN with zeroes.

 +25      ;******************************************************************************

 +26       QUIT 

 +27      ;

 +28      ;***** LAB SEARCH CALLBACK

 +29      ;

 +30      ; .ROR8DST      Reference to the ROR8DST parameter.

 +31      ;

 +32      ; INVDT         IEN of the Lab test (inverted date)

 +33      ;

 +34      ; .RESULT       Reference to a local variable, which contains

 +35      ;               the result (see the $$LTSEARCH^RORUTL10).

 +36      ;

 +37      ; Return Values:

 +38      ;       <0  Error code (the search will be aborted)

 +39      ;        0  Ok

 +40      ;        1  Skip this result

 +41      ;        2  Skip this and all remaining results

 +42      ;

LTSCB(ROR8DST,INVDT,RESULT) ;

 +1       ;all lab tests

 +2        NEW DATE,IEN,NAME,RC,TMP,VAL,WEEKS,DAYS,RAWDAYS

 +3       ; IEN of the Lab test

           SET IEN=+RESULT(2)

           if IEN'>0

               QUIT 1

 +4       ; Name of the test

           SET NAME=$PIECE(RESULT(2),U,2)

           if NAME=""

               QUIT 1

 +5       ; Result of the test

           SET VAL=$PIECE(RESULT(1),U,3)

           if VAL=""

               QUIT 1

 +6       ; Date of the test

           SET DATE=+$PIECE(RESULT(1),U,1)

           if DATE'>0

               QUIT 1

 +7        SET RAWDAYS=$$FMDIFF^XLFDT(((9999999-DATE)\1),ROR8DST("DAA"))

 +8       ;Number of weeks

           SET WEEKS=RAWDAYS\7

 +9       ;Remainder in days

           SET DAYS=RAWDAYS#7

 +10       SET VAL=$$UP^XLFSTR(VAL)

 +11      ;--- Skip value if test not performed

 +12       IF VAL["CANC"!(VAL["DNR")!(VAL["TNP")

               QUIT 1

 +13      ;--- Skip value out of the result range

 +14       IF $DATA(RORLTRV(IEN))>1

               SET RC=1

               Begin DoDot:1

 +15               SET VAL=$$CLRNMVAL^RORUTL18($PIECE(RESULT(1),U,3))

 +16      ;--- Skip a non-numeric result

 +17               if '$$NUMERIC^RORUTL05(VAL)

                       QUIT 

 +18      ;--- Check the range

 +19               IF $GET(RORLTRV(IEN,"L"))'=""

                       if VAL<RORLTRV(IEN,"L")

                           QUIT 

 +20               IF $GET(RORLTRV(IEN,"H"))'=""

                       if VAL>RORLTRV(IEN,"H")

                           QUIT 

 +21               SET RC=0

               End DoDot:1

               if RC

                   QUIT RC

 +22      ;--- Store the result

 +23       SET @ROR8DST@(NAME,IEN,DATE)=($PIECE(RESULT(1),U,3))_U_(+WEEKS_" weeks "_+DAYS_" days")

 +24       QUIT 0

 +25      ;

 +26      ;***** QUERIES THE REGISTRY

 +27      ;

 +28      ; FLAGS         Flags for the $$SKIP^RORXU005

 +29      ; RORTSK        Parameters passed by client

 +30      ; .NSPT         Number of selected patients is returned here

 +31      ;

 +32      ; Return Values:

 +33      ;       <0  Error code

 +34      ;        0  Ok

 +35      ;       >0  Number of non-fatal errors

 +36      ;

QUERY(FLAGS,RORTSK,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       ; Date of patient's 1st DAA fill

           NEW RORDAA

 +8       ; Location of drug list

           NEW RORXL

 +9       ; RX start date

           NEW RXSDT

 +10      ; RX end date

           NEW RXEDT

 +11      ; National ICN

           NEW RORICN

 +12      ; Patient Care Team

           NEW RORPACT

 +13      ; Priamary Care Provider

           NEW RORPCP

 +14      ;

 +15       NEW CNT,ECNT,IEN,IENS,PATIEN,RC,SKIP,TMP,VA,VADM,XREFNODE

 +16       NEW RCC,FLAG,DAASDT,DAAEDT,RORXSDT,RORDAACH,AGE,AGETYPE

 +17       NEW LTEDT,LTSDT,LTWKDYS,LTWKS

 +18       SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))

 +19       SET (CNT,ECNT,NSPT,RC,RORCDLIST)=0

 +20      ;--- Number of patients in the registry

 +21       SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)

           if RORPTN<0

               SET RORPTN=0

 +22      ;--- Date range to search for DAA meds

 +23       SET DAASDT=$$PARAM^RORTSK01("DATE_RANGE_4","START")\1

 +24       SET DAAEDT=$$PARAM^RORTSK01("DATE_RANGE_4","END")\1

 +25      ;--- set up LAB descriptors

 +26       SET LTWKS=$$PARAM^RORTSK01("WEEKS_AFTER")

 +27       SET LTWKDYS=LTWKS*7

 +28       SET LTMREC=$$PARAM^RORTSK01("WEEKS_AFTER","MOST_RECENT")

 +29       SET RORLDST("RORCB")="$$LTSCB^RORX022A"

 +30      ;--- set up RX descriptors

 +31       SET RORXDST("RORCB")="$$RXOCB^RORX022A"

 +32       SET RORXDST("GENERIC")=1

 +33       SET RORXL=$$ALLOC^RORTMP()

 +34       SET RC=$$DRUGLIST^RORUTL16(RORXL,+RORREG,"DG")

 +35      ;based on compliance date PSN*4*293

           SET RXSDT=3100101

 +36       SET RXEDT=$$FMADD^XLFDT(DAAEDT,1)

 +37      ;--- Set up Clinic/Division list parameters

 +38       IF $DATA(RORTSK("PARAMS","CLINICS","C"))

               SET RORCDLIST=1

 +39       IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))

               SET RORCDLIST=1

 +40      ;--- Set up ICD parameters

 +41       SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))

 +42      ;

 +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 for patient list and quit if not on list  ;+18

 +53               IF $DATA(RORTSK("PARAMS","PATIENTS","C"))

                       IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))

                           QUIT 

 +54      ;--- Check if the patient should be skipped

 +55               if $$SKIP^RORXU005(IEN,FLAGS)

                       QUIT 

 +56      ;--- Check if patient should be skipped because of ICD codes

 +57               SET RCC=0

 +58               IF FLAG'="ALL"

                       Begin DoDot:2

 +59                       SET RCC=$$ICD^RORXU010(PATIEN)

                       End DoDot:2

 +60               IF (FLAG="INCLUDE")&(RCC=0)

                       QUIT 

 +61               IF (FLAG="EXCLUDE")&(RCC=1)

                       QUIT 

 +62      ;--- Check if patient should be skipped because not on Clinic or Division list

 +63               IF RORCDLIST

                       IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,DAASDT,DAAEDT)

                           QUIT 

 +64      ;--- Report specific filters

 +65               SET SKIP=1

 +66      ;--- Check if patient should be skipped because no DAA fill

 +67               Begin DoDot:2

 +68      ;--- Search for 1st DAA fill date skip patient if not taking DAA

 +69      ;set DAA flag

                       SET RORXDST("1STDAA")=1

 +70                   Begin DoDot:3

 +71                       NEW RORDAACH

 +72                       SET RORDAACH=$$PARAM^RORTSK01("OPTIONS","DAA_DRUGS")

 +73                       SET RORXDST=$$ALLOC^RORTMP()

 +74                       SET RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV"_$SELECT(RORDAACH="C":"C",RORDAACH="I":"H",1:""),RXSDT,RXEDT)

                       End DoDot:3

                       IF RC'>0

                           QUIT 

 +75                   SET SKIP=0

                   End DoDot:2

                   IF RC<0

                       SET ECNT=ECNT+1

                       SET RC=0

                       QUIT 

 +76               SET RORDAA=$ORDER(@RORXDST@(""))

 +77      ;1st fill before daa start date

                   IF +RORDAA<DAASDT

                       SET SKIP=1

 +78      ;--- Skip the patient if not all search criteria have been met

 +79               IF SKIP

                       DO FREE^RORTMP(RORXDST)

                       QUIT 

 +80      ;=== Store the patient's data

 +81               DO VADEM^RORUTL05(PATIEN,1)

                   SET VA("BID")="0000"

 +82               DO FREE^RORTMP(RORXDST)

 +83               SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")

 +84               SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")

 +85               SET RORICN=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")

 +86               SET RORPACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")

 +87               SET RORPCP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")

 +88               SET ^TMP("RORX022",$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_RORDAA_U_RORICN_U_RORPACT_U_RORPCP_U_AGE

 +89      ;--- Get lab tests N weeks after 1st DAA fill

 +90               NEW X,X1,X2

 +91               SET X1=RORDAA

                   SET X2=LTWKDYS

                   DO C^%DTC

                   SET LTEDT=X

 +92               SET LTEDT=$$FMADD^XLFDT(LTEDT\1,1)

 +93      ;--- If baseline requested get all lab results

 +94               SET LTSDT=$SELECT(LTMREC=1:"",1:RORDAA)

 +95               SET RORLDST("DAA")=RORDAA

 +96               Begin DoDot:2

 +97                   SET RORLDST=$NAME(^TMP("RORX022",$JOB,"PAT",PATIEN,"LR"))

 +98                   SET RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)

                   End DoDot:2

                   if RC<0

                       QUIT 

 +99      ;--- Get all registry med fills 60 days before 1st DAA fill

 +100     ;clear DAA flag

                   KILL RORXDST("1STDAA")