- 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 Dec 13, 2024@02:07:42 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)