Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJMISC2

PSJMISC2.m

Go to the documentation of this file.
  1. 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
  1. ; Reference to ^PS(51.1 is supported by DBIA #2177
  1. ; Reference to ^PSSDSAPI is supported by DBIA #5425
  1. ;
  1. P8(PSJINFRT) ;Set infusion rate in term of numeric, dose unit over time unit
  1. ;PSJINFRT - Infusion Rate
  1. ;Return either Null or numeric^doseUnit^timeUnit
  1. ;PWJP8ERR - Must be clean up by calling routine.
  1. ;PSJP8ERR = 1 - "FRQ_ERROR"
  1. ;PSJP8ERR = 2 - "WT_ERROR"
  1. ;PSJP8ERR = 3 - "HT_ERROR"
  1. ;PSJP8ERR = 4 - Set both WT & HT error
  1. ;
  1. I $G(PSJINFRT)="" Q ""
  1. NEW X,PSJBSA,PSJBSAFG,PSJHT,PSJWT,PSJWTFG,PSJTIME,PSJUNIT,PSJP1,PSJP2,PSJNUT,PSJUP8
  1. K PSJP8ERR
  1. S PSJUP8=$$UP^XLFSTR(PSJINFRT)
  1. I $S(PSJUP8["TITRATE AT ":0,PSJUP8["TITRATE":1,1:0) S PSJP8ERR=1 Q ""
  1. I PSJUP8["BOLUS" S PSJP8ERR=1 Q ""
  1. S PSJP1=$P(PSJUP8,"@")
  1. S:PSJP1["INFUSE OVER " PSJP1=$P(PSJP1,"INFUSE OVER ",2)
  1. S:PSJP1["INFUSE AT " PSJP1=$P(PSJP1,"INFUSE AT ",2)
  1. S:PSJP1["INFUSE " PSJP1=$P(PSJP1,"INFUSE ",2)
  1. S:PSJP1["OVER " PSJP1=$P(PSJP1,"OVER ",2)
  1. S:PSJP1["START AT " PSJP1=$P(PSJP1,"START AT ",2)
  1. S:PSJP1["TITRATE AT " PSJP1=$P(PSJP1,"TITRATE AT ",2)
  1. I PSJP1[" TO " S PSJP8ERR=1 Q ""
  1. S:PSJP1["," PSJP1=$TR(PSJP1,",","")
  1. S PSJP1=$TR(PSJP1," ")
  1. I '+PSJP1 S PSJP8ERR=1 Q ""
  1. ;
  1. S PSJP2=$P(PSJUP8,"@",2)
  1. I PSJUP8["@",$S(PSJP2=0:0,'+PSJP2:1,1:0) S PSJP8ERR=1 Q ""
  1. ;
  1. I PSJP1'["/" S PSJP8ERR=1 Q ""
  1. ;Process ml/hr, mg/day... types
  1. NEW PSJUOTME
  1. I $S(PSJP1["/KG/":0,PSJP1["/M2/":0,1:1) S PSJUOTME=$$UNTOTME(PSJP1) Q PSJUOTME
  1. ;
  1. ;If Infusion rate contains /KG/, /M2/ and also contains ML/HR
  1. I PSJP1["ML/HR" S PSJP8ERR=1 Q ""
  1. ;
  1. ;Set patient parameter
  1. S X=$$BSA^PSSDSAPI($G(DFN))
  1. S PSJHT=+$P(X,U),PSJWT=+$P(X,U,2),PSJBSA=+$P(X,U,3)
  1. S PSJTIME=$P(PSJP1,"/",3)
  1. S PSJTIME=$$TIME(PSJTIME)
  1. S X=$P(PSJP1,"/"),PSJUNIT=$P(X,+X,2)
  1. I PSJP1["." S PSJUNIT=$$UNIT(PSJUNIT)
  1. S PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
  1. ;
  1. ;Calculate SDA using weight
  1. I PSJP1["/KG/" S PSJWTFG=$$WT() Q PSJWTFG
  1. ;
  1. ;Calculate SDA using BSA
  1. I PSJP1["/M2/" S PSJBSAFG=$$BSA() Q PSJBSAFG
  1. ;
  1. Q ""
  1. WT() ;
  1. NEW X
  1. I $S(PSJUNIT="":1,PSJTIME="":1,'PSJWT:1,'+PSJP1:1,1:0) S PSJP8ERR=2 Q ""
  1. S X=(+PSJP1*PSJWT)_U_PSJUNIT_U_PSJTIME
  1. Q X
  1. BSA() ;
  1. NEW X
  1. I $S(PSJUNIT="":1,PSJTIME="":1,'PSJBSA:1,'+PSJP1:1,1:0) D Q ""
  1. . I $G(PSJHT)=0,($G(PSJWT)=0) S PSJP8ERR=4 Q
  1. . I $G(PSJHT)=0 S PSJP8ERR=3 Q
  1. . I $G(PSJWT)=0 S PSJP8ERR=2
  1. S X=(+PSJP1*PSJBSA)_U_PSJUNIT_U_PSJTIME
  1. Q X
  1. 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
  1. ;Otherwise return null
  1. ;PSJINF is already have "OVER" and whatever from "@" removed
  1. NEW PSJNUM,PSJP1S1,PSJP1S2,PSJUNIT,PSJTIME
  1. I $G(PSJINF)="" S PSJP8ERR=1 Q ""
  1. S PSJNUM=+PSJINF
  1. I 'PSJNUM S PSJP8ERR=1 Q ""
  1. S PSJP1S1=$P(PSJINF,"/")
  1. S PSJP1S2=$P(PSJINF,"/",2)
  1. ; Should be free text if in format: "8MG/HRML/HR" PSJP1S2="HRML/HR"
  1. I PSJP1S2["ML/HR" S PSJP8ERR=1 Q ""
  1. S PSJUNIT=$P(PSJP1S1,PSJNUM,2)
  1. S PSJUNIT=$$UNIT^PSSDSAPI(PSJUNIT)
  1. I PSJUNIT="" S PSJP8ERR=1 Q ""
  1. S PSJTIME=$$TIME(PSJP1S2)
  1. I PSJTIME="" S PSJP8ERR=1 Q ""
  1. Q PSJNUM_U_PSJUNIT_U_PSJTIME
  1. TIME(PSJTIME) ;
  1. Q:$G(PSJTIME)="" ""
  1. I PSJTIME="MIN" Q "MINUTE"
  1. I PSJTIME="MINUTE" Q "MINUTE"
  1. I PSJTIME="MINUTES" Q "MINUTE"
  1. I PSJTIME="HR" Q "HOUR"
  1. I PSJTIME="HOUR" Q "HOUR"
  1. I PSJTIME="HOURS" Q "HOUR"
  1. I PSJTIME="DAY" Q "DAY"
  1. I PSJTIME="DAYS" Q "DAY"
  1. Q ""
  1. UNIT(PSJUNIT) ;Remove extra zero after decimal point
  1. NEW PSJX
  1. I $G(PSJUNIT)=""!($G(PSJUNIT)=0) Q ""
  1. F S PSJX=$E(PSJUNIT,1,1) Q:PSJX'=0 S:PSJX=0 PSJUNIT=$E(PSJUNIT,2,$L(PSJUNIT))
  1. Q PSJUNIT
  1. 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
  1. ;PSJOLDNM(OLD_SCHD) - found an old schedule name
  1. ;PSJOLDNM(NEW_SCHD) - new schedule name
  1. ;Note - if schedule is DOW or in DOW format, don't check for Old Schedule Name
  1. NEW PSJSCH,PSJNSCH,PSJNSCH0,PSJIEN
  1. S PSJSCH=$G(PSJOLDNM("ORD_SCHD"))
  1. Q:PSJSCH=""
  1. I $D(^PS(51.1,"APPSJ",PSJSCH)) Q
  1. S PSJIEN=$O(^PS(51.1,"D",PSJSCH,0))
  1. I +PSJIEN D Q
  1. . S PSJNSCH0=$G(^PS(51.1,PSJIEN,0))
  1. . Q:$P(PSJNSCH0,U,5)="D"
  1. . S PSJNSCH=$P(PSJNSCH0,U,1)
  1. . Q:$$DOW^PSIVUTL(PSJNSCH)
  1. . I PSJNSCH]"" S PSJOLDNM("NEW_SCHD")=PSJNSCH,PSJOLDNM("OLD_SCHD")=PSJSCH
  1. Q
  1. PROMPT(PSJOLDNM,PSJMSGFL) ;display the replaced schedule name and prompt if the user want to continue with the order
  1. NEW PSJMSG,VALMBCK,PSGORQF
  1. I $G(PSJOLDNM("ORD_SCHD"))=""!$G(PSJOLDNM("ORD_SCHD"))="" Q
  1. 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.")
  1. W !!!
  1. D WRITE^PSJMISC(PSJMSG)
  1. ;PSGORQF=1 if the user said No from the prompt below, VALMBCK="R" from this call. Newed to keep the orig value.
  1. I $G(PSJMSGFL)]"" S PSGORQF=1 D D PAUSE^PSJLMUT1
  1. . I $G(PSJMSGFL)="V" W !,"Please correct the schedule before verifying this order."
  1. . I $G(PSJMSGFL)="R" W !,"WARNING - Renewed RXs cannot be edited. Please enter new order."
  1. D:$G(PSJMSGFL)="" CONT^PSJOCDT
  1. Q $G(PSGORQF)
  1. CHKSCHD(PSJOLDNM,PSJMSGFL) ;
  1. ;PSJMSGFL = "V" if calling during verification; "R" - renew; null - otherwise
  1. NEW PSGORQF
  1. I $G(PSJOLDNM("ORD_SCHD"))]"" D OLDSCHD(.PSJOLDNM)
  1. I $G(PSJOLDNM("NEW_SCHD"))]"" S PSGORQF=$$PROMPT(.PSJOLDNM,$G(PSJMSGFL))
  1. Q $G(PSGORQF)