242 lines
7.2 KiB
Mathematica
242 lines
7.2 KiB
Mathematica
RORUTL15 ;HCIOFO/BH,SG - PHARMACY DATA SEARCH (TOOLS) ; 12/21/05 11:11am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #2400 OCL^PSOORRL and OEL^PSOORRL (controlled)
|
|
; #4533 ARWS^PSS50 (supported)
|
|
; #4543 IEN^PSN50P65 (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** DOUBLE-CHECKS THE OUTPATIENT RX (ORDER, REFILLS AND PARTIALS)
|
|
;
|
|
; STDT Start Date (FileMan)
|
|
; ENDT End Date (FileMan)
|
|
;
|
|
; [.NREF] Number of refills is returned via this parameter
|
|
;
|
|
; [.NPAR] Nubmer of partials is returned via this parameter
|
|
;
|
|
; The ^TMP("PS",$J) node must be populated by the OEL^PSOORRL
|
|
; before calling this function.
|
|
;
|
|
; Return Values:
|
|
; 0 Ok
|
|
; 1 Skip the order
|
|
;
|
|
DTCHECK(STDT,ENDT,NREF,NPAR) ;
|
|
N IRP,RXDT,SKIP
|
|
S RXDT=+$P($G(^TMP("PS",$J,"RXN",0)),U,6),(NREF,NPAR)=0
|
|
S SKIP=(RXDT<STDT)!(RXDT'<ENDT)
|
|
;--- Refills
|
|
S IRP=0
|
|
F S IRP=$O(^TMP("PS",$J,"REF",IRP)) Q:IRP'>0 D
|
|
. S RXDT=+$P($G(^TMP("PS",$J,"REF",IRP,0)),U)
|
|
. I RXDT'<STDT,RXDT<ENDT S SKIP=0,NREF=NREF+1 Q
|
|
. K ^TMP("PS",$J,"REF",IRP)
|
|
;--- Partials
|
|
S IRP=0
|
|
F S IRP=$O(^TMP("PS",$J,"PAR",IRP)) Q:IRP'>0 D
|
|
. S RXDT=+$P($G(^TMP("PS",$J,"PAR",IRP,0)),U)
|
|
. I RXDT'<STDT,RXDT<ENDT S SKIP=0,NPAR=NPAR+1 Q
|
|
. K ^TMP("PS",$J,"PAR",IRP)
|
|
;---
|
|
Q SKIP
|
|
;
|
|
;***** PROCESSES THE LIST OF PRESELECTED PHARMACY ORDERS
|
|
;
|
|
; PTIEN IEN of the patient (DFN)
|
|
;
|
|
; RORFLAGS Flags to control processing
|
|
;
|
|
; ROR8LST Closed root of the list of preselected orders
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 No orders have been found
|
|
; >0 Number of orders
|
|
;
|
|
PROCESS(PTIEN,RORFLAGS,ROR8LST) ;
|
|
N DRUGIEN,IRX,IVM,LOADEXT,ORDDATE,ORDER,ORDIEN,ORDFLG,RC,ROR8SET,RORLST,RORTMP,RORTS,RORXCNT,TMP
|
|
S LOADEXT=(RORFLAGS["E")
|
|
S (RC,RORXCNT)=0
|
|
S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
|
;
|
|
;=== Determine the storage method (default or callback)
|
|
I $G(ROR8DST("RORCB"))?2"$"1.8UN1"^"1.8UN D
|
|
. S ROR8SET="S RC="_ROR8DST("RORCB")_"(.ROR8DST,ORDER"
|
|
. S ROR8SET=ROR8SET_",ORDFLG,DRUGIEN_U_DRUGNAME,ORDDATE)"
|
|
. ;---
|
|
. S ROR8DST("RORDFN")=PTIEN
|
|
. S ROR8DST("ROREDT")=ROREDT
|
|
. S ROR8DST("RORFLAGS")=RORFLAGS
|
|
. S ROR8DST("RORSDT")=RORSDT
|
|
E S ROR8SET="" K @ROR8DST
|
|
;
|
|
;=== Process the list of preselected orders
|
|
S (IRX,RC)=0
|
|
F S IRX=$O(@ROR8LST@(IRX)) Q:'IRX D Q:RC
|
|
. S ORDFLG=$P(@ROR8LST@(IRX),U)
|
|
. S TMP=@ROR8LST@(IRX,0)
|
|
. S ORDER=$P(TMP,U),ORDDATE=$P(TMP,U,15)
|
|
. ;--- Get the order details
|
|
. K ^TMP("PS",$J)
|
|
. D OEL^PSOORRL(PTIEN,ORDER)
|
|
. Q:$D(^TMP("PS",$J))<10
|
|
. ;=== Inpatient and Outpatient Medications
|
|
. I ORDFLG'["V" D Q
|
|
. . ;--- Double-check the dates for outpatient orders
|
|
. . I ORDFLG["O" Q:$$DTCHECK(RORSDT,ROREDT)
|
|
. . ;--- Get the drug IEN in the DRUG file (#50)
|
|
. . S TMP=$G(^TMP("PS",$J,"DD",1,0)),DRUGIEN=+$P(TMP,U,3)
|
|
. . I DRUGIEN'>0 S DRUGIEN=+$P(TMP,U) Q:DRUGIEN'>0
|
|
. . ;--- Process the order
|
|
. . S RC=$$PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE)
|
|
. . S:'RC RORXCNT=RORXCNT+1
|
|
. . S:RC=1 RC=0
|
|
. ;=== IV Medications
|
|
. S RORLST=$$ALLOC^RORTMP(.TMP),ORDIEN=+ORDER
|
|
. D
|
|
. . N IEN,ORDER ; Workaround for the bug in the API
|
|
. . D PSS436^PSS55(PTIEN,ORDIEN,TMP)
|
|
. I $G(@RORLST@(0))'>0 D FREE^RORTMP(RORLST) Q
|
|
. ;--- Process the additives
|
|
. S IVM=0
|
|
. F S IVM=$O(@RORLST@(ORDIEN,"ADD",IVM)) Q:IVM'>0 D Q:RC
|
|
. . ;--- IEN in the IV ADDITIVES file (#52.6)
|
|
. . S DRUGIEN=+$P($G(@RORLST@(ORDIEN,"ADD",IVM,.01)),U)
|
|
. . Q:DRUGIEN'>0
|
|
. . ;--- IEN in the DRUG file (#50)
|
|
. . D ZERO^PSS52P6(DRUGIEN,,,RORTS)
|
|
. . Q:$G(@RORTMP@(0))'>0
|
|
. . S DRUGIEN=+$P($G(@RORTMP@(DRUGIEN,1)),U)
|
|
. . Q:DRUGIEN'>0
|
|
. . ;--- Process the medication
|
|
. . S RC=$$PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE)
|
|
. . S:'RC RORXCNT=RORXCNT+1
|
|
. . S:RC=1 RC=0
|
|
. ;---
|
|
. D FREE^RORTMP(RORLST)
|
|
;
|
|
;===
|
|
D FREE^RORTMP(RORTMP)
|
|
Q $S(RC<0:RC,1:RORXCNT)
|
|
;
|
|
;***** PROCESS THE MEDICATION (internal)
|
|
;
|
|
; DRUGIEN IEN of the medication in the DRUG file (#50)
|
|
;
|
|
; The ROR8DST, ROR8RXS, ROR8SET, RORTMP, and RORTS variables
|
|
; must be defined before calling this function.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; 1 Skip this medication
|
|
; 2 Skip this and all remaining medications
|
|
;
|
|
PROCMED(ORDER,ORDFLG,DRUGIEN,ORDDATE) ;
|
|
N DRUGNAME,RC,ROR8BUF,SKIP,TMP
|
|
S RC=0
|
|
;=== Load some drug data
|
|
D ARWS^PSS50(DRUGIEN,,RORTS) K ROR8BUF
|
|
F TMP=2,20,25 S ROR8BUF(TMP)=$G(@RORTMP@(DRUGIEN,TMP))
|
|
S DRUGNAME=$G(@RORTMP@(DRUGIEN,.01))
|
|
S:DRUGNAME="" DRUGNAME="Unknown (IEN="_DRUGIEN_")"
|
|
K @RORTMP
|
|
;--- Generic Drug
|
|
S ROR8DST("RORXGEN")=ROR8BUF(20)
|
|
I $P(ROR8BUF(20),U,2)="" D S $P(ROR8DST("RORXGEN"),U,2)=TMP
|
|
. S TMP="Unknown ("_(+ROR8BUF(20))_")"
|
|
;--- VA Drug Class
|
|
S ROR8DST("RORXVCL")=""
|
|
D:ROR8BUF(2)'=""
|
|
. ;--- If the "national" drug class is the same, use its IEN
|
|
. I $P(ROR8BUF(25),U,2)=ROR8BUF(2) D Q
|
|
. . S ROR8DST("RORXVCL")=$P(ROR8BUF(25),U,1,2)
|
|
. ;--- Get the Drug Class IEN
|
|
. D IEN^PSN50P65(,ROR8BUF(2),RORTS)
|
|
. S TMP=+$G(@RORTMP@(0))
|
|
. S:TMP=1 ROR8DST("RORXVCL")=+$O(@RORTMP@(0))_U_ROR8BUF(2)
|
|
. K @RORTMP
|
|
;
|
|
;=== Check if the drug should be skipped
|
|
I ROR8RXS'="*" S SKIP=0 D Q:SKIP 1
|
|
. Q:$D(@ROR8RXS@(DRUGIEN))
|
|
. I $D(@ROR8RXS@("C"))>1 Q:$D(@ROR8RXS@("C",+ROR8DST("RORXVCL")))
|
|
. I $D(@ROR8RXS@("G"))>1 Q:$D(@ROR8RXS@("G",+ROR8DST("RORXGEN")))
|
|
. S SKIP=1
|
|
;
|
|
;--- Load additional drug data
|
|
;D:LOADEXT
|
|
;.
|
|
;
|
|
;=== Default output
|
|
I ROR8SET="" D Q 0
|
|
. S RORXCNT=RORXCNT+1
|
|
. M @ROR8DST@(RORXCNT)=^TMP("PS",$J)
|
|
. S TMP=ORDER_U_ORDFLG_U_ROR8DST("RORXGEN")
|
|
. S $P(TMP,U,5,6)=ROR8DST("RORXVCL")
|
|
. S @ROR8DST@(RORXCNT)=TMP
|
|
;=== Callback function
|
|
X ROR8SET ; (.ROR8DST,ORDER,ORDFLG,DRUGIEN_U_DRUGNAME,ORDDATE)
|
|
Q RC
|
|
;
|
|
;***** LOADS AND PRESELECTS PHARMACY ORDERS
|
|
;
|
|
; PTIEN IEN of the patient (DFN)
|
|
;
|
|
; FLAGS Flags to control processing
|
|
;
|
|
; STDT Start date (FileMan)
|
|
; ENDT End date (FileMan)
|
|
;
|
|
; ROR8LST Closed root for the list of preselected orders
|
|
;
|
|
; @ROR8LST@(
|
|
; Seq#, Flags that describe the order (I,O,P, etc.)
|
|
; 0) Content of the ^TMP("PS",$J,i,0) node
|
|
; returned by the OCL^PSOORRL (see the DBIA
|
|
; #2400 for details).
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 No orders have been found
|
|
; >0 Number of orders
|
|
;
|
|
QUERY(PTIEN,FLAGS,STDT,ENDT,ROR8LST) ;
|
|
N IEN,IRX,ORDER,RXCNT,TMP,TYPE
|
|
K ^TMP("PS",$J),@ROR8LST
|
|
;
|
|
;--- Prepare the flags
|
|
I FLAGS["I" D S TYPE("U;I")="I"
|
|
. S:FLAGS["P" TYPE("P;I")="IP"
|
|
. S:FLAGS["V" TYPE("V;I")="IV"
|
|
I FLAGS["O" D S TYPE("R;O")="O"
|
|
. S:FLAGS["P" TYPE("P;O")="OP"
|
|
;
|
|
;--- Load the list of pharmacy orders
|
|
D OCL^PSOORRL(PTIEN,STDT,ENDT)
|
|
Q:$D(^TMP("PS",$J))<10 0
|
|
;
|
|
;--- Preselect the orders
|
|
S (IRX,RXCNT)=0
|
|
F S IRX=$O(^TMP("PS",$J,IRX)) Q:'IRX D
|
|
. S ORDER=$P($G(^TMP("PS",$J,IRX,0)),U) Q:ORDER'>0
|
|
. ;--- Check the type of order
|
|
. S TMP=$L(ORDER),TYPE=$E(ORDER,TMP-2,TMP)
|
|
. S TYPE=$G(TYPE(TYPE)) Q:TYPE=""
|
|
. ;--- Double-check the dates
|
|
. I TYPE["I" D Q:(TMP<STDT)!(TMP'<ENDT)
|
|
. . S TMP=+$P($G(^TMP("PS",$J,IRX,0)),U,15)
|
|
. I TYPE["O" D Q:TMP<STDT
|
|
. . S TMP=+$P($G(^TMP("PS",$J,IRX,0)),U,10)
|
|
. ;--- Select the order
|
|
. S RXCNT=RXCNT+1,@ROR8LST@(RXCNT)=TYPE
|
|
. S @ROR8LST@(RXCNT,0)=^TMP("PS",$J,IRX,0)
|
|
;
|
|
;--- Cleanup
|
|
K ^TMP("PS",$J)
|
|
Q RXCNT
|