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

RORUTL15.m

Go to the documentation of this file.
  1. RORUTL15 ;HCIOFO/BH,SG - PHARMACY DATA SEARCH (TOOLS) ; 04 Apr 2016 4:57 PM
  1. ;;1.5;CLINICAL CASE REGISTRIES;**13,26,28**;Feb 17, 2006;Build 66
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #2400 OCL^PSOORRL and OEL^PSOORRL (controlled)
  1. ; #4533 ARWS^PSS50 (supported)
  1. ; #4543 IEN^PSN50P65 (supported)
  1. ; #4549 ZERO^PSS52P6 (supported)
  1. ; #4826 PSS436^PSS55 (supported)
  1. ; #10104 UP^XLFSTR (supported)
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*13 DEC 2010 A SAUNDERS Patient Med History Report: retrieve
  1. ; #refills remaining and add to the
  1. ; 'callback' function call
  1. ; NOTE: Patch 11 became patch 13.
  1. ; Any references to patch 11 in the code
  1. ; below is referring to path 13.
  1. ;
  1. ;ROR*1.5*26 JUN 2015 T KOPP Callback function for SVR screening
  1. ; does not require the # of refills as a
  1. ; parameter for the Patient Med History
  1. ; Report, so a check is made for callback
  1. ; entry point RXOCB to prevent adding it.
  1. ;
  1. ;ROR*1.5*28 APR 2016 T KOPP Check for DAA drug/in house param
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** DOUBLE-CHECKS THE OUTPATIENT RX (ORDER, REFILLS AND PARTIALS)
  1. ;
  1. ; STDT Start Date (FileMan)
  1. ; ENDT End Date (FileMan)
  1. ;
  1. ; [.NREF] Number of refills is returned via this parameter
  1. ;
  1. ; [.NPAR] Nubmer of partials is returned via this parameter
  1. ;
  1. ; The ^TMP("PS",$J) node must be populated by the OEL^PSOORRL
  1. ; before calling this function.
  1. ;
  1. ; Return Values:
  1. ; 0 Ok
  1. ; 1 Skip the order
  1. ;
  1. DTCHECK(STDT,ENDT,NREF,NPAR) ;
  1. N IRP,RXDT,SKIP
  1. S RXDT=+$P($G(^TMP("PS",$J,"RXN",0)),U,6),(NREF,NPAR)=0
  1. S SKIP=(RXDT<STDT)!(RXDT'<ENDT)
  1. ;--- Refills
  1. S IRP=0
  1. F S IRP=$O(^TMP("PS",$J,"REF",IRP)) Q:IRP'>0 D
  1. . S RXDT=+$P($G(^TMP("PS",$J,"REF",IRP,0)),U)
  1. . I RXDT'<STDT,RXDT<ENDT S SKIP=0,NREF=NREF+1 Q
  1. . K ^TMP("PS",$J,"REF",IRP)
  1. ;--- Partials
  1. S IRP=0
  1. F S IRP=$O(^TMP("PS",$J,"PAR",IRP)) Q:IRP'>0 D
  1. . S RXDT=+$P($G(^TMP("PS",$J,"PAR",IRP,0)),U)
  1. . I RXDT'<STDT,RXDT<ENDT S SKIP=0,NPAR=NPAR+1 Q
  1. . K ^TMP("PS",$J,"PAR",IRP)
  1. ;---
  1. Q SKIP
  1. ;
  1. ;***** PROCESSES THE LIST OF PRESELECTED PHARMACY ORDERS
  1. ;
  1. ; PTIEN IEN of the patient (DFN)
  1. ;
  1. ; RORFLAGS Flags to control processing
  1. ;
  1. ; ROR8LST Closed root of the list of preselected orders
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 No orders have been found
  1. ; >0 Number of orders
  1. ;
  1. PROCESS(PTIEN,RORFLAGS,ROR8LST) ;
  1. N DRUGIEN,IRX,IVM,LOADEXT,ORDDATE,ORDER,ORDIEN,ORDFLG,RC,ROR8SET,RORLST,RORTMP,RORTS,RORXCNT,TMP,NUMREF
  1. S LOADEXT=(RORFLAGS["E")
  1. S (RC,RORXCNT)=0
  1. S RORTMP=$$ALLOC^RORTMP(.RORTS)
  1. ;
  1. ;=== Determine the storage method (default or callback)
  1. I $G(ROR8DST("RORCB"))?2"$"1.8UN1"^"1.8UN D
  1. . ;standard callback setup
  1. . S ROR8SET="S RC="_ROR8DST("RORCB")_"(.ROR8DST,ORDER"
  1. . S ROR8SET=ROR8SET_",ORDFLG,DRUGIEN_U_DRUGNAME,ORDDATE)"
  1. . ;Patch 11/13: Variable 'RORX011' is set in routine RORX011 for the
  1. . ;Patient Medications History report. If set, add # refills
  1. . ;remaining (NUMREF) to the callback parameter list.
  1. . I $G(RORX011),$G(ROR8DST("RORCB"))'["RXOCB" S ROR8SET=$E(ROR8SET,1,$L(ROR8SET)-1)_",$G(NUMREF))"
  1. . ;---
  1. . S ROR8DST("RORDFN")=PTIEN
  1. . S ROR8DST("ROREDT")=ROREDT
  1. . S ROR8DST("RORFLAGS")=RORFLAGS
  1. . S ROR8DST("RORSDT")=RORSDT
  1. E S ROR8SET="" K @ROR8DST
  1. ;
  1. ;=== Process the list of preselected orders
  1. S (IRX,RC)=0
  1. F S IRX=$O(@ROR8LST@(IRX)) Q:'IRX D Q:RC
  1. . N REMARK,CHOICE
  1. . S ORDFLG=$P(@ROR8LST@(IRX),U)
  1. . S TMP=@ROR8LST@(IRX,0)
  1. . S ORDER=$P(TMP,U),ORDDATE=$P(TMP,U,15)
  1. . ;Patch 11/13: get #refills remaining for Patient Medication History report:
  1. . I $G(RORX011) S NUMREF=$P(TMP,U,5)
  1. . ;--- Get the order details
  1. . K ^TMP("PS",$J)
  1. . D OEL^PSOORRL(PTIEN,ORDER)
  1. . Q:$D(^TMP("PS",$J))<10
  1. . ; Check order remark for "CHOICE"
  1. . I RORFLAGS["C"!(RORFLAGS["H") D Q:$S(RORFLAGS["C":'CHOICE,RORFLAGS["H":CHOICE,1:0)
  1. . . S REMARK=$$UP^XLFSTR($P($G(^TMP("PS",$J,"RXN",0)),U,4))
  1. . . S CHOICE=(REMARK["CHOICE") ; true if DAA drug, false if in house
  1. . ;=== Inpatient and Outpatient Medications
  1. . I ORDFLG'["V" D Q
  1. . . ;--- Double-check the dates for outpatient orders
  1. . . I ORDFLG["O" Q:$$DTCHECK(RORSDT,ROREDT)
  1. . . ;--- Get the drug IEN in the DRUG file (#50)
  1. . . S TMP=$G(^TMP("PS",$J,"DD",1,0)),DRUGIEN=+$P(TMP,U,3)
  1. . . I DRUGIEN'>0 S DRUGIEN=+$P(TMP,U) Q:DRUGIEN'>0
  1. . . ;--- Process the order
  1. . . S RC=$$PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE)
  1. . . S:'RC RORXCNT=RORXCNT+1
  1. . . S:RC=1 RC=0
  1. . ;=== IV Medications
  1. . S RORLST=$$ALLOC^RORTMP(.TMP),ORDIEN=+ORDER
  1. . D
  1. . . N IEN,ORDER ; Workaround for the bug in the API
  1. . . D PSS436^PSS55(PTIEN,ORDIEN,TMP)
  1. . I $G(@RORLST@(0))'>0 D FREE^RORTMP(RORLST) Q
  1. . ;--- Process the additives
  1. . S IVM=0
  1. . F S IVM=$O(@RORLST@(ORDIEN,"ADD",IVM)) Q:IVM'>0 D Q:RC
  1. . . ;--- IEN in the IV ADDITIVES file (#52.6)
  1. . . S DRUGIEN=+$P($G(@RORLST@(ORDIEN,"ADD",IVM,.01)),U)
  1. . . Q:DRUGIEN'>0
  1. . . ;--- IEN in the DRUG file (#50)
  1. . . D ZERO^PSS52P6(DRUGIEN,,,RORTS)
  1. . . Q:$G(@RORTMP@(0))'>0
  1. . . S DRUGIEN=+$P($G(@RORTMP@(DRUGIEN,1)),U)
  1. . . Q:DRUGIEN'>0
  1. . . ;--- Process the medication
  1. . . S RC=$$PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE)
  1. . . S:'RC RORXCNT=RORXCNT+1
  1. . . S:RC=1 RC=0
  1. . ;---
  1. . D FREE^RORTMP(RORLST)
  1. ;
  1. ;===
  1. D FREE^RORTMP(RORTMP)
  1. Q $S(RC<0:RC,1:RORXCNT)
  1. ;
  1. ;***** PROCESS THE MEDICATION (internal)
  1. ;
  1. ; DRUGIEN IEN of the medication in the DRUG file (#50)
  1. ;
  1. ; The ROR8DST, ROR8RXS, ROR8SET, RORTMP, and RORTS variables
  1. ; must be defined before calling this function.
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; 1 Skip this medication
  1. ; 2 Skip this and all remaining medications
  1. ;
  1. PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE) ;
  1. N DRUGNAME,RC,ROR8BUF,SKIP,TMP
  1. S RC=0
  1. ;=== Load some drug data
  1. D ARWS^PSS50(DRUGIEN,,RORTS) K ROR8BUF
  1. F TMP=2,20,25 S ROR8BUF(TMP)=$G(@RORTMP@(DRUGIEN,TMP))
  1. S DRUGNAME=$G(@RORTMP@(DRUGIEN,.01))
  1. S:DRUGNAME="" DRUGNAME="Unknown (IEN="_DRUGIEN_")"
  1. K @RORTMP
  1. ;--- Generic Drug
  1. S ROR8DST("RORXGEN")=ROR8BUF(20)
  1. I $P(ROR8BUF(20),U,2)="" D S $P(ROR8DST("RORXGEN"),U,2)=TMP
  1. . S TMP="Unknown ("_(+ROR8BUF(20))_")"
  1. ;--- VA Drug Class
  1. S ROR8DST("RORXVCL")=""
  1. D:ROR8BUF(2)'=""
  1. . ;--- If the "national" drug class is the same, use its IEN
  1. . I $P(ROR8BUF(25),U,2)=ROR8BUF(2) D Q
  1. . . S ROR8DST("RORXVCL")=$P(ROR8BUF(25),U,1,2)
  1. . ;--- Get the Drug Class IEN
  1. . D IEN^PSN50P65(,ROR8BUF(2),RORTS)
  1. . S TMP=+$G(@RORTMP@(0))
  1. . S:TMP=1 ROR8DST("RORXVCL")=+$O(@RORTMP@(0))_U_ROR8BUF(2)
  1. . K @RORTMP
  1. ;
  1. ;=== Check if the drug should be skipped
  1. I ROR8RXS'="*" S SKIP=0 D Q:SKIP 1
  1. . Q:$D(@ROR8RXS@(DRUGIEN))
  1. . I $D(@ROR8RXS@("C"))>1 Q:$D(@ROR8RXS@("C",+ROR8DST("RORXVCL")))
  1. . I $D(@ROR8RXS@("G"))>1 Q:$D(@ROR8RXS@("G",+ROR8DST("RORXGEN")))
  1. . S SKIP=1
  1. ;
  1. ;--- Load additional drug data
  1. ;D:LOADEXT
  1. ;.
  1. ;
  1. ;=== Default output
  1. I ROR8SET="" D Q 0
  1. . S RORXCNT=RORXCNT+1
  1. . M @ROR8DST@(RORXCNT)=^TMP("PS",$J)
  1. . S TMP=ORDER_U_ORDFLG_U_ROR8DST("RORXGEN")
  1. . S $P(TMP,U,5,6)=ROR8DST("RORXVCL")
  1. . S @ROR8DST@(RORXCNT)=TMP
  1. ;=== Callback function
  1. X ROR8SET ; (.ROR8DST,ORDER,ORDFLG,DRUGIEN_U_DRUGNAME,ORDDATE,special data for specific reports)
  1. Q RC
  1. ;
  1. ;***** LOADS AND PRESELECTS PHARMACY ORDERS
  1. ;
  1. ; PTIEN IEN of the patient (DFN)
  1. ;
  1. ; FLAGS Flags to control processing
  1. ;
  1. ; STDT Start date (FileMan)
  1. ; ENDT End date (FileMan)
  1. ;
  1. ; ROR8LST Closed root for the list of preselected orders
  1. ;
  1. ; @ROR8LST@(
  1. ; Seq#, Flags that describe the order (I,O,P, etc.)
  1. ; 0) Content of the ^TMP("PS",$J,i,0) node
  1. ; returned by the OCL^PSOORRL (see the DBIA
  1. ; #2400 for details).
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 No orders have been found
  1. ; >0 Number of orders
  1. ;
  1. QUERY(PTIEN,FLAGS,STDT,ENDT,ROR8LST) ;
  1. N IEN,IRX,ORDER,RXCNT,TMP,TYPE
  1. K ^TMP("PS",$J),@ROR8LST
  1. ;
  1. ;--- Prepare the flags
  1. I FLAGS["I" D S TYPE("U;I")="I"
  1. . S:FLAGS["P" TYPE("P;I")="IP"
  1. . S:FLAGS["V" TYPE("V;I")="IV"
  1. I FLAGS["O" D S TYPE("R;O")="O"
  1. . S:FLAGS["P" TYPE("P;O")="OP"
  1. ;
  1. ;--- Load the list of pharmacy orders
  1. D OCL^PSOORRL(PTIEN,STDT,ENDT)
  1. Q:$D(^TMP("PS",$J))<10 0
  1. ;
  1. ;--- Preselect the orders
  1. S (IRX,RXCNT)=0
  1. F S IRX=$O(^TMP("PS",$J,IRX)) Q:'IRX D
  1. . S ORDER=$P($G(^TMP("PS",$J,IRX,0)),U) Q:ORDER'>0
  1. . ;--- Check the type of order
  1. . S TMP=$L(ORDER),TYPE=$E(ORDER,TMP-2,TMP)
  1. . S TYPE=$G(TYPE(TYPE)) Q:TYPE=""
  1. . ;--- Double-check the dates
  1. . I TYPE["I" D Q:(TMP<STDT)!(TMP'<ENDT)
  1. . . S TMP=+$P($G(^TMP("PS",$J,IRX,0)),U,15)
  1. . I TYPE["O" D Q:TMP<STDT
  1. . . S TMP=+$P($G(^TMP("PS",$J,IRX,0)),U,10)
  1. . ;--- Select the order
  1. . S RXCNT=RXCNT+1,@ROR8LST@(RXCNT)=TYPE
  1. . S @ROR8LST@(RXCNT,0)=^TMP("PS",$J,IRX,0)
  1. ;
  1. ;--- Cleanup
  1. K ^TMP("PS",$J)
  1. Q RXCNT