PSJOCDS ;BIR/MV - SET INPUT DATA FOR DOSING ORDER CHECKS ;6 Jun 07 / 3:37 PM
;;5.0;INPATIENT MEDICATIONS;**181,252,257,256,358**;16 DEC 97;Build 10
;
; Reference to ^PS(55 is supported by DBIA #2191.
; Reference to ^PS(51.1 is supported by DBIA #2177.
; Reference to ^PSSORPH is supported by DBIA #3234.
; Reference to ^PSSDSAPI is supported by DBIA #5425.
; Reference to ^PSSDSAPD is supported by DBIA #5426.
; Reference to FULL^VALM1 and PAUSE^VALM1 is supported by DBIA #10116.
;
;The Dose API will be processed separately than the DD & DT order checks
;
IN(PSJPON,PSJTYPE,PSJDD) ;
;PSJPON - Order number
;PSJPTYPE - UD/IV
;PSJDD - Dispense drug IEN (for UD order only)
;
;PSJOVR array is defined when OVERLAP^PSGOEF2 is called.
;
NEW PSJDSOFF,PSJCNT
D FULL^VALM1
S PSJDSOFF=$$DS^PSSDSAPI()
I '+PSJDSOFF D DOSEOFF^PSJOCDSD($P(PSJDSOFF,U,2)) Q
NEW PSJOCDS,PSJFDB,PSJBASE,PSJOVR,PSJOVRLP,PSJX
K PSJOCDS,PSJFDB
;I '$$PING^PSJOC("Maximum Single Dose Check could not be performed") Q
I '$$PING^PSJOC("Dosing Checks could not be performed.") Q
K ^TMP($J,"PSJPRE"),^TMP($J,"PSJPRE1")
S PSJBASE(1)="PSJPRE",PSJBASE(3)="PSJPRE1"
;
;;**** Commented out complex dosing
;;PSJOCDSC("CX","PSJCOM") is to flag if dosing checks needs to handle complex orders.
;;*I '$D(PSJOCDSC("CX","PSJCOM")) D
;;*. I $G(PSJCOM),$$CONJ^PSJOCDSC() S PSJOCDSC("CX","PSJCOM")=1
;;*I $G(PSJOCDSC("CX","PSJCOM")),'$D(PSJOCDSC("CX","ACX")) D SETLST^PSJOCDSC(PSJPON)
;;*I PSJTYPE="UD" D UD I $G(PSJOCDSC("CX","PSJCOM")) D COMPLEX^PSJOCDSC Q
;;*I PSJTYPE="IV" D IN^PSIVOCDS("PSJPRE") D:$G(PSJOCDSC("CX","PSJCOM")) IV^PSJOCDSC(PSJPON),UPDLST^PSJOCDSC(PSJPON,2)
;;**** End Complex dosing
;
;;****To be removed when complex dosing is ready
I PSJTYPE="UD" D UD
I PSJTYPE="IV" D IN^PSIVOCDS("PSJPRE")
;;****END
;
I '$D(PSJFDB) Q
;;*If complex order then set conjunction to "Then" so low dose warning is screened out.
;;*I $G(PSJCOM),$$ALLTHEN^PSJOCDSC() D
;;*. F PSJX=0:0 S PSJX=$O(PSJOCDS(PSJX)) Q:'PSJX S PSJOCDS(PSJX,"CONJ")="T"
D DOSE^PSSDSAPD(.PSJBASE,DFN,.PSJOCDS,.PSJFDB)
D DISPLAY^PSJOCDSD
;I '$G(PSGORQF),(PSJTYPE="IV"),$G(PSJOCDSC("CX","PSJCOM")) D NODAILY^PSJOCDSP(PSJPON)
K ^TMP($J,"PSJPRE"),^TMP($J,"PSJPRE1")
Q
UD ;Process data from a UD order
NEW PSJDS,PSJFREQ,X
;At this state a dispense drug should be selected already. But just incase...
Q:'+PSJDD
K PSJOCDS,PSJFDB
;If the drug is to be exempted then exclude it from the dose check
Q:$$EXMT^PSSDSAPI(PSJDD)
S PSJCNT=1
S PSJDS=""
;
S PSJOCDS("CONTEXT")="IP-UD"
S X=$$DOSE()
S PSJOCDS(PSJCNT,"DRG_AMT")=$P(X,U)
S PSJOCDS(PSJCNT,"DRG_UNIT")=$P(X,U,2)
S PSJOCDS(PSJCNT,"DO")=$P(X,U,3)
;
S X=$$DATES(PSJPON)
S X=$$DURATION($P(X,U),$P(X,U,2))
;S X=$$DURATION($G(PSGSD),$G(PSGFD))
S PSJOCDS(PSJCNT,"DRATE")=$S(+X:X_"M",1:"")
;S PSJOCDS(PSJCNT,"DUR")=X
;S PSJOCDS(PSJCNT,"DUR_RT")=$S(+X:"MINUTE",1:"")
S PSJOCDS(PSJCNT,"MR_IEN")=$G(PSGMR)
S PSJOCDS(PSJCNT,"SCHEDULE")=$G(PSGSCH)
D FDBDATA
;D LITER
Q
FDBDATA ;Set data needed by FDB's Dose API
;Use the OI + Dosage form when display drug name. If OI IEN doesn't exist, use DD name
NEW PSJOINM,PSJXSCH,X,PSJSFFG
S PSJFDB(PSJCNT,"RX_NUM")="I;"_PSJPON_";PROSPECTIVE;"_PSJCNT
S PSJFDB(PSJCNT,"DRUG_IEN")=PSJDD
S PSJOINM="",PSJSFFG=0
; ^PS(53.45 nodes are not set for speed renew at this point.
I +$G(PSJSPEED),($G(PSGOEE)="R"),(PSJPON["P") S PSJOINM=$$OINM(PSJPON),PSJSFFG=1
I 'PSJSFFG S PSJOINM=$$DRGNM^PSGSICHK()
S PSJFDB(PSJCNT,"DRUG_NM")=$S(PSJOINM]"":PSJOINM,1:$$DN^PSJMISC(+PSJDD))
I PSJOCDS(PSJCNT,"DO")=(PSJOCDS(PSJCNT,"DRG_AMT")_PSJOCDS(PSJCNT,"DRG_UNIT")) D
. Q:PSJOCDS(PSJCNT,"DO")=""
.;Strip off leading zero otherwise FDB triggers an "Invalid or Undefined Dose"
. S X=PSJOCDS(PSJCNT,"DRG_AMT")
. S PSJFDB(PSJCNT,"DOSE_AMT")=$S(+X=0:X,1:+X)
. S PSJFDB(PSJCNT,"DOSE_UNIT")=$$UNIT^PSSDSAPI(PSJOCDS(PSJCNT,"DRG_UNIT"))
S PSJFDB(PSJCNT,"DOSE_RATE")="DAY"
;
S X="",PSJXSCH=PSGSCH
I $G(PSGS0XT)="" S PSGS0XT=$$DOW^PSJAPIDS(PSGSCH)
;"I $G(PSGS0XT)="D,$G(PSGS0Y)]"" S $P(PSJXSCH,"@",2)=$G(PSGS0Y)
I $G(PSGS0XT)="D" S PSJXSCH=$$DOWCHK(PSJXSCH,$G(PSGS0Y))
I $G(PSGSCH)]"" S X=$P($$FRQ^PSSDSAPI(PSJXSCH,$G(PSGS0XT),"I",,PSJDD),U)
I X="" S X=1 S PSJFDB(PSJCNT,"FRQ_ERROR")=""
S PSJFDB(PSJCNT,"FREQ")=X
S PSJFDB(PSJCNT,"DURATION")=1
S PSJFDB(PSJCNT,"DURATION_RT")="DAY"
S PSJFDB(PSJCNT,"ROUTE")=$P($$MRT^PSSDSAPI($G(PSGMR)),U,2)
S PSJFDB(PSJCNT,"DOSE_TYPE")="MAINTENANCE"
S PSJFDB(PSJCNT,"SPECIFIC")=1
;Set data for onetime or <24 hours order
;PSJ*5*358
S PSJXSCH=$G(PSJXSCH)
I ($G(PSGSCH)[" PRN"),'$D(^PS(51.1,"APPSJ",PSGSCH)) S PSJXSCH=$P(PSGSCH," PRN",1)
S X=$$ONE^PSJORPOE($G(PSJXSCH))
I +X!($G(PSGST)="O")!+$$ONCALL^PSJMISC($G(PSJXSCH),$G(PSGST)) D Q
. K PSJFDB(PSJCNT,"FRQ_ERROR")
. S PSJFDB(PSJCNT,"DOSE_TYPE")="SINGLE DOSE"
. S PSJFDB(PSJCNT,"DURATION")=1
. S PSJFDB(PSJCNT,"DURATION_RT")=PSJFDB(PSJCNT,"DURATION_RT")
. S PSJFDB(PSJCNT,"FREQ")=1
I +PSJOCDS(PSJCNT,"DRATE") D UND24HRS(+PSJOCDS(PSJCNT,"DRATE"),$G(PSGAT),$G(PSGS0XT),PSGSD,PSGFD,PSGSCH)
Q
DOWCHK(PSJSCHD,PSJADM) ;Append the admin times to the schedule if it's not defined in 51.1
;Assuming the shedule is day of the week
;PSJSCHD - the schedule from the order
;PSJADM - the admin times from the order
;Output - the schedule name (as entered or appended to the schedule)
I $G(PSJSCHD)="" Q ""
I $D(^PS(51.1,"B",PSJSCHD)) Q PSJSCHD
I $G(PSJADM)]"" S $P(PSJSCHD,"@",2)=PSJADM Q PSJSCHD
Q PSJSCHD
LITER ;FDB requires "L" instead of ML for the particular conditions below
;PSJ*5*252 (6/29/11)- This module is longer called since FDB handles either "ML" or "L" now.
NEW PSJXDO
Q:'$G(PSJDD)
Q:$G(PSJFDB(1,"ROUTE"))'="INTRAVENOUS"
Q:$G(PSGST)'="R"
Q:$$VAGEN^PSJMISC(PSJDD)'["POTASSIUM"
Q:$$CLASS^PSJMISC(PSJDD)'="TN102"
S PSJXDO=PSJOCDS(PSJCNT,"DO")
I PSJXDO["ML" D
. Q:'+PSJXDO
. S (PSJOCDS(PSJCNT,"DRG_AMT"),PSJFDB(PSJCNT,"DOSE_AMT"))=+(+PSJXDO/1000)
. S (PSJOCDS(1,"DRG_UNIT"),PSJFDB(PSJCNT,"DOSE_UNIT"))="L"
Q
UND24HRS(PSJDUR,PSGAT,PSGS0XT,PSGSD,PSGFD,PSGSCH) ;
;*** This line tag is called by ^PSIVOCDS also ***
;PSJDUR - order duration in minutes
;PSGAT - admin times
;PSGS0XT - Order Frequency
NEW PSJNDOSE,PSJFRQ1,PSJFRQX,PSJX
Q:'+$G(PSJDUR)
; Set frequency to # of amdin times
I ($G(PSGAT)]"") D Q
. S PSJX=$$DATES(PSJPON)
. S PSJNDOSE=$$CNTDOSE($P(PSJX,U),$P(PSJX,U,2))
. I PSJNDOSE S PSJFDB(PSJCNT,"FREQ")=PSJNDOSE Q
; Set frequency based on frequency(51.1)
; NUMB^PSSDSAPI is removed for MOCHA 2.1. Need to make sure PSJFRQ1 is in numeric value
;;S PSJFRQ2=$P($$FRQ^PSSDSAPI($G(PSGSCH),$G(PSGS0XT),"I",PSJDUR_"M",PSJDD),U)
S PSJFRQ1=$P($$FRQ^PSSDSAPI($G(PSGSCH),$G(PSGS0XT),"I",PSJDUR_"M",PSJDD),U)
;;I PSJFRQ2?1"Q"1N.N1"H" S PSJFRQ2=1440/(+$E(PSJFRQ2,2,$L(PSJFRQ2))*60)
;;I PSJFRQ2?1"X"1N.N1"D" S PSJFRQ2=+$E(PSJFRQ2,2,$L(PSJFRQ2))
;;I +PSJFRQ2 S PSJFRQ1=(PSJFRQ2/24)*(+PSJDUR/60)
; If no value returned from FRQ^PSSDSAPI and frequency is there then set freq = duration in min / freq in min
I '+$G(PSJFRQ1),+$G(PSGS0XT) S PSJFRQ1=(+PSJDUR)/PSGS0XT
; Calculate freq from number of dose admin per day (round up)
S PSJFDB(PSJCNT,"FREQ")=$S(PSJFRQ1?.N:PSJFRQ1,1:$J((+$G(PSJFRQ1)+.5),0,0))
I PSJFDB(PSJCNT,"FREQ")'=0 Q
; If no admin times or frequency(51.1) set error
S PSJFDB(PSJCNT,"FREQ")=1
S PSJFDB(PSJCNT,"FRQ_ERROR")=""
Q
CNTDOSE(PSGSD,PSGFD) ;Count # of admins to set the Freq to
;only do this if the start & stop dates are within 24 hours.
NEW PSJX,PSJADMIN,PSJCNT,PSJSTRTM,PSJSTPTM,PSJDTFLG
I $G(PSGAT)="" Q 0
I $G(PSGSD)="" Q 0
I $G(PSGFD)="" Q 0
I ($$FMDIFF^XLFDT(PSGFD,PSGSD,2)/60)>1440 Q 0
S PSJCNT=0
S PSJSTRTM=$E($P(PSGSD,".",2)_"0000",1,4)
S PSJSTPTM=$E($P(PSGFD,".",2)_"0000",1,4)
S PSJDTFLG=0
I $P(PSGSD,".")=$P(PSGFD,".") S PSJDTFLG=1
F PSJX=1:1 S PSJADMIN=$P(PSGAT,"-",PSJX) Q:PSJADMIN="" D
. S PSJADMIN=$E($P(PSGAT,"-",PSJX)_"0000",1,4)
. I PSJDTFLG D Q
.. I (PSJSTRTM'>PSJADMIN),(PSJADMIN<PSJSTPTM) S PSJCNT=PSJCNT+1
. I (PSJSTRTM'>PSJADMIN) S PSJCNT=PSJCNT+1
. I (PSJSTPTM>PSJADMIN) S PSJCNT=PSJCNT+1
Q PSJCNT
DURATION(PSGSD,PSGFD) ;Figure out the duration from the start, stop dates
;Return the diff between Stop - Start date in minutes. If > 1 day then return null
NEW PSJDIFF
I '$D(PSGFD)!'$D(PSGSD) Q ""
S PSJDIFF=$$FMDIFF^XLFDT(PSGFD,PSGSD,2)/60
I (PSJDIFF<1440) Q PSJDIFF
Q ""
DOSE() ;Figure out the dose, unit, & dosage Ordered
;Return 3 pieces: Numeric Dose ^ Unit ^ Dosage Ordered
NEW PSJDS,PSJND0,PSJND2,X,PSJX,PSJXDOX,PSJNDS,PSJALLGY
S PSJDS=""
;Subsequence orders in the Complex order has the PSGDO from the first order. Get new PSGDO
I $G(PSJPON)["U",$S($G(PSJCOM):1,$G(PSGRENEW):1,1:0) S PSGDO=$P($G(^PS(55,DFN,5,+PSJPON,.2)),U,2)
;If the dose & unit exist use them
I +$G(PSJDOSE("DO"))_$P($G(PSJDOSE("DO")),U,2)=$G(PSGDO) Q PSJDOSE("DO")_U_$G(PSGDO)
;Get dd, dose, unit from the order
I $G(PSGORD)]"",'+$G(PSJDD) D
. I PSGORD["P" S PSJND2=$G(^PS(53.1,+PSGORD,.2)),PSJDD=$O(^PS(53.1,+PSGORD,1,"B",0))
. I PSGORD["U" S PSJND2=$G(^PS(55,DFN,5,+PSGORD,.2)),PSJDD=$O(^PS(55,+DFN,5,+PSGORD,1,"B",0))
;If no numeric dose and there is a dosage ordered then get dose & unit from the order
I $D(PSGORD),$G(PSGDO)]"" D
. S PSJDS=$P($G(PSJND2),U,5,6)
Q:+PSJDS PSJDS_U_$G(PSGDO)
;Get dispense unit per dose and figure out numeric and unit
I +$G(PSJDD),($G(PSGDO)]"") D
. S PSJDS=$$DOSE1()
. I $P($G(PSJXDOX(1)),U,11)=$$UP^XLFSTR(PSGDO) Q:+PSJDS
. S PSJDS=""
. S PSJX=$G(PSJXDOX(1))
. I +PSJX S X=+PSGDO/+PSJX S PSJDS=$$DOSE1(X)
. I $P($G(PSJXDOX(1)),U,11)=$$UP^XLFSTR(PSGDO) Q:+PSJDS
. S PSJDS=""
Q:+PSJDS PSJDS
I +$G(PSJDD),($G(PSGDO)=""),($G(PSGORD)="") D
. S PSJDS=$$DOSE1($S(+$G(PSGUD):PSGUD,1:1))
Q:+PSJDS PSJDS
;Figure out dose & unit from the dispense drug. Dosage Ordered is required for multiple dispense drugs
I $G(PSGDO)="" D
. S PSJND0=$$DD53P45^PSJMISC()
. I PSJND0="" S PSJND0=$G(PSGDRG)
. S X=+$P(PSJND0,U,2) S PSJDS=$$DOSE1($S(X:X,1:1))
Q:+PSJDS PSJDS
Q "^^"_$G(PSGDO)
DOSE1(PSJDUP) ;
;PSJDUP - Dispense unit per dose
NEW PSJDS
Q:'+$G(PSJDD)
K PSJXDOX
S PSJDS=""
D DOSE^PSSORPH(.PSJXDOX,+PSJDD,"U",,$G(PSJDUP))
S:$G(PSJXDOX(1)) PSJDS=$P(PSJXDOX(1),U,1,2)_U_$P(PSJXDOX(1),U)_$P(PSJXDOX(1),U,2)
Q PSJDS
DATES(PSJPON) ;Check the correct Start, Stop dates to use
;PSJOCDSC("CX",PSGsd/PSGfd,on)=default PSGsd/PSGfd date _^_ PSGsd/PSGfd _^_PSJFLG
;PSJP1 = Start date; PSJP2 = Stop date; PSJFLG = 1 if start or stop date has changed.
;For some reasons, PSGSD redefined to cal start date for Complex order (one with duration),
; PSGFD redefined to cal stop date. These 2 fields reflect the default start, stop dates if they
; were edited.
;
NEW PSJXSD,PSJXFD,PSJP1,PSJP2,PSJFLG,X
I '+$G(PSJPON) Q $G(PSGSD)_U_$G(PSGFD)_U_0
S PSJFLG=0
S PSJP1=$G(PSGSD),PSJP2=$G(PSGFD)
I $D(PSJOCDSC("CX","PSGSD")) D
. S PSJXSD=$G(PSJOCDSC("CX","PSGSD",+PSJPON))
. S PSJXFD=$G(PSJOCDSC("CX","PSGFD",+PSJPON))
. I PSGSD=$P(PSJXSD,U,2) S PSJP1=$P(PSJXSD,U)
.;
. I $P(PSJXFD,U,2)]"",(PSGFD=$P(PSJXFD,U,2)) S PSJP2=$P(PSJXFD,U)
. I $P(PSJXFD,U,2)="" S $P(PSJXFD,U,2)=PSGFD,PSJP2=PSGFD
.;
.; I $P(PSJXFD,U,2)="" S $P(PSJXFD,U,2)=PSGFD
.; I PSGFD=$P(PSJXFD,U,2) S PSJP2=$P(PSJXFD,U)
. I (PSJXSD]"")!(PSJXFD]"") D
.. I $S($G(PSGSD)'=$P(PSJXSD,U,2):1,$G(PSGFD)'=$P(PSJXFD,U,2):1,1:0) S PSJFLG=1
. S X=$G(^PS(53.1,+PSJPON,2.5))
. ;Reset PSJP1 & PSJP2 from the order is needed when complex order defaulted to IV but FN as UD,
. ; the calc Start/stop dates were used therefore the duration was not considered.
. I (PSJPON["P"),(PSJFLG=0),($P(X,U,2)]"") S PSJP1=$P(X,U,1),PSJP2=$P(X,U,3)
Q PSJP1_U_PSJP2_U_PSJFLG
OINM(PSJPON) ;For speed renew, returns OI name if order has multiple DD else returns null
NEW PSJCNT,PSJDD,PSJOINM,PSJOI
I $G(PSJPON)'["P" Q
S PSJCNT=0
F PSJDD=0:0 S PSJDD=$O(^PS(53.1,+PSJPON,1,PSJDD)) Q:'PSJDD S PSJCNT=PSJCNT+1
I PSJCNT>1 S PSJOI=+$G(^PS(53.1,+PSJPON,.2)) S PSJOINM=$$OIDF^PSJLMUT1(+PSJOI)
Q $G(PSJOINM)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOCDS 12231 printed Dec 13, 2024@02:08:01 Page 2
PSJOCDS ;BIR/MV - SET INPUT DATA FOR DOSING ORDER CHECKS ;6 Jun 07 / 3:37 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**181,252,257,256,358**;16 DEC 97;Build 10
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA #2191.
+4 ; Reference to ^PS(51.1 is supported by DBIA #2177.
+5 ; Reference to ^PSSORPH is supported by DBIA #3234.
+6 ; Reference to ^PSSDSAPI is supported by DBIA #5425.
+7 ; Reference to ^PSSDSAPD is supported by DBIA #5426.
+8 ; Reference to FULL^VALM1 and PAUSE^VALM1 is supported by DBIA #10116.
+9 ;
+10 ;The Dose API will be processed separately than the DD & DT order checks
+11 ;
IN(PSJPON,PSJTYPE,PSJDD) ;
+1 ;PSJPON - Order number
+2 ;PSJPTYPE - UD/IV
+3 ;PSJDD - Dispense drug IEN (for UD order only)
+4 ;
+5 ;PSJOVR array is defined when OVERLAP^PSGOEF2 is called.
+6 ;
+7 NEW PSJDSOFF,PSJCNT
+8 DO FULL^VALM1
+9 SET PSJDSOFF=$$DS^PSSDSAPI()
+10 IF '+PSJDSOFF
DO DOSEOFF^PSJOCDSD($PIECE(PSJDSOFF,U,2))
QUIT
+11 NEW PSJOCDS,PSJFDB,PSJBASE,PSJOVR,PSJOVRLP,PSJX
+12 KILL PSJOCDS,PSJFDB
+13 ;I '$$PING^PSJOC("Maximum Single Dose Check could not be performed") Q
+14 IF '$$PING^PSJOC("Dosing Checks could not be performed.")
QUIT
+15 KILL ^TMP($JOB,"PSJPRE"),^TMP($JOB,"PSJPRE1")
+16 SET PSJBASE(1)="PSJPRE"
SET PSJBASE(3)="PSJPRE1"
+17 ;
+18 ;;**** Commented out complex dosing
+19 ;;PSJOCDSC("CX","PSJCOM") is to flag if dosing checks needs to handle complex orders.
+20 ;;*I '$D(PSJOCDSC("CX","PSJCOM")) D
+21 ;;*. I $G(PSJCOM),$$CONJ^PSJOCDSC() S PSJOCDSC("CX","PSJCOM")=1
+22 ;;*I $G(PSJOCDSC("CX","PSJCOM")),'$D(PSJOCDSC("CX","ACX")) D SETLST^PSJOCDSC(PSJPON)
+23 ;;*I PSJTYPE="UD" D UD I $G(PSJOCDSC("CX","PSJCOM")) D COMPLEX^PSJOCDSC Q
+24 ;;*I PSJTYPE="IV" D IN^PSIVOCDS("PSJPRE") D:$G(PSJOCDSC("CX","PSJCOM")) IV^PSJOCDSC(PSJPON),UPDLST^PSJOCDSC(PSJPON,2)
+25 ;;**** End Complex dosing
+26 ;
+27 ;;****To be removed when complex dosing is ready
+28 IF PSJTYPE="UD"
DO UD
+29 IF PSJTYPE="IV"
DO IN^PSIVOCDS("PSJPRE")
+30 ;;****END
+31 ;
+32 IF '$DATA(PSJFDB)
QUIT
+33 ;;*If complex order then set conjunction to "Then" so low dose warning is screened out.
+34 ;;*I $G(PSJCOM),$$ALLTHEN^PSJOCDSC() D
+35 ;;*. F PSJX=0:0 S PSJX=$O(PSJOCDS(PSJX)) Q:'PSJX S PSJOCDS(PSJX,"CONJ")="T"
+36 DO DOSE^PSSDSAPD(.PSJBASE,DFN,.PSJOCDS,.PSJFDB)
+37 DO DISPLAY^PSJOCDSD
+38 ;I '$G(PSGORQF),(PSJTYPE="IV"),$G(PSJOCDSC("CX","PSJCOM")) D NODAILY^PSJOCDSP(PSJPON)
+39 KILL ^TMP($JOB,"PSJPRE"),^TMP($JOB,"PSJPRE1")
+40 QUIT
UD ;Process data from a UD order
+1 NEW PSJDS,PSJFREQ,X
+2 ;At this state a dispense drug should be selected already. But just incase...
+3 if '+PSJDD
QUIT
+4 KILL PSJOCDS,PSJFDB
+5 ;If the drug is to be exempted then exclude it from the dose check
+6 if $$EXMT^PSSDSAPI(PSJDD)
QUIT
+7 SET PSJCNT=1
+8 SET PSJDS=""
+9 ;
+10 SET PSJOCDS("CONTEXT")="IP-UD"
+11 SET X=$$DOSE()
+12 SET PSJOCDS(PSJCNT,"DRG_AMT")=$PIECE(X,U)
+13 SET PSJOCDS(PSJCNT,"DRG_UNIT")=$PIECE(X,U,2)
+14 SET PSJOCDS(PSJCNT,"DO")=$PIECE(X,U,3)
+15 ;
+16 SET X=$$DATES(PSJPON)
+17 SET X=$$DURATION($PIECE(X,U),$PIECE(X,U,2))
+18 ;S X=$$DURATION($G(PSGSD),$G(PSGFD))
+19 SET PSJOCDS(PSJCNT,"DRATE")=$SELECT(+X:X_"M",1:"")
+20 ;S PSJOCDS(PSJCNT,"DUR")=X
+21 ;S PSJOCDS(PSJCNT,"DUR_RT")=$S(+X:"MINUTE",1:"")
+22 SET PSJOCDS(PSJCNT,"MR_IEN")=$GET(PSGMR)
+23 SET PSJOCDS(PSJCNT,"SCHEDULE")=$GET(PSGSCH)
+24 DO FDBDATA
+25 ;D LITER
+26 QUIT
FDBDATA ;Set data needed by FDB's Dose API
+1 ;Use the OI + Dosage form when display drug name. If OI IEN doesn't exist, use DD name
+2 NEW PSJOINM,PSJXSCH,X,PSJSFFG
+3 SET PSJFDB(PSJCNT,"RX_NUM")="I;"_PSJPON_";PROSPECTIVE;"_PSJCNT
+4 SET PSJFDB(PSJCNT,"DRUG_IEN")=PSJDD
+5 SET PSJOINM=""
SET PSJSFFG=0
+6 ; ^PS(53.45 nodes are not set for speed renew at this point.
+7 IF +$GET(PSJSPEED)
IF ($GET(PSGOEE)="R")
IF (PSJPON["P")
SET PSJOINM=$$OINM(PSJPON)
SET PSJSFFG=1
+8 IF 'PSJSFFG
SET PSJOINM=$$DRGNM^PSGSICHK()
+9 SET PSJFDB(PSJCNT,"DRUG_NM")=$SELECT(PSJOINM]"":PSJOINM,1:$$DN^PSJMISC(+PSJDD))
+10 IF PSJOCDS(PSJCNT,"DO")=(PSJOCDS(PSJCNT,"DRG_AMT")_PSJOCDS(PSJCNT,"DRG_UNIT"))
Begin DoDot:1
+11 if PSJOCDS(PSJCNT,"DO")=""
QUIT
+12 ;Strip off leading zero otherwise FDB triggers an "Invalid or Undefined Dose"
+13 SET X=PSJOCDS(PSJCNT,"DRG_AMT")
+14 SET PSJFDB(PSJCNT,"DOSE_AMT")=$SELECT(+X=0:X,1:+X)
+15 SET PSJFDB(PSJCNT,"DOSE_UNIT")=$$UNIT^PSSDSAPI(PSJOCDS(PSJCNT,"DRG_UNIT"))
End DoDot:1
+16 SET PSJFDB(PSJCNT,"DOSE_RATE")="DAY"
+17 ;
+18 SET X=""
SET PSJXSCH=PSGSCH
+19 IF $GET(PSGS0XT)=""
SET PSGS0XT=$$DOW^PSJAPIDS(PSGSCH)
+20 ;"I $G(PSGS0XT)="D,$G(PSGS0Y)]"" S $P(PSJXSCH,"@",2)=$G(PSGS0Y)
+21 IF $GET(PSGS0XT)="D"
SET PSJXSCH=$$DOWCHK(PSJXSCH,$GET(PSGS0Y))
+22 IF $GET(PSGSCH)]""
SET X=$PIECE($$FRQ^PSSDSAPI(PSJXSCH,$GET(PSGS0XT),"I",,PSJDD),U)
+23 IF X=""
SET X=1
SET PSJFDB(PSJCNT,"FRQ_ERROR")=""
+24 SET PSJFDB(PSJCNT,"FREQ")=X
+25 SET PSJFDB(PSJCNT,"DURATION")=1
+26 SET PSJFDB(PSJCNT,"DURATION_RT")="DAY"
+27 SET PSJFDB(PSJCNT,"ROUTE")=$PIECE($$MRT^PSSDSAPI($GET(PSGMR)),U,2)
+28 SET PSJFDB(PSJCNT,"DOSE_TYPE")="MAINTENANCE"
+29 SET PSJFDB(PSJCNT,"SPECIFIC")=1
+30 ;Set data for onetime or <24 hours order
+31 ;PSJ*5*358
+32 SET PSJXSCH=$GET(PSJXSCH)
+33 IF ($GET(PSGSCH)[" PRN")
IF '$DATA(^PS(51.1,"APPSJ",PSGSCH))
SET PSJXSCH=$PIECE(PSGSCH," PRN",1)
+34 SET X=$$ONE^PSJORPOE($GET(PSJXSCH))
+35 IF +X!($GET(PSGST)="O")!+$$ONCALL^PSJMISC($GET(PSJXSCH),$GET(PSGST))
Begin DoDot:1
+36 KILL PSJFDB(PSJCNT,"FRQ_ERROR")
+37 SET PSJFDB(PSJCNT,"DOSE_TYPE")="SINGLE DOSE"
+38 SET PSJFDB(PSJCNT,"DURATION")=1
+39 SET PSJFDB(PSJCNT,"DURATION_RT")=PSJFDB(PSJCNT,"DURATION_RT")
+40 SET PSJFDB(PSJCNT,"FREQ")=1
End DoDot:1
QUIT
+41 IF +PSJOCDS(PSJCNT,"DRATE")
DO UND24HRS(+PSJOCDS(PSJCNT,"DRATE"),$GET(PSGAT),$GET(PSGS0XT),PSGSD,PSGFD,PSGSCH)
+42 QUIT
DOWCHK(PSJSCHD,PSJADM) ;Append the admin times to the schedule if it's not defined in 51.1
+1 ;Assuming the shedule is day of the week
+2 ;PSJSCHD - the schedule from the order
+3 ;PSJADM - the admin times from the order
+4 ;Output - the schedule name (as entered or appended to the schedule)
+5 IF $GET(PSJSCHD)=""
QUIT ""
+6 IF $DATA(^PS(51.1,"B",PSJSCHD))
QUIT PSJSCHD
+7 IF $GET(PSJADM)]""
SET $PIECE(PSJSCHD,"@",2)=PSJADM
QUIT PSJSCHD
+8 QUIT PSJSCHD
LITER ;FDB requires "L" instead of ML for the particular conditions below
+1 ;PSJ*5*252 (6/29/11)- This module is longer called since FDB handles either "ML" or "L" now.
+2 NEW PSJXDO
+3 if '$GET(PSJDD)
QUIT
+4 if $GET(PSJFDB(1,"ROUTE"))'="INTRAVENOUS"
QUIT
+5 if $GET(PSGST)'="R"
QUIT
+6 if $$VAGEN^PSJMISC(PSJDD)'["POTASSIUM"
QUIT
+7 if $$CLASS^PSJMISC(PSJDD)'="TN102"
QUIT
+8 SET PSJXDO=PSJOCDS(PSJCNT,"DO")
+9 IF PSJXDO["ML"
Begin DoDot:1
+10 if '+PSJXDO
QUIT
+11 SET (PSJOCDS(PSJCNT,"DRG_AMT"),PSJFDB(PSJCNT,"DOSE_AMT"))=+(+PSJXDO/1000)
+12 SET (PSJOCDS(1,"DRG_UNIT"),PSJFDB(PSJCNT,"DOSE_UNIT"))="L"
End DoDot:1
+13 QUIT
UND24HRS(PSJDUR,PSGAT,PSGS0XT,PSGSD,PSGFD,PSGSCH) ;
+1 ;*** This line tag is called by ^PSIVOCDS also ***
+2 ;PSJDUR - order duration in minutes
+3 ;PSGAT - admin times
+4 ;PSGS0XT - Order Frequency
+5 NEW PSJNDOSE,PSJFRQ1,PSJFRQX,PSJX
+6 if '+$GET(PSJDUR)
QUIT
+7 ; Set frequency to # of amdin times
+8 IF ($GET(PSGAT)]"")
Begin DoDot:1
+9 SET PSJX=$$DATES(PSJPON)
+10 SET PSJNDOSE=$$CNTDOSE($PIECE(PSJX,U),$PIECE(PSJX,U,2))
+11 IF PSJNDOSE
SET PSJFDB(PSJCNT,"FREQ")=PSJNDOSE
QUIT
End DoDot:1
QUIT
+12 ; Set frequency based on frequency(51.1)
+13 ; NUMB^PSSDSAPI is removed for MOCHA 2.1. Need to make sure PSJFRQ1 is in numeric value
+14 ;;S PSJFRQ2=$P($$FRQ^PSSDSAPI($G(PSGSCH),$G(PSGS0XT),"I",PSJDUR_"M",PSJDD),U)
+15 SET PSJFRQ1=$PIECE($$FRQ^PSSDSAPI($GET(PSGSCH),$GET(PSGS0XT),"I",PSJDUR_"M",PSJDD),U)
+16 ;;I PSJFRQ2?1"Q"1N.N1"H" S PSJFRQ2=1440/(+$E(PSJFRQ2,2,$L(PSJFRQ2))*60)
+17 ;;I PSJFRQ2?1"X"1N.N1"D" S PSJFRQ2=+$E(PSJFRQ2,2,$L(PSJFRQ2))
+18 ;;I +PSJFRQ2 S PSJFRQ1=(PSJFRQ2/24)*(+PSJDUR/60)
+19 ; If no value returned from FRQ^PSSDSAPI and frequency is there then set freq = duration in min / freq in min
+20 IF '+$GET(PSJFRQ1)
IF +$GET(PSGS0XT)
SET PSJFRQ1=(+PSJDUR)/PSGS0XT
+21 ; Calculate freq from number of dose admin per day (round up)
+22 SET PSJFDB(PSJCNT,"FREQ")=$SELECT(PSJFRQ1?.N:PSJFRQ1,1:$JUSTIFY((+$GET(PSJFRQ1)+.5),0,0))
+23 IF PSJFDB(PSJCNT,"FREQ")'=0
QUIT
+24 ; If no admin times or frequency(51.1) set error
+25 SET PSJFDB(PSJCNT,"FREQ")=1
+26 SET PSJFDB(PSJCNT,"FRQ_ERROR")=""
+27 QUIT
CNTDOSE(PSGSD,PSGFD) ;Count # of admins to set the Freq to
+1 ;only do this if the start & stop dates are within 24 hours.
+2 NEW PSJX,PSJADMIN,PSJCNT,PSJSTRTM,PSJSTPTM,PSJDTFLG
+3 IF $GET(PSGAT)=""
QUIT 0
+4 IF $GET(PSGSD)=""
QUIT 0
+5 IF $GET(PSGFD)=""
QUIT 0
+6 IF ($$FMDIFF^XLFDT(PSGFD,PSGSD,2)/60)>1440
QUIT 0
+7 SET PSJCNT=0
+8 SET PSJSTRTM=$EXTRACT($PIECE(PSGSD,".",2)_"0000",1,4)
+9 SET PSJSTPTM=$EXTRACT($PIECE(PSGFD,".",2)_"0000",1,4)
+10 SET PSJDTFLG=0
+11 IF $PIECE(PSGSD,".")=$PIECE(PSGFD,".")
SET PSJDTFLG=1
+12 FOR PSJX=1:1
SET PSJADMIN=$PIECE(PSGAT,"-",PSJX)
if PSJADMIN=""
QUIT
Begin DoDot:1
+13 SET PSJADMIN=$EXTRACT($PIECE(PSGAT,"-",PSJX)_"0000",1,4)
+14 IF PSJDTFLG
Begin DoDot:2
+15 IF (PSJSTRTM'>PSJADMIN)
IF (PSJADMIN<PSJSTPTM)
SET PSJCNT=PSJCNT+1
End DoDot:2
QUIT
+16 IF (PSJSTRTM'>PSJADMIN)
SET PSJCNT=PSJCNT+1
+17 IF (PSJSTPTM>PSJADMIN)
SET PSJCNT=PSJCNT+1
End DoDot:1
+18 QUIT PSJCNT
DURATION(PSGSD,PSGFD) ;Figure out the duration from the start, stop dates
+1 ;Return the diff between Stop - Start date in minutes. If > 1 day then return null
+2 NEW PSJDIFF
+3 IF '$DATA(PSGFD)!'$DATA(PSGSD)
QUIT ""
+4 SET PSJDIFF=$$FMDIFF^XLFDT(PSGFD,PSGSD,2)/60
+5 IF (PSJDIFF<1440)
QUIT PSJDIFF
+6 QUIT ""
DOSE() ;Figure out the dose, unit, & dosage Ordered
+1 ;Return 3 pieces: Numeric Dose ^ Unit ^ Dosage Ordered
+2 NEW PSJDS,PSJND0,PSJND2,X,PSJX,PSJXDOX,PSJNDS,PSJALLGY
+3 SET PSJDS=""
+4 ;Subsequence orders in the Complex order has the PSGDO from the first order. Get new PSGDO
+5 IF $GET(PSJPON)["U"
IF $SELECT($GET(PSJCOM):1,$GET(PSGRENEW):1,1:0)
SET PSGDO=$PIECE($GET(^PS(55,DFN,5,+PSJPON,.2)),U,2)
+6 ;If the dose & unit exist use them
+7 IF +$GET(PSJDOSE("DO"))_$PIECE($GET(PSJDOSE("DO")),U,2)=$GET(PSGDO)
QUIT PSJDOSE("DO")_U_$GET(PSGDO)
+8 ;Get dd, dose, unit from the order
+9 IF $GET(PSGORD)]""
IF '+$GET(PSJDD)
Begin DoDot:1
+10 IF PSGORD["P"
SET PSJND2=$GET(^PS(53.1,+PSGORD,.2))
SET PSJDD=$ORDER(^PS(53.1,+PSGORD,1,"B",0))
+11 IF PSGORD["U"
SET PSJND2=$GET(^PS(55,DFN,5,+PSGORD,.2))
SET PSJDD=$ORDER(^PS(55,+DFN,5,+PSGORD,1,"B",0))
End DoDot:1
+12 ;If no numeric dose and there is a dosage ordered then get dose & unit from the order
+13 IF $DATA(PSGORD)
IF $GET(PSGDO)]""
Begin DoDot:1
+14 SET PSJDS=$PIECE($GET(PSJND2),U,5,6)
End DoDot:1
+15 if +PSJDS
QUIT PSJDS_U_$GET(PSGDO)
+16 ;Get dispense unit per dose and figure out numeric and unit
+17 IF +$GET(PSJDD)
IF ($GET(PSGDO)]"")
Begin DoDot:1
+18 SET PSJDS=$$DOSE1()
+19 IF $PIECE($GET(PSJXDOX(1)),U,11)=$$UP^XLFSTR(PSGDO)
if +PSJDS
QUIT
+20 SET PSJDS=""
+21 SET PSJX=$GET(PSJXDOX(1))
+22 IF +PSJX
SET X=+PSGDO/+PSJX
SET PSJDS=$$DOSE1(X)
+23 IF $PIECE($GET(PSJXDOX(1)),U,11)=$$UP^XLFSTR(PSGDO)
if +PSJDS
QUIT
+24 SET PSJDS=""
End DoDot:1
+25 if +PSJDS
QUIT PSJDS
+26 IF +$GET(PSJDD)
IF ($GET(PSGDO)="")
IF ($GET(PSGORD)="")
Begin DoDot:1
+27 SET PSJDS=$$DOSE1($SELECT(+$GET(PSGUD):PSGUD,1:1))
End DoDot:1
+28 if +PSJDS
QUIT PSJDS
+29 ;Figure out dose & unit from the dispense drug. Dosage Ordered is required for multiple dispense drugs
+30 IF $GET(PSGDO)=""
Begin DoDot:1
+31 SET PSJND0=$$DD53P45^PSJMISC()
+32 IF PSJND0=""
SET PSJND0=$GET(PSGDRG)
+33 SET X=+$PIECE(PSJND0,U,2)
SET PSJDS=$$DOSE1($SELECT(X:X,1:1))
End DoDot:1
+34 if +PSJDS
QUIT PSJDS
+35 QUIT "^^"_$GET(PSGDO)
DOSE1(PSJDUP) ;
+1 ;PSJDUP - Dispense unit per dose
+2 NEW PSJDS
+3 if '+$GET(PSJDD)
QUIT
+4 KILL PSJXDOX
+5 SET PSJDS=""
+6 DO DOSE^PSSORPH(.PSJXDOX,+PSJDD,"U",,$GET(PSJDUP))
+7 if $GET(PSJXDOX(1))
SET PSJDS=$PIECE(PSJXDOX(1),U,1,2)_U_$PIECE(PSJXDOX(1),U)_$PIECE(PSJXDOX(1),U,2)
+8 QUIT PSJDS
DATES(PSJPON) ;Check the correct Start, Stop dates to use
+1 ;PSJOCDSC("CX",PSGsd/PSGfd,on)=default PSGsd/PSGfd date _^_ PSGsd/PSGfd _^_PSJFLG
+2 ;PSJP1 = Start date; PSJP2 = Stop date; PSJFLG = 1 if start or stop date has changed.
+3 ;For some reasons, PSGSD redefined to cal start date for Complex order (one with duration),
+4 ; PSGFD redefined to cal stop date. These 2 fields reflect the default start, stop dates if they
+5 ; were edited.
+6 ;
+7 NEW PSJXSD,PSJXFD,PSJP1,PSJP2,PSJFLG,X
+8 IF '+$GET(PSJPON)
QUIT $GET(PSGSD)_U_$GET(PSGFD)_U_0
+9 SET PSJFLG=0
+10 SET PSJP1=$GET(PSGSD)
SET PSJP2=$GET(PSGFD)
+11 IF $DATA(PSJOCDSC("CX","PSGSD"))
Begin DoDot:1
+12 SET PSJXSD=$GET(PSJOCDSC("CX","PSGSD",+PSJPON))
+13 SET PSJXFD=$GET(PSJOCDSC("CX","PSGFD",+PSJPON))
+14 IF PSGSD=$PIECE(PSJXSD,U,2)
SET PSJP1=$PIECE(PSJXSD,U)
+15 ;
+16 IF $PIECE(PSJXFD,U,2)]""
IF (PSGFD=$PIECE(PSJXFD,U,2))
SET PSJP2=$PIECE(PSJXFD,U)
+17 IF $PIECE(PSJXFD,U,2)=""
SET $PIECE(PSJXFD,U,2)=PSGFD
SET PSJP2=PSGFD
+18 ;
+19 ; I $P(PSJXFD,U,2)="" S $P(PSJXFD,U,2)=PSGFD
+20 ; I PSGFD=$P(PSJXFD,U,2) S PSJP2=$P(PSJXFD,U)
+21 IF (PSJXSD]"")!(PSJXFD]"")
Begin DoDot:2
+22 IF $SELECT($GET(PSGSD)'=$PIECE(PSJXSD,U,2):1,$GET(PSGFD)'=$PIECE(PSJXFD,U,2):1,1:0)
SET PSJFLG=1
End DoDot:2
+23 SET X=$GET(^PS(53.1,+PSJPON,2.5))
+24 ;Reset PSJP1 & PSJP2 from the order is needed when complex order defaulted to IV but FN as UD,
+25 ; the calc Start/stop dates were used therefore the duration was not considered.
+26 IF (PSJPON["P")
IF (PSJFLG=0)
IF ($PIECE(X,U,2)]"")
SET PSJP1=$PIECE(X,U,1)
SET PSJP2=$PIECE(X,U,3)
End DoDot:1
+27 QUIT PSJP1_U_PSJP2_U_PSJFLG
OINM(PSJPON) ;For speed renew, returns OI name if order has multiple DD else returns null
+1 NEW PSJCNT,PSJDD,PSJOINM,PSJOI
+2 IF $GET(PSJPON)'["P"
QUIT
+3 SET PSJCNT=0
+4 FOR PSJDD=0:0
SET PSJDD=$ORDER(^PS(53.1,+PSJPON,1,PSJDD))
if 'PSJDD
QUIT
SET PSJCNT=PSJCNT+1
+5 IF PSJCNT>1
SET PSJOI=+$GET(^PS(53.1,+PSJPON,.2))
SET PSJOINM=$$OIDF^PSJLMUT1(+PSJOI)
+6 QUIT $GET(PSJOINM)
