PSJMISC2 ;BIR/MV - MISC. CALLS FOR IV DOSING CHECKS;6 Jun 07 / 3:37 PM
;;5.0;INPATIENT MEDICATIONS ;**181,252,256**;16 DEC 97;Build 34
; Reference to ^PS(51.1 is supported by DBIA #2177
; Reference to ^PSSDSAPI is supported by DBIA #5425
;
P8(PSJINFRT) ;Set infusion rate in term of numeric, dose unit over time unit
;PSJINFRT - Infusion Rate
;Return either Null or numeric^doseUnit^timeUnit
;PWJP8ERR - Must be clean up by calling routine.
;PSJP8ERR = 1 - "FRQ_ERROR"
;PSJP8ERR = 2 - "WT_ERROR"
;PSJP8ERR = 3 - "HT_ERROR"
;PSJP8ERR = 4 - Set both WT & HT error
;
I $G(PSJINFRT)="" Q ""
NEW X,PSJBSA,PSJBSAFG,PSJHT,PSJWT,PSJWTFG,PSJTIME,PSJUNIT,PSJP1,PSJP2,PSJNUT,PSJUP8
K PSJP8ERR
S PSJUP8=$$UP^XLFSTR(PSJINFRT)
I $S(PSJUP8["TITRATE AT ":0,PSJUP8["TITRATE":1,1:0) S PSJP8ERR=1 Q ""
I PSJUP8["BOLUS" S PSJP8ERR=1 Q ""
S PSJP1=$P(PSJUP8,"@")
S:PSJP1["INFUSE OVER " PSJP1=$P(PSJP1,"INFUSE OVER ",2)
S:PSJP1["INFUSE AT " PSJP1=$P(PSJP1,"INFUSE AT ",2)
S:PSJP1["INFUSE " PSJP1=$P(PSJP1,"INFUSE ",2)
S:PSJP1["OVER " PSJP1=$P(PSJP1,"OVER ",2)
S:PSJP1["START AT " PSJP1=$P(PSJP1,"START AT ",2)
S:PSJP1["TITRATE AT " PSJP1=$P(PSJP1,"TITRATE AT ",2)
I PSJP1[" TO " S PSJP8ERR=1 Q ""
S:PSJP1["," PSJP1=$TR(PSJP1,",","")
S PSJP1=$TR(PSJP1," ")
I '+PSJP1 S PSJP8ERR=1 Q ""
;
S PSJP2=$P(PSJUP8,"@",2)
I PSJUP8["@",$S(PSJP2=0:0,'+PSJP2:1,1:0) S PSJP8ERR=1 Q ""
;
I PSJP1'["/" S PSJP8ERR=1 Q ""
;Process ml/hr, mg/day... types
NEW PSJUOTME
I $S(PSJP1["/KG/":0,PSJP1["/M2/":0,1:1) S PSJUOTME=$$UNTOTME(PSJP1) Q PSJUOTME
;
;If Infusion rate contains /KG/, /M2/ and also contains ML/HR
I PSJP1["ML/HR" S PSJP8ERR=1 Q ""
;
;Set patient parameter
S X=$$BSA^PSSDSAPI($G(DFN))
S PSJHT=+$P(X,U),PSJWT=+$P(X,U,2),PSJBSA=+$P(X,U,3)
S PSJTIME=$P(PSJP1,"/",3)
S PSJTIME=$$TIME(PSJTIME)
S X=$P(PSJP1,"/"),PSJUNIT=$P(X,+X,2)
I PSJP1["." S PSJUNIT=$$UNIT(PSJUNIT)
S PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
;
;Calculate SDA using weight
I PSJP1["/KG/" S PSJWTFG=$$WT() Q PSJWTFG
;
;Calculate SDA using BSA
I PSJP1["/M2/" S PSJBSAFG=$$BSA() Q PSJBSAFG
;
Q ""
WT() ;
NEW X
I $S(PSJUNIT="":1,PSJTIME="":1,'PSJWT:1,'+PSJP1:1,1:0) S PSJP8ERR=2 Q ""
S X=(+PSJP1*PSJWT)_U_PSJUNIT_U_PSJTIME
Q X
BSA() ;
NEW X
I $S(PSJUNIT="":1,PSJTIME="":1,'PSJBSA:1,'+PSJP1:1,1:0) D Q ""
. I $G(PSJHT)=0,($G(PSJWT)=0) S PSJP8ERR=4 Q
. I $G(PSJHT)=0 S PSJP8ERR=3 Q
. I $G(PSJWT)=0 S PSJP8ERR=2
S X=(+PSJP1*PSJBSA)_U_PSJUNIT_U_PSJTIME
Q X
UNTOTME(PSJINF) ;Process Infusion rate for format of Num Unit/time. Ex: 8MG/HR, 125ML/HR, 1000UNITS/HR@TITRATE
;Return n^unit^time if infusion rate contain numeric + Unit over time (8MG/HR;125ML/HR) format in p1^p2^p3
;Otherwise return null
;PSJINF is already have "OVER" and whatever from "@" removed
NEW PSJNUM,PSJP1S1,PSJP1S2,PSJUNIT,PSJTIME
I $G(PSJINF)="" S PSJP8ERR=1 Q ""
S PSJNUM=+PSJINF
I 'PSJNUM S PSJP8ERR=1 Q ""
S PSJP1S1=$P(PSJINF,"/")
S PSJP1S2=$P(PSJINF,"/",2)
; Should be free text if in format: "8MG/HRML/HR" PSJP1S2="HRML/HR"
I PSJP1S2["ML/HR" S PSJP8ERR=1 Q ""
S PSJUNIT=$P(PSJP1S1,PSJNUM,2)
S PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
I PSJUNIT="" S PSJP8ERR=1 Q ""
S PSJTIME=$$TIME(PSJP1S2)
I PSJTIME="" S PSJP8ERR=1 Q ""
Q PSJNUM_U_PSJUNIT_U_PSJTIME
TIME(PSJTIME) ;
Q:$G(PSJTIME)="" ""
I PSJTIME="MIN" Q "MINUTE"
I PSJTIME="MINUTE" Q "MINUTE"
I PSJTIME="MINUTES" Q "MINUTE"
I PSJTIME="HR" Q "HOUR"
I PSJTIME="HOUR" Q "HOUR"
I PSJTIME="HOURS" Q "HOUR"
I PSJTIME="DAY" Q "DAY"
I PSJTIME="DAYS" Q "DAY"
Q ""
UNIT(PSJUNIT) ;Remove extra zero after decimal point
NEW PSJX
I $G(PSJUNIT)=""!($G(PSJUNIT)=0) Q ""
F S PSJX=$E(PSJUNIT,1,1) Q:PSJX'=0 S:PSJX=0 PSJUNIT=$E(PSJUNIT,2,$L(PSJUNIT))
Q PSJUNIT
OLDSCHD(PSJOLDNM) ;checking if the schedule in the order is an old schedule name
;PSJOLDNM(ORD_SCHD) - the schedule as entered in the order
;PSJOLDNM(OLD_SCHD) - found an old schedule name
;PSJOLDNM(NEW_SCHD) - new schedule name
;Note - if schedule is DOW or in DOW format, don't check for Old Schedule Name
NEW PSJSCH,PSJNSCH,PSJNSCH0,PSJIEN
S PSJSCH=$G(PSJOLDNM("ORD_SCHD"))
Q:PSJSCH=""
I $D(^PS(51.1,"APPSJ",PSJSCH)) Q
S PSJIEN=$O(^PS(51.1,"D",PSJSCH,0))
I +PSJIEN D Q
. S PSJNSCH0=$G(^PS(51.1,PSJIEN,0))
. Q:$P(PSJNSCH0,U,5)="D"
. S PSJNSCH=$P(PSJNSCH0,U,1)
. Q:$$DOW^PSIVUTL(PSJNSCH)
. I PSJNSCH]"" S PSJOLDNM("NEW_SCHD")=PSJNSCH,PSJOLDNM("OLD_SCHD")=PSJSCH
Q
PROMPT(PSJOLDNM,PSJMSGFL) ;display the replaced schedule name and prompt if the user want to continue with the order
NEW PSJMSG,VALMBCK,PSGORQF
I $G(PSJOLDNM("ORD_SCHD"))=""!$G(PSJOLDNM("ORD_SCHD"))="" Q
S PSJMSG="The schedule "_PSJOLDNM("ORD_SCHD")_" has been replaced with "_PSJOLDNM("NEW_SCHD")_" by the system administrator after this order was "_$S($G(PSJMSGFL)="R":"renewed.",1:"entered.")
W !!!
D WRITE^PSJMISC(PSJMSG)
;PSGORQF=1 if the user said No from the prompt below, VALMBCK="R" from this call. Newed to keep the orig value.
I $G(PSJMSGFL)]"" S PSGORQF=1 D D PAUSE^PSJLMUT1
. I $G(PSJMSGFL)="V" W !,"Please correct the schedule before verifying this order."
. I $G(PSJMSGFL)="R" W !,"WARNING - Renewed RXs cannot be edited. Please enter new order."
D:$G(PSJMSGFL)="" CONT^PSJOCDT
Q $G(PSGORQF)
CHKSCHD(PSJOLDNM,PSJMSGFL) ;
;PSJMSGFL = "V" if calling during verification; "R" - renew; null - otherwise
NEW PSGORQF
I $G(PSJOLDNM("ORD_SCHD"))]"" D OLDSCHD(.PSJOLDNM)
I $G(PSJOLDNM("NEW_SCHD"))]"" S PSGORQF=$$PROMPT(.PSJOLDNM,$G(PSJMSGFL))
Q $G(PSGORQF)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMISC2 5588 printed Oct 16, 2024@18:08:28 Page 2
PSJMISC2 ;BIR/MV - MISC. CALLS FOR IV DOSING CHECKS;6 Jun 07 / 3:37 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**181,252,256**;16 DEC 97;Build 34
+2 ; Reference to ^PS(51.1 is supported by DBIA #2177
+3 ; Reference to ^PSSDSAPI is supported by DBIA #5425
+4 ;
P8(PSJINFRT) ;Set infusion rate in term of numeric, dose unit over time unit
+1 ;PSJINFRT - Infusion Rate
+2 ;Return either Null or numeric^doseUnit^timeUnit
+3 ;PWJP8ERR - Must be clean up by calling routine.
+4 ;PSJP8ERR = 1 - "FRQ_ERROR"
+5 ;PSJP8ERR = 2 - "WT_ERROR"
+6 ;PSJP8ERR = 3 - "HT_ERROR"
+7 ;PSJP8ERR = 4 - Set both WT & HT error
+8 ;
+9 IF $GET(PSJINFRT)=""
QUIT ""
+10 NEW X,PSJBSA,PSJBSAFG,PSJHT,PSJWT,PSJWTFG,PSJTIME,PSJUNIT,PSJP1,PSJP2,PSJNUT,PSJUP8
+11 KILL PSJP8ERR
+12 SET PSJUP8=$$UP^XLFSTR(PSJINFRT)
+13 IF $SELECT(PSJUP8["TITRATE AT ":0,PSJUP8["TITRATE":1,1:0)
SET PSJP8ERR=1
QUIT ""
+14 IF PSJUP8["BOLUS"
SET PSJP8ERR=1
QUIT ""
+15 SET PSJP1=$PIECE(PSJUP8,"@")
+16 if PSJP1["INFUSE OVER "
SET PSJP1=$PIECE(PSJP1,"INFUSE OVER ",2)
+17 if PSJP1["INFUSE AT "
SET PSJP1=$PIECE(PSJP1,"INFUSE AT ",2)
+18 if PSJP1["INFUSE "
SET PSJP1=$PIECE(PSJP1,"INFUSE ",2)
+19 if PSJP1["OVER "
SET PSJP1=$PIECE(PSJP1,"OVER ",2)
+20 if PSJP1["START AT "
SET PSJP1=$PIECE(PSJP1,"START AT ",2)
+21 if PSJP1["TITRATE AT "
SET PSJP1=$PIECE(PSJP1,"TITRATE AT ",2)
+22 IF PSJP1[" TO "
SET PSJP8ERR=1
QUIT ""
+23 if PSJP1[","
SET PSJP1=$TRANSLATE(PSJP1,",","")
+24 SET PSJP1=$TRANSLATE(PSJP1," ")
+25 IF '+PSJP1
SET PSJP8ERR=1
QUIT ""
+26 ;
+27 SET PSJP2=$PIECE(PSJUP8,"@",2)
+28 IF PSJUP8["@"
IF $SELECT(PSJP2=0:0,'+PSJP2:1,1:0)
SET PSJP8ERR=1
QUIT ""
+29 ;
+30 IF PSJP1'["/"
SET PSJP8ERR=1
QUIT ""
+31 ;Process ml/hr, mg/day... types
+32 NEW PSJUOTME
+33 IF $SELECT(PSJP1["/KG/":0,PSJP1["/M2/":0,1:1)
SET PSJUOTME=$$UNTOTME(PSJP1)
QUIT PSJUOTME
+34 ;
+35 ;If Infusion rate contains /KG/, /M2/ and also contains ML/HR
+36 IF PSJP1["ML/HR"
SET PSJP8ERR=1
QUIT ""
+37 ;
+38 ;Set patient parameter
+39 SET X=$$BSA^PSSDSAPI($GET(DFN))
+40 SET PSJHT=+$PIECE(X,U)
SET PSJWT=+$PIECE(X,U,2)
SET PSJBSA=+$PIECE(X,U,3)
+41 SET PSJTIME=$PIECE(PSJP1,"/",3)
+42 SET PSJTIME=$$TIME(PSJTIME)
+43 SET X=$PIECE(PSJP1,"/")
SET PSJUNIT=$PIECE(X,+X,2)
+44 IF PSJP1["."
SET PSJUNIT=$$UNIT(PSJUNIT)
+45 SET PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
+46 ;
+47 ;Calculate SDA using weight
+48 IF PSJP1["/KG/"
SET PSJWTFG=$$WT()
QUIT PSJWTFG
+49 ;
+50 ;Calculate SDA using BSA
+51 IF PSJP1["/M2/"
SET PSJBSAFG=$$BSA()
QUIT PSJBSAFG
+52 ;
+53 QUIT ""
WT() ;
+1 NEW X
+2 IF $SELECT(PSJUNIT="":1,PSJTIME="":1,'PSJWT:1,'+PSJP1:1,1:0)
SET PSJP8ERR=2
QUIT ""
+3 SET X=(+PSJP1*PSJWT)_U_PSJUNIT_U_PSJTIME
+4 QUIT X
BSA() ;
+1 NEW X
+2 IF $SELECT(PSJUNIT="":1,PSJTIME="":1,'PSJBSA:1,'+PSJP1:1,1:0)
Begin DoDot:1
+3 IF $GET(PSJHT)=0
IF ($GET(PSJWT)=0)
SET PSJP8ERR=4
QUIT
+4 IF $GET(PSJHT)=0
SET PSJP8ERR=3
QUIT
+5 IF $GET(PSJWT)=0
SET PSJP8ERR=2
End DoDot:1
QUIT ""
+6 SET X=(+PSJP1*PSJBSA)_U_PSJUNIT_U_PSJTIME
+7 QUIT X
UNTOTME(PSJINF) ;Process Infusion rate for format of Num Unit/time. Ex: 8MG/HR, 125ML/HR, 1000UNITS/HR@TITRATE
+1 ;Return n^unit^time if infusion rate contain numeric + Unit over time (8MG/HR;125ML/HR) format in p1^p2^p3
+2 ;Otherwise return null
+3 ;PSJINF is already have "OVER" and whatever from "@" removed
+4 NEW PSJNUM,PSJP1S1,PSJP1S2,PSJUNIT,PSJTIME
+5 IF $GET(PSJINF)=""
SET PSJP8ERR=1
QUIT ""
+6 SET PSJNUM=+PSJINF
+7 IF 'PSJNUM
SET PSJP8ERR=1
QUIT ""
+8 SET PSJP1S1=$PIECE(PSJINF,"/")
+9 SET PSJP1S2=$PIECE(PSJINF,"/",2)
+10 ; Should be free text if in format: "8MG/HRML/HR" PSJP1S2="HRML/HR"
+11 IF PSJP1S2["ML/HR"
SET PSJP8ERR=1
QUIT ""
+12 SET PSJUNIT=$PIECE(PSJP1S1,PSJNUM,2)
+13 SET PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
+14 IF PSJUNIT=""
SET PSJP8ERR=1
QUIT ""
+15 SET PSJTIME=$$TIME(PSJP1S2)
+16 IF PSJTIME=""
SET PSJP8ERR=1
QUIT ""
+17 QUIT PSJNUM_U_PSJUNIT_U_PSJTIME
TIME(PSJTIME) ;
+1 if $GET(PSJTIME)=""
QUIT ""
+2 IF PSJTIME="MIN"
QUIT "MINUTE"
+3 IF PSJTIME="MINUTE"
QUIT "MINUTE"
+4 IF PSJTIME="MINUTES"
QUIT "MINUTE"
+5 IF PSJTIME="HR"
QUIT "HOUR"
+6 IF PSJTIME="HOUR"
QUIT "HOUR"
+7 IF PSJTIME="HOURS"
QUIT "HOUR"
+8 IF PSJTIME="DAY"
QUIT "DAY"
+9 IF PSJTIME="DAYS"
QUIT "DAY"
+10 QUIT ""
UNIT(PSJUNIT) ;Remove extra zero after decimal point
+1 NEW PSJX
+2 IF $GET(PSJUNIT)=""!($GET(PSJUNIT)=0)
QUIT ""
+3 FOR
SET PSJX=$EXTRACT(PSJUNIT,1,1)
if PSJX'=0
QUIT
if PSJX=0
SET PSJUNIT=$EXTRACT(PSJUNIT,2,$LENGTH(PSJUNIT))
+4 QUIT PSJUNIT
OLDSCHD(PSJOLDNM) ;checking if the schedule in the order is an old schedule name
+1 ;PSJOLDNM(ORD_SCHD) - the schedule as entered in the order
+2 ;PSJOLDNM(OLD_SCHD) - found an old schedule name
+3 ;PSJOLDNM(NEW_SCHD) - new schedule name
+4 ;Note - if schedule is DOW or in DOW format, don't check for Old Schedule Name
+5 NEW PSJSCH,PSJNSCH,PSJNSCH0,PSJIEN
+6 SET PSJSCH=$GET(PSJOLDNM("ORD_SCHD"))
+7 if PSJSCH=""
QUIT
+8 IF $DATA(^PS(51.1,"APPSJ",PSJSCH))
QUIT
+9 SET PSJIEN=$ORDER(^PS(51.1,"D",PSJSCH,0))
+10 IF +PSJIEN
Begin DoDot:1
+11 SET PSJNSCH0=$GET(^PS(51.1,PSJIEN,0))
+12 if $PIECE(PSJNSCH0,U,5)="D"
QUIT
+13 SET PSJNSCH=$PIECE(PSJNSCH0,U,1)
+14 if $$DOW^PSIVUTL(PSJNSCH)
QUIT
+15 IF PSJNSCH]""
SET PSJOLDNM("NEW_SCHD")=PSJNSCH
SET PSJOLDNM("OLD_SCHD")=PSJSCH
End DoDot:1
QUIT
+16 QUIT
PROMPT(PSJOLDNM,PSJMSGFL) ;display the replaced schedule name and prompt if the user want to continue with the order
+1 NEW PSJMSG,VALMBCK,PSGORQF
+2 IF $GET(PSJOLDNM("ORD_SCHD"))=""!$GET(PSJOLDNM("ORD_SCHD"))=""
QUIT
+3 SET PSJMSG="The schedule "_PSJOLDNM("ORD_SCHD")_" has been replaced with "_PSJOLDNM("NEW_SCHD")_" by the system administrator after this order was "_$SELECT($GET(PSJMSGFL)="R":"renewed.",1:"entered.")
+4 WRITE !!!
+5 DO WRITE^PSJMISC(PSJMSG)
+6 ;PSGORQF=1 if the user said No from the prompt below, VALMBCK="R" from this call. Newed to keep the orig value.
+7 IF $GET(PSJMSGFL)]""
SET PSGORQF=1
Begin DoDot:1
+8 IF $GET(PSJMSGFL)="V"
WRITE !,"Please correct the schedule before verifying this order."
+9 IF $GET(PSJMSGFL)="R"
WRITE !,"WARNING - Renewed RXs cannot be edited. Please enter new order."
End DoDot:1
DO PAUSE^PSJLMUT1
+10 if $GET(PSJMSGFL)=""
DO CONT^PSJOCDT
+11 QUIT $GET(PSGORQF)
CHKSCHD(PSJOLDNM,PSJMSGFL) ;
+1 ;PSJMSGFL = "V" if calling during verification; "R" - renew; null - otherwise
+2 NEW PSGORQF
+3 IF $GET(PSJOLDNM("ORD_SCHD"))]""
DO OLDSCHD(.PSJOLDNM)
+4 IF $GET(PSJOLDNM("NEW_SCHD"))]""
SET PSGORQF=$$PROMPT(.PSJOLDNM,$GET(PSJMSGFL))
+5 QUIT $GET(PSGORQF)
