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 ---[H[J[2J[HRORX022A 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")
+101 Begin DoDot:2
+102 NEW RORDAACH
+103 SET RORXDST=$NAME(^TMP("RORX022",$JOB,"PAT",PATIEN,"RX"))
+104 SET X1=RORDAA
SET X2=-60
DO C^%DTC
SET RORXSDT=X
+105 SET RORXEDT=$$FMADD^XLFDT(DT,1)
+106 SET RORDAACH=$$PARAM^RORTSK01("OPTIONS","DAA_DRUGS")
+107 SET RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV"_$SELECT(RORDAACH="C":"C",RORDAACH="I":"H",1:""),RORXSDT,RORXEDT)
End DoDot:2
if RC<0
QUIT
+108 SET NSPT=NSPT+1
End DoDot:1
if RC<0
QUIT
+109 QUIT $SELECT(RC<0:RC,1:ECNT)
+110 ;
+111 ;
+112 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
+113 ;
+114 ; .ROR8DST Reference to the ROR8DST parameter.
+115 ;
+116 ;
+117 ; ORDER Order number (from condensed list)
+118 ;
+119 ; FLAGS Flags describing the order to be
+120 ; processed.
+121 ;
+122 ; DRUG Dispensed drug
+123 ; ^01: Drug IEN in file #50
+124 ; ^02: Drug name
+125 ;
+126 ; DATE Order date (issue date for outpatient
+127 ; drugs or start date for inpatient)
+128 ;
+129 ;Return Values:
+130 ; <0 Error code (the search will be aborted)
+131 ; 0 Ok
+132 ; 1 Skip this result
+133 ; 2 Skip this and all remaining results
+134 ;
RXOCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW DRUGIEN,DRUGNAME,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,TMP
+2 IF ROR8DST("GENERIC")
Begin DoDot:1
+3 SET DRUGIEN=+ROR8DST("RORXGEN")
SET DRUGNAME=$PIECE(ROR8DST("RORXGEN"),U,2)
End DoDot:1
+4 IF DRUGIEN'>0!(DRUGNAME="")
SET DRUGIEN=+DRUG
SET DRUGNAME=$PIECE(DRUG,U,2)
+5 if (DRUGIEN'>0)!(DRUGNAME="")
QUIT 1
+6 ;--- if DAA flag set, skip med if not a DAA
+7 ;I +$G(ROR8DST("1STDAA")),(DRUGNAME'="BOCEPREVIR"),(DRUGNAME'="TELAPREVIR") Q 1
+8 ; Days Supply
SET $PIECE(RXBUF,U,5)=$PIECE($GET(^TMP("PS",$JOB,0)),U,7)
+9 SET TMP=$GET(^TMP("PS",$JOB,"RXN",0))
+10 SET RXNUM=$PIECE(TMP,U)
if RXNUM=""
SET RXNUM=" "
+11 SET RXCNT=0
+12 ;--- Original prescription
+13 ;--- Inpatient
IF ORDFLG["I"
Begin DoDot:1
+14 ; Start Date
SET OFD=$PIECE($GET(^TMP("PS",$JOB,0)),U,5)\1
+15 SET RXCNT=RXCNT+1
+16 SET @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
End DoDot:1
+17 ;--- Outpatient
IF '$TEST
Begin DoDot:1
+18 ; Original Fill Date
SET OFD=+$PIECE($GET(^TMP("PS",$JOB,"RXN",0)),U,6)
+19 if (OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
QUIT
+20 SET RXCNT=RXCNT+1
+21 SET @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
End DoDot:1
+22 ;--- Refills and partials
+23 FOR RPSUB="REF","PAR"
Begin DoDot: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 ; Days Supply
SET $PIECE(RXBUF,U,5)=$PIECE(TMP,U,2)
+28 IF TMP>0
SET RXCNT=RXCNT+1
Begin DoDot:3
+29 SET @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT 0
+31 ;
+32 ;***** STORES THE REPORT DATA
+33 ;
+34 ; REPORT IEN of the REPORT element
+35 ; RORTSK Parameters passed by GUI
+36 ; NSPT Number of selected patients
+37 ;
+38 ; Return Values:
+39 ; <0 Error code
+40 ; 0 Ok
+41 ; >0 Number of non-fatal errors
+42 ;
STORE(REPORT,RORTSK,NSPT) ;
+1 NEW CNT,DATE,DFN,DAA,ECNT,ICN,IEN,ITEM,LAST4,LTLST,NAME,NODE,PTCNT,PACT,PCP,PTLST,PTNAME,RC,RXLST,TMP,VAL,AGE,AGETYPE
+2 NEW DAAINV,LRMREC
+3 SET (ECNT,RC)=0
SET (LTLST,PTLST,RXLST)=-1
+4 ;--- Force the "patient data" note in the output
+5 DO ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
+6 SET LRMREC=$$PARAM^RORTSK01("LABTESTS","MOST_RECENT")
+7 ;--- Create lab test list
+8 Begin DoDot:1
+9 SET LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)
+10 DO ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")
End DoDot:1
if LTLST<0
QUIT LTLST
+11 ;--- Create pharmacy list
+12 Begin DoDot:1
+13 SET RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
+14 DO ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")
End DoDot:1
if RXLST<0
QUIT RXLST
+15 ;--- Loop through selected patients and store as XML
+16 SET (CNT,DFN,PTCNT)=0
+17 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+18 FOR
SET DFN=$ORDER(^TMP("RORX022",$JOB,"PAT",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+19 SET TMP=$SELECT(NSPT>0:CNT/NSPT,1:"")
+20 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+21 SET CNT=CNT+1
SET NODE=$NAME(^TMP("RORX022",$JOB,"PAT",DFN))
+22 ;--- Patient's data
+23 SET TMP=$GET(@NODE)
+24 SET LAST4=$PIECE(TMP,U)
SET PTNAME=$PIECE(TMP,U,2)
SET DAA=$PIECE(TMP,U,3)
SET ICN=$PIECE(TMP,U,4)
SET PACT=$PIECE(TMP,U,5)
SET PCP=$PIECE(TMP,U,6)
SET AGE=$PIECE(TMP,U,7)
+25 SET PTCNT=PTCNT+1
+26 ;--- List of Lab tests
+27 SET NAME=""
KILL LTCNT
+28 FOR
SET NAME=$ORDER(@NODE@("LR",NAME))
if NAME=""
QUIT
Begin DoDot:2
+29 SET IEN=""
+30 FOR
SET IEN=$ORDER(@NODE@("LR",NAME,IEN))
if IEN=""
QUIT
Begin DoDot:3
+31 SET DATE=""
SET DAAINV=9999999-DAA
+32 FOR
SET DATE=$ORDER(@NODE@("LR",NAME,IEN,DATE))
if DATE=""!($GET(LTCNT(NAME,IEN))=2)!((DATE>DAAINV)&'LTMREC)
QUIT
Begin DoDot:4
+33 ;store results after or on DAA fill date
+34 IF DATE'>DAAINV
Begin DoDot:5
+35 ;quit if most recent
IF LRMREC
IF $GET(LTCNT(NAME,IEN))=0
QUIT
+36 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
+37 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+38 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+39 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+40 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+41 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+42 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+43 DO ADDVAL^RORTSK11(RORTSK,"DATE",((9999999-DATE)\1),ITEM,1)
+44 DO ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
+45 SET VAL=$GET(@NODE@("LR",NAME,IEN,DATE))
+46 SET TMP=$SELECT($$NUMERIC^RORUTL05($PIECE(VAL,U)):3,1:1)
+47 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$PIECE(VAL,U),ITEM,TMP)
+48 DO ADDVAL^RORTSK11(RORTSK,"WKS_LAB",$PIECE(VAL,U,2),ITEM,1)
+49 SET LTCNT(NAME,IEN)=0
End DoDot:5
QUIT
+50 ;store 2 baseline results if flag is set
+51 IF LTMREC
Begin DoDot:5
+52 ;count for each test
SET LTCNT(NAME,IEN)=$SELECT('$DATA(LTCNT(NAME,IEN)):1,1:LTCNT(NAME,IEN)+1)
+53 ;stop after 2 baseline results
if LTCNT(NAME,IEN)>2
QUIT
+54 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
+55 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+56 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+57 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+58 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+59 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+60 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+61 DO ADDVAL^RORTSK11(RORTSK,"DAA_FILL",DAA,ITEM,1)
+62 DO ADDVAL^RORTSK11(RORTSK,"DATE",((9999999-DATE)\1),ITEM,1)
+63 DO ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
+64 SET VAL=$GET(@NODE@("LR",NAME,IEN,DATE))
+65 SET TMP=$SELECT($$NUMERIC^RORUTL05($PIECE(VAL,U)):3,1:1)
+66 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$PIECE(VAL,U),ITEM,TMP)
+67 DO ADDVAL^RORTSK11(RORTSK,"WKS_LAB","Baseline",ITEM,1)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+68 ;--- List of drugs
+69 SET DATE=""
+70 FOR
SET DATE=$ORDER(@NODE@("RX",DATE))
if DATE=""
QUIT
Begin DoDot:2
+71 SET NAME=""
+72 FOR
SET NAME=$ORDER(@NODE@("RX",DATE,NAME))
if NAME=""
QUIT
Begin DoDot:3
+73 SET IEN=""
+74 FOR
SET IEN=$ORDER(@NODE@("RX",DATE,NAME,IEN))
if IEN=""
QUIT
Begin DoDot:4
+75 SET RXNUM=""
+76 FOR
SET RXNUM=$ORDER(@NODE@("RX",DATE,NAME,IEN,RXNUM))
if RXNUM=""
QUIT
Begin DoDot:5
+77 SET RXCNT=""
+78 FOR
SET RXCNT=$ORDER(@NODE@("RX",DATE,NAME,IEN,RXNUM,RXCNT))
if RXCNT=""
QUIT
SET RXBUF=@NODE@("RX",DATE,NAME,IEN,RXNUM,RXCNT)
Begin DoDot:6
+79 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)
+80 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+81 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+82 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+83 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+84 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+85 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+86 DO ADDVAL^RORTSK11(RORTSK,"DAA_FILL",DAA,ITEM,1)
+87 DO ADDVAL^RORTSK11(RORTSK,"FILL_DATE",DATE\1,ITEM,1)
+88 DO ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)
+89 DO ADDVAL^RORTSK11(RORTSK,"DAYSPLY",$PIECE(RXBUF,U,5),ITEM,1)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if RC<0
QUIT
+90 ;--- Inactivate the patient list tag if the list is empty
+91 if PTCNT'>0
DO UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
+92 QUIT ECNT
