Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX011

RORX011.m

Go to the documentation of this file.
  1. RORX011 ;HOIFO/SG,VAC - PATIENT MEDICATION HISTORY ;4/17/09 10:45am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,31,39**;Feb 17, 2006;Build 4
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10103 DT^XLFDT, FMADD^XLFDT (supported)
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
  1. ; 'include' or 'exclude'.
  1. ;ROR*1.5*13 DEC 2010 A SAUNDERS Added #refills remaining and logic
  1. ; to include only most recent fills
  1. ; NOTE: Patch 11 became patch 13.
  1. ; Any references to patch 11 in the code
  1. ; below is referring to path 13.
  1. ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
  1. ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
  1. ; additional identifier option selected
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
  1. ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** OUTPUTS THE REPORT HEADER
  1. ;
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; >0 IEN of the HEADER element
  1. ;
  1. ;;PATIENTS(#,NAME,LAST4,DOB,AGE,DOD,ICN,PACT,PCP)
  1. ;;PTRXL(DATE,ORDER,TYPE,NAME,GENERIC,DAYSPLY,FILLTYPE,REFILLS)
  1. ;REFILLS added to column headers (above) - Patch 11
  1. N HEADER,NOTES,RC
  1. S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
  1. Q:HEADER<0 HEADER
  1. S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
  1. D ADDVAL^RORTSK11(RORTSK,"AGE",$$DT^XLFDT,NOTES)
  1. S RC=$$TBLDEF^RORXU002("HEADER^RORX011",HEADER)
  1. Q $S(RC<0:RC,1:HEADER)
  1. ;
  1. ;***** OUTPUTS THE PARAMETERS TO THE REPORT
  1. ;
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; [.STDT] Start and end dates of the report
  1. ; [.ENDT] are returned via these parameters
  1. ; [.FLAGS] Flags for the $$SKIP^RORXU005 are returned via this parameter
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; >0 IEN of the PARAMETERS element
  1. ;
  1. PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
  1. N PARAMS,TMP
  1. S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
  1. Q:PARAMS<0 PARAMS
  1. ;--- Process the drug list and options
  1. S TMP=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL,.RORXGRP)
  1. Q:TMP<0 TMP
  1. ;
  1. Q PARAMS
  1. ;
  1. ;***** PROCESS THE PATIENT'S DATA
  1. ;
  1. ; PTLIST Reference (IEN) to the parent tag
  1. ; PATIEN Patient IEN in the file #2 (DFN)
  1. ; RORXDST Patient's Medication History data
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. PATIENT(PTLIST,PATIEN,RORXDST) ;
  1. N BUF,FLT,FLTL,FQL,ITEM,NODE,PTAG,QSB,RC,TABLE,VA,VADM,VAERR
  1. S (ECNT,RC)=0
  1. ;--- Patient data
  1. S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLIST,,PATIEN)
  1. Q:PTAG<0 PTAG
  1. D VADEM^RORUTL05(PATIEN,1)
  1. D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
  1. S VA("BID")="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
  1. D ADDVAL^RORTSK11(RORTSK,"DOB",$$DATE^RORXU002(VADM(3)\1),PTAG,1)
  1. D ADDVAL^RORTSK11(RORTSK,"AGE",VADM(4),PTAG,3)
  1. D ADDVAL^RORTSK11(RORTSK,"DOD",$$DATE^RORXU002(VADM(6)\1),PTAG,1)
  1. I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1. . D ADDVAL^RORTSK11(RORTSK,"ICN",$$ICN^RORUTL02(PATIEN),PTAG,1)
  1. I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1. . D ADDVAL^RORTSK11(RORTSK,"PACT",$$PACT^RORUTL02(PATIEN),PTAG,1)
  1. I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1. . D ADDVAL^RORTSK11(RORTSK,"PCP",$$PCP^RORUTL02(PATIEN),PTAG,1)
  1. ;--- List of drugs
  1. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PTRXL",,PTAG)
  1. Q:TABLE<0 TABLE
  1. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PTRXL")
  1. ;---
  1. S NODE=RORXDST,FLTL=$L(NODE)-1,FLT=$E(NODE,1,FLTL)
  1. S QSB=$QL(NODE),FQL=QSB+5
  1. F S NODE=$Q(@NODE) Q:$E(NODE,1,FLTL)'=FLT D:$QL(NODE)=FQL
  1. . ; NODE: @RORXDST@(DATE,DRUGNAME,DRUGIEN,RXNUM,RXCNT)
  1. . S BUF=@NODE
  1. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
  1. . D ADDVAL^RORTSK11(RORTSK,"DATE",$QS(NODE,QSB+1)\1,ITEM,1)
  1. . D ADDVAL^RORTSK11(RORTSK,"ORDER",$QS(NODE,QSB+4),ITEM,1)
  1. . S TMP=$P(BUF,U)
  1. . S TMP=$S(TMP="O":"ORIGINAL",TMP="P":"PARTIAL",TMP="R":"REFILL",1:"")
  1. . D ADDVAL^RORTSK11(RORTSK,"TYPE",TMP,ITEM,1)
  1. . D ADDVAL^RORTSK11(RORTSK,"NAME",$QS(NODE,QSB+2),ITEM,1)
  1. . D ADDVAL^RORTSK11(RORTSK,"GENERIC",$P(BUF,U,4),ITEM,1)
  1. . D ADDVAL^RORTSK11(RORTSK,"DAYSPLY",$P(BUF,U,5),ITEM,1)
  1. . S TMP=$P(BUF,U,2)
  1. . S TMP=$S(TMP="I":"INPATIENT",TMP="M":"MAIL",TMP="W":"WINDOW",1:"")
  1. . D ADDVAL^RORTSK11(RORTSK,"FILLTYPE",TMP,ITEM,1)
  1. . D ADDVAL^RORTSK11(RORTSK,"REFILLS",$P(BUF,U,6),ITEM,1) ;number of refills remaining - Patch 11
  1. ;---
  1. Q $S(RC<0:RC,1:ECNT)
  1. ;
  1. ;***** PROCESSES THE LIST OF PATIENTS
  1. ;
  1. ; REPORT Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. PROCESS(REPORT,FLAGS) ;
  1. N CNT,ECNT,IEN798,PTIEN,PTLIST,PTNODE,RC,RORPTN,RORXDST,RXFLAGS,SKIP,TMP,DFN
  1. N RORX011 S RORX011=1 ;Patch 11: needed for 'callback' function setup in PROCESS^RORUTL15
  1. S (CNT,ECNT,RC)=0
  1. N RCC,FLAG
  1. N RORCDLIST ; Flag to indicate whether a clinic or division list exists
  1. N RORCDSTDT ; Start date for clinic/division utilization search
  1. N RORCDENDT ; End date for clinic/division utilization search
  1. ;
  1. ;--- Count patients in the list. Define which patient 'list' to use: the one
  1. ;selected by the user, or all patients in 798
  1. I RORALL D S:RORPTN<0 RORPTN=0
  1. . S PTNODE=$NA(^RORDATA(798,"ARP",RORREG_"#"))
  1. . S RORPTN=$$REGSIZE^RORUTL02(+RORREG)
  1. E S (PTIEN,RORPTN)=0 D Q:RORPTN'>0 0
  1. . S PTNODE=$NA(RORTSK("PARAMS","PATIENTS","C"))
  1. . F S PTIEN=$O(@PTNODE@(PTIEN)) Q:PTIEN'>0 S RORPTN=RORPTN+1
  1. ;---
  1. S PTLIST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1. Q:PTLIST<0 PTLIST
  1. ;
  1. ;--- Prepare parameters for the pharmacy search API
  1. S RORXDST=$NA(^TMP("RORX011",$J))
  1. S RORXDST("RORCB")="$$RXSCB^RORX011"
  1. S RXFLAGS="E"
  1. S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
  1. S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
  1. ;
  1. ;=== Set up Clinic/Division list parameters
  1. S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
  1. ;
  1. ;--- Browse through the list of selected patients
  1. S (CNT,PTIEN)=0
  1. S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1. ;
  1. F S PTIEN=$O(@PTNODE@(PTIEN)) Q:PTIEN'>0 D Q:RC<0
  1. . S RC=$$LOOP^RORTSK01(CNT/RORPTN) Q:RC<0
  1. . S CNT=CNT+1,IEN798=$$PRRIEN^RORUTL01(PTIEN,RORREG) Q:IEN798'>0
  1. . ;--- Check if the patient should be skipped
  1. . I RORALL Q:$$SKIP^RORXU005(IEN798,FLAGS,RORSDT,ROREDT)
  1. . ;
  1. . ;--- Check the patient against the ICD Filter
  1. . S RCC=0
  1. . I FLAG'="ALL" D
  1. . . S RCC=$$ICD^RORXU010(PTIEN)
  1. . I (FLAG="INCLUDE")&(RCC=0) Q
  1. . I (FLAG="EXCLUDE")&(RCC=1) Q
  1. . ;--- End of check for ICD Filter
  1. . ;--- Check for Clinic or Division list and quit if not in list
  1. . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PTIEN,RORCDSTDT,RORCDENDT) Q
  1. . ;--- Search the pharmacy data
  1. . K @RORXDST
  1. . S TMP=$$RXSEARCH^RORUTL14(PTIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
  1. . I TMP<0 S ECNT=ECNT+1 Q
  1. . I RORALL Q:TMP'>0
  1. . ;--- If user selected most recent drug fills, remove older duplicates
  1. . I $$PARAM^RORTSK01("OPTIONS","RECENT_FILLS") D RECENT(RORXDST)
  1. . ;--- Append the patient's data to the report
  1. . S TMP=$$PATIENT(PTLIST,PTIEN,RORXDST)
  1. . I TMP S ECNT=ECNT+$S(TMP>0:TMP,1:1) Q
  1. ;
  1. ;--- Cleanup
  1. K @RORXDST
  1. K ^TMP("RORX011-RESORTED",$J) ;Patch 11
  1. Q $S(RC<0:RC,1:ECNT)
  1. ;
  1. ;***** COMPILES THE "PATIENT DRUG HISTORY" REPORT
  1. ; REPORT CODE: 011
  1. ;
  1. ; .RORTSK Task number and task parameters
  1. ;
  1. ; The ^TMP("RORX011",$J) global node is used by this function.
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. RXHIST(RORTSK) ;
  1. N RORALL ; Consider all registry patients
  1. N ROREDT ; End date
  1. N ROREDT1 ; End date + 1
  1. N RORREG ; Registry IEN
  1. N RORSDT ; Start date
  1. N RORXGRP ; List of drug groups
  1. N RORXL ; Closed root of the medication list
  1. ;
  1. N ECNT,FLAGS,RC,REPORT,TMP
  1. S RORXL="",(ECNT,RC)=0
  1. K ^TMP("RORX011",$J)
  1. ;
  1. ;--- Root node of the report
  1. S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
  1. Q:REPORT<0 REPORT
  1. ;
  1. D
  1. . ;--- Get and prepare the report parameters
  1. . S RORREG=+$$PARAM^RORTSK01("REGIEN")
  1. . S RORALL=$$PARAM^RORTSK01("PATIENTS","ALL")
  1. . S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.FLAGS) Q:RC<0
  1. . S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
  1. . ;
  1. . ;--- Report header
  1. . S RC=$$HEADER(REPORT) Q:RC<0
  1. . ;
  1. . ;--- Process the data and generate the report
  1. . S RC=$$PROCESS(REPORT,FLAGS) S:RC>0 ECNT=ECNT+RC
  1. ;
  1. ;--- Cleanup
  1. K ^TMP("RORX011-RESORTED",$J)
  1. D FREE^RORTMP(RORXL)
  1. Q $S(RC<0:RC,ECNT>0:-43,1:0)
  1. ;
  1. ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
  1. RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE,NUMREF) ;
  1. N DRUGIEN,DRUGNAME,FILLTYPE,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,TMP
  1. S DRUGIEN=+DRUG,DRUGNAME=$P(DRUG,U,2)
  1. Q:(DRUGIEN'>0)!(DRUGNAME="") 1
  1. ;--- Check the drug groups
  1. S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
  1. Q:TMP TMP
  1. ;--- Process the order
  1. S:ROR8DST("RORXGEN")>0 $P(RXBUF,U,4)=$P(ROR8DST("RORXGEN"),U,2)
  1. S $P(RXBUF,U,5)=$P($G(^TMP("PS",$J,0)),U,7) ; Days Supply
  1. S $P(RXBUF,U,6)=+$G(NUMREF) ; # Refills remaining - Patch 11
  1. S TMP=$G(^TMP("PS",$J,"RXN",0))
  1. S FILLTYPE=$S(ORDFLG["I":"I",1:$P(TMP,U,3))
  1. S RXNUM=$P(TMP,U) S:RXNUM="" RXNUM=" "
  1. S RXCNT=0
  1. ;--- Original prescription
  1. I ORDFLG["I" D ;--- Inpatient
  1. . S OFD=$P($G(^TMP("PS",$J,0)),U,5) ; Start Date
  1. . S $P(RXBUF,U,1,2)="I"_U_FILLTYPE,RXCNT=RXCNT+1
  1. . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
  1. E D ;--- Outpatient
  1. . S OFD=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
  1. . Q:(OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
  1. . S $P(RXBUF,U,1,2)="O"_U_FILLTYPE,RXCNT=RXCNT+1
  1. . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
  1. ;--- Refills and partials
  1. F RPSUB="REF","PAR" D
  1. . S $P(RXBUF,U)=$E(RPSUB,1)
  1. . S IRP=0
  1. . F S IRP=$O(^TMP("PS",$J,RPSUB,IRP)) Q:IRP'>0 D
  1. . . S TMP=$G(^TMP("PS",$J,RPSUB,IRP,0))
  1. . . S $P(RXBUF,U,2)=$S(ORDFLG["I":"I",1:$P(TMP,U,5))
  1. . . S $P(RXBUF,U,5)=$P(TMP,U,2) ; Days Supply
  1. . . I TMP>0 S RXCNT=RXCNT+1 D
  1. . . . S @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
  1. Q 0
  1. ;
  1. ;***** KEEP ONLY MOST RECENT FILLS FOR EACH DRUG
  1. ;Input:
  1. ; RORXDST - arry containing all drug fills for patient
  1. ;
  1. ;Output:
  1. ; RORXDST - array containing only most recent drug fills for patient
  1. ;
  1. ;The ^TMP("RORX011-RESORTED",$J) global node is used by this function.
  1. ;Indirection: RORXDST = $NA(^TMP("RORX011",$J))
  1. ; ^TMP("RORX011",$J,DATE,DRUG_NAME,IEN,...)
  1. ;
  1. RECENT(RORXDST) ;
  1. N DATE,DRUG
  1. K ^TMP("RORX011-RESORTED",$J) ;empty the temporary global
  1. ;Patient's Rx data was stored by date, then drug name. Spin through
  1. ;Rx data and re-order it by drug name first, then date. The reordered
  1. ;data is put into temp global ^TMP("RORX011-RESORTED",$J,DRUG,DATE)
  1. S DATE=0 F S DATE=$O(@RORXDST@(DATE)) Q:'DATE D
  1. . S DRUG=0 F S DRUG=$O(@RORXDST@(DATE,DRUG)) Q:'$L(DRUG) D
  1. . . S ^TMP("RORX011-RESORTED",$J,DRUG,DATE)=1
  1. ;
  1. ;spin through re-sorted drug file
  1. S DRUG=0 F S DRUG=$O(^TMP("RORX011-RESORTED",$J,DRUG)) Q:'$L(DRUG) D
  1. . ;get entry for drug with most recent (latest) date
  1. . S DATE=$O(^TMP("RORX011-RESORTED",$J,DRUG,9999999),-1)
  1. . ;has any drug been re-filled?
  1. . F S DATE=$O(^TMP("RORX011-RESORTED",$J,DRUG,DATE),-1) Q:'DATE D
  1. . . ;yes, previous/older fill found - delete from the original file
  1. . . K @RORXDST@(DATE,DRUG)
  1. Q