- 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 Jan 18, 2025@03:09:15 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)