PSIVUTL1 ;BIR/MLM-IV UTILITIES ; 2/2/09 9:17am
;;5.0; INPATIENT MEDICATIONS ;**58,81,111,134,218**;16 DEC 97;Build 2
;
; Reference to ^PS(50.7 is supported by DBIA 2180
; Reference to ^PS(51.2 is supported by DBIA 2178
; Reference to ^PS(52.6 is supported by DBIA 1231
; Reference to ^PS(52.7 is supported by DBIA 2173.
; Reference to ^PS(55 is supported by DBIA 2191
;
DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item.
N OK,ND,NDU,NDI S OK=0 ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0
S ND=$G(^PS(50.7,+Y,0))
I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)
Q OK
;
IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.
; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7
N Y S Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)"
Q Y
;
ENU(Y) ;Get IV additive strength.
N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2)
Q Y
;
CODES(X,Y) ; Get name from code.
S Y=$P($P(";"_$P(Y,U,3),";"_X_":",2),";")
Q Y
;
GTPCI(Y) ; Set up "work" area for provider comments.
N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC
Q Y
;
WDTE(Y) ; Format and print date.
I 'Y S Y="******"
E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
Q Y
GTOT(DFN,ON) ; Get order type for display.
N DRGT,DRGI,Y
S X=$P($G(^PS(55,DFN,"IV",ON,0)),U,4)
S Y=$S(X="A":"F",X="H":"H",1:"I")
I Y="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON,DRGT,DRGI)) Q:'DRGI I '$P($G(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5) S Y="I" Q
Q Y
;
PIV(ON) ; Display IV orders.
N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D
.S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X)
.S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
.S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
I ON'["V" S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) I $E(P("OT"))="I" D Q
.S P("PD")=$P($$DRUGNAME^PSJLMUTL(PSGP,ON),"^"),P("DO")=$S($P(DN,"^",2)=.2:$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$G(^PS(55,PSGP,5,+PSJO,.3))),P("DO")=$P(P("DO"),"^")
.S Y=$G(^PS(53.1,+ON,.2)),P("MR")=$P($G(^PS(53.1,+ON,0)),U,3)_U_$P($G(^PS(51.2,+$P($G(^PS(53.1,+ON,0)),U,3),0)),U,3)
.W ?9,P("PD") D PIV1 W !?11,"Give: ",P("DO")," ",$P(P("MR"),U,2)," ",$S(P(9)]"":P(9),1:P(8))
S DRG=0 F S DRG=$O(DRG("AD",DRG)) Q:'DRG D PIVAD
SOL ;
NEW NAME
S DRG=0 F S DRG=$O(DRG("SOL",DRG)) Q:'DRG D
. D NAME(DRG("SOL",DRG),39,.NAME,0)
. W ! W:DRG=1 ?9,"in "
. F X=0:0 S X=$O(NAME(X)) Q:'X W ?12 W NAME(X) I X=1,DRG=1,'$D(DRG("AD",1)) D PIV1
Q
PIVAD ; Print IV Additives.
NEW NAME
D NAME(DRG("AD",DRG),39,.NAME,1)
F X=0:0 S X=$O(NAME(X)) Q:'X W:DRG'=1 ! W ?9,NAME(X) I X=1,DRG=1 D PIV1
Q
;
PIV1 ; Print Sched type, start/stop dates, and status.
F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,P(17) Q
W ?50,TYP,?53,P(2),?63,P(3),?73,P(17)
Q
59 ; Validate the Infusion rate entered using IV Quick order code.
N I F I=2,3,5,7,8,9,11,15,23 S P(I)=""
S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5)
I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1
I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59
I X]"" D ENI^PSIVSP S:$D(X) P(8)=X
Q
WRTDRG(X,L) ; Format and print drug name, strength and bottle no.
N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")"
Q $E($P(X,U,2),1,(L-$L(Y)))_Y
NAME(X,L,NAME,AD) ; Format Additive display.
;INPUT : X=DRG("AD",DRG) L=Display length AD=for Addtive(1/0)
;OUTPUT: AD(X) if X=2 that means there is a second line to display
K NAME
NEW Y S Y=$P(X,U,3) S:(AD&$P(X,U,4)) Y=Y_" ("_$P(X,U,4)_")"
S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@"))
I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)=" "_Y Q
S NAME(1)=$P(X,U,2)_" "_Y
Q
;
CNVTOM(RATE,TVOL) ; Convert volume to minutes
; Input:
; RATE - Infusion Rate
; TVOL - Volume being infused, EX: m100 (100 Milliliters) or l5 (5 Liters)
; Output:
; MINS - Minutes required to infuse volume
N DAYS,ML,MLSHR
; Get rate in terms of mils per hour
I 'RATE Q 0
I RATE<1 S RATE=1
S TVOL=$S($E(TVOL)="m":$E(TVOL,2,9),$E(TVOL)="l":$E(TVOL,2,9)*1000,1:0) Q:'TVOL 0
; Find IV duration in minutes
S MINS=(TVOL/RATE)*60
Q MINS
;
GETMIN(LIM,DFN,PSJORD,DAYS) ;
N F,DDLX
I LIM!(LIM=0) Q LIM
S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"")
N RATE S RATE=$S(PSJORD["P":+$P($G(@(F_"8)")),"^",5),PSJORD["V":+$P($G(@(F_"0)")),"^",8),1:0)
I (",l,m,")[(","_$E(LIM)_",") D
.I RATE D
..I RATE<1 S RATE=1
..S MIN=$$CNVTOM(RATE,LIM) I MIN S LIM=MIN
.I 'RATE N SOL,SOLVOL,DOSVOL,DUR,STOP,OIX,X S (SOLVOL,DOSVOL)="" D
..S SOL=0 F S SOL=$O(@(F_"""SOL"",SOL)")) Q:'SOL D
...S SOLVOL=$P(@(F_"""SOL"",SOL,0)"),"^",2) I SOLVOL S DOSVOL=DOSVOL+SOLVOL
..;PSJ*5*218 Prevent divide by zero
..I $G(DOSVOL) S DDLX=$S($E(LIM)["l":(($E(LIM,2,99)*1000)/DOSVOL),1:($E(LIM,2,99)/DOSVOL))_"L"
I (",a,")[(","_$E(LIM)_",") S DDLX=$E(LIM,2,99)_"L"
I $G(DDLX)>0 D
.N STOP,LASTD S DAYS="",STOP=""
.S OIX=$P($G(@(F_".2)")),"^") S:(DDLX<1) DDLX="1L" S LASTD=$$DOSES^PSIVCAL(DDLX,.P)
.I LASTD,$G(P(2)) S DAYS=$$FMDIFF^XLFDT(LASTD,P(2),2) I DAYS>0 S DAYS=DAYS/86400
.I DAYS>0 S LIM=DAYS*1440
I (",h,d,")[(","_$E(LIM)_",") S LIM=$S($E(LIM)="d":(1440*$E(LIM,2,99)),1:(60*$E(LIM,2,99))) Q
Q LIM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVUTL1 5715 printed Oct 16, 2024@18:05:58 Page 2
PSIVUTL1 ;BIR/MLM-IV UTILITIES ; 2/2/09 9:17am
+1 ;;5.0; INPATIENT MEDICATIONS ;**58,81,111,134,218**;16 DEC 97;Build 2
+2 ;
+3 ; Reference to ^PS(50.7 is supported by DBIA 2180
+4 ; Reference to ^PS(51.2 is supported by DBIA 2178
+5 ; Reference to ^PS(52.6 is supported by DBIA 1231
+6 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+7 ; Reference to ^PS(55 is supported by DBIA 2191
+8 ;
DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item.
+1 ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0
NEW OK,ND,NDU,NDI
SET OK=0
+2 SET ND=$GET(^PS(50.7,+Y,0))
+3 IF $PIECE(ND,U,3)
SET OK=$SELECT('$PIECE(ND,U,4):1,$PIECE(ND,U,4)>DT:1,1:0)
+4 QUIT OK
+5 ;
IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.
+1 ; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7
+2 NEW Y
SET Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)"
+3 QUIT Y
+4 ;
ENU(Y) ;Get IV additive strength.
+1 NEW X
SET X=$PIECE(^PS(52.6,+Y,0),U,3)
SET Y=$$CODES^PSIVUTL(X,52.6,2)
+2 QUIT Y
+3 ;
CODES(X,Y) ; Get name from code.
+1 SET Y=$PIECE($PIECE(";"_$PIECE(Y,U,3),";"_X_":",2),";")
+2 QUIT Y
+3 ;
GTPCI(Y) ; Set up "work" area for provider comments.
+1 NEW DIC,DINUM,DLAYGO,X
SET DIC="^PS(53.45,"
SET DIC(0)="LNZ"
SET DLAYGO=53.45
SET (DINUM,X)=+DUZ
DO ^DIC
+2 QUIT Y
+3 ;
WDTE(Y) ; Format and print date.
+1 IF 'Y
SET Y="******"
+2 IF '$TEST
XECUTE ^DD("DD")
SET Y=$PIECE(Y,"@")_" "_$PIECE($PIECE(Y,"@",2),":",1,2)
+3 QUIT Y
GTOT(DFN,ON) ; Get order type for display.
+1 NEW DRGT,DRGI,Y
+2 SET X=$PIECE($GET(^PS(55,DFN,"IV",ON,0)),U,4)
+3 SET Y=$SELECT(X="A":"F",X="H":"H",1:"I")
+4 IF Y="F"
FOR DRGT="AD","SOL"
FOR DRGI=0:0
SET DRGI=$ORDER(^PS(55,DFN,"IV",+ON,DRGT,DRGI))
if 'DRGI
QUIT
IF '$PIECE($GET(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5)
SET Y="I"
QUIT
+5 QUIT Y
+6 ;
PIV(ON) ; Display IV orders.
+1 NEW DRG,ON55,P,PSJORIFN,TYP,X,Y
SET TYP="?"
IF ON["V"
Begin DoDot:1
+2 SET Y=$GET(^PS(55,DFN,"IV",+ON,0))
FOR X=2,3,4,5,8,9,17,23
SET P(X)=$PIECE(Y,U,X)
+3 SET TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
IF TYP'="O"
SET TYP="C"
+4 SET ON55=ON
SET P("OT")=$SELECT(P(4)="A":"F",P(4)="H":"H",1:"I")
DO GTDRG^PSIVORFB
DO GTOT^PSIVUTL(P(4))
End DoDot:1
+5 IF ON'["V"
SET (P(2),P(3))=""
SET P(17)=$PIECE($GET(^PS(53.1,+ON,0)),U,9)
SET Y=$GET(^(8))
SET P(4)=$PIECE(Y,U)
SET P(8)=$PIECE(Y,U,5)
SET P(9)=$PIECE($GET(^(2)),U)
DO GTDRG^PSIVORFA
DO GTOT^PSIVUTL(P(4))
IF $EXTRACT(P("OT"))="I"
Begin DoDot:1
+6 SET P("PD")=$PIECE($$DRUGNAME^PSJLMUTL(PSGP,ON),"^")
SET P("DO")=$SELECT($PIECE(DN,"^",2)=.2:$PIECE($GET(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$GET(^PS(55,PSGP,5,+PSJO,.3)))
SET P("DO")=$PIECE(P("DO"),"^")
+7 SET Y=$GET(^PS(53.1,+ON,.2))
SET P("MR")=$PIECE($GET(^PS(53.1,+ON,0)),U,3)_U_$PIECE($GET(^PS(51.2,+$PIECE($GET(^PS(53.1,+ON,0)),U,3),0)),U,3)
+8 WRITE ?9,P("PD")
DO PIV1
WRITE !?11,"Give: ",P("DO")," ",$PIECE(P("MR"),U,2)," ",$SELECT(P(9)]"":P(9),1:P(8))
End DoDot:1
QUIT
+9 SET DRG=0
FOR
SET DRG=$ORDER(DRG("AD",DRG))
if 'DRG
QUIT
DO PIVAD
SOL ;
+1 NEW NAME
+2 SET DRG=0
FOR
SET DRG=$ORDER(DRG("SOL",DRG))
if 'DRG
QUIT
Begin DoDot:1
+3 DO NAME(DRG("SOL",DRG),39,.NAME,0)
+4 WRITE !
if DRG=1
WRITE ?9,"in "
+5 FOR X=0:0
SET X=$ORDER(NAME(X))
if 'X
QUIT
WRITE ?12
WRITE NAME(X)
IF X=1
IF DRG=1
IF '$DATA(DRG("AD",1))
DO PIV1
End DoDot:1
+6 QUIT
PIVAD ; Print IV Additives.
+1 NEW NAME
+2 DO NAME(DRG("AD",DRG),39,.NAME,1)
+3 FOR X=0:0
SET X=$ORDER(NAME(X))
if 'X
QUIT
if DRG'=1
WRITE !
WRITE ?9,NAME(X)
IF X=1
IF DRG=1
DO PIV1
+4 QUIT
+5 ;
PIV1 ; Print Sched type, start/stop dates, and status.
+1 FOR X=2,3
SET P(X)=$EXTRACT($$ENDTC^PSGMI(P(X)),1,$SELECT($DATA(PSJEXTP):8,1:5))
+2 IF '$DATA(PSJEXTP)
WRITE ?50,TYP,?53,P(2),?60,P(3),?67,P(17)
QUIT
+3 WRITE ?50,TYP,?53,P(2),?63,P(3),?73,P(17)
+4 QUIT
59 ; Validate the Infusion rate entered using IV Quick order code.
+1 NEW I
FOR I=2,3,5,7,8,9,11,15,23
SET P(I)=""
+2 SET P(4)="A"
SET P(8)=$PIECE($GET(^PS(57.1,PSJQO,1)),U,5)
+3 IF $GET(^PS(57.1,PSJQO,4,1,0))
SET DRG("SOL",1)=^(0)
SET DRG("SOL",0)=1
+4 IF X["?"
SET F1=53.1
SET F2=59
DO ENHLP^PSIVORC1
GOTO 59
+5 IF X]""
DO ENI^PSIVSP
if $DATA(X)
SET P(8)=X
+6 QUIT
WRTDRG(X,L) ; Format and print drug name, strength and bottle no.
+1 NEW Y
SET Y=" "_$PIECE(X,U,3)
if $PIECE(X,U,4)
SET Y=Y_" ("_$PIECE(X,U,4)_")"
+2 QUIT $EXTRACT($PIECE(X,U,2),1,(L-$LENGTH(Y)))_Y
NAME(X,L,NAME,AD) ; Format Additive display.
+1 ;INPUT : X=DRG("AD",DRG) L=Display length AD=for Addtive(1/0)
+2 ;OUTPUT: AD(X) if X=2 that means there is a second line to display
+3 KILL NAME
+4 NEW Y
SET Y=$PIECE(X,U,3)
if (AD&$PIECE(X,U,4))
SET Y=Y_" ("_$PIECE(X,U,4)_")"
+5 if 'AD
SET Y=Y_" "_$SELECT(P(4)="P"!($GET(P(23))="P")!$GET(P(5)):P(9),1:$PIECE(P(8),"@"))
+6 IF ($LENGTH($PIECE(X,U,2))+$LENGTH(Y)+1)>L
SET NAME(1)=$PIECE(X,U,2)
SET NAME(2)=" "_Y
QUIT
+7 SET NAME(1)=$PIECE(X,U,2)_" "_Y
+8 QUIT
+9 ;
CNVTOM(RATE,TVOL) ; Convert volume to minutes
+1 ; Input:
+2 ; RATE - Infusion Rate
+3 ; TVOL - Volume being infused, EX: m100 (100 Milliliters) or l5 (5 Liters)
+4 ; Output:
+5 ; MINS - Minutes required to infuse volume
+6 NEW DAYS,ML,MLSHR
+7 ; Get rate in terms of mils per hour
+8 IF 'RATE
QUIT 0
+9 IF RATE<1
SET RATE=1
+10 SET TVOL=$SELECT($EXTRACT(TVOL)="m":$EXTRACT(TVOL,2,9),$EXTRACT(TVOL)="l":$EXTRACT(TVOL,2,9)*1000,1:0)
if 'TVOL
QUIT 0
+11 ; Find IV duration in minutes
+12 SET MINS=(TVOL/RATE)*60
+13 QUIT MINS
+14 ;
GETMIN(LIM,DFN,PSJORD,DAYS) ;
+1 NEW F,DDLX
+2 IF LIM!(LIM=0)
QUIT LIM
+3 SET F=$SELECT(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"")
+4 NEW RATE
SET RATE=$SELECT(PSJORD["P":+$PIECE($GET(@(F_"8)")),"^",5),PSJORD["V":+$PIECE($GET(@(F_"0)")),"^",8),1:0)
+5 IF (",l,m,")[(","_$EXTRACT(LIM)_",")
Begin DoDot:1
+6 IF RATE
Begin DoDot:2
+7 IF RATE<1
SET RATE=1
+8 SET MIN=$$CNVTOM(RATE,LIM)
IF MIN
SET LIM=MIN
End DoDot:2
+9 IF 'RATE
NEW SOL,SOLVOL,DOSVOL,DUR,STOP,OIX,X
SET (SOLVOL,DOSVOL)=""
Begin DoDot:2
+10 SET SOL=0
FOR
SET SOL=$ORDER(@(F_"""SOL"",SOL)"))
if 'SOL
QUIT
Begin DoDot:3
+11 SET SOLVOL=$PIECE(@(F_"""SOL"",SOL,0)"),"^",2)
IF SOLVOL
SET DOSVOL=DOSVOL+SOLVOL
End DoDot:3
+12 ;PSJ*5*218 Prevent divide by zero
+13 IF $GET(DOSVOL)
SET DDLX=$SELECT($EXTRACT(LIM)["l":(($EXTRACT(LIM,2,99)*1000)/DOSVOL),1:($EXTRACT(LIM,2,99)/DOSVOL))_"L"
End DoDot:2
End DoDot:1
+14 IF (",a,")[(","_$EXTRACT(LIM)_",")
SET DDLX=$EXTRACT(LIM,2,99)_"L"
+15 IF $GET(DDLX)>0
Begin DoDot:1
+16 NEW STOP,LASTD
SET DAYS=""
SET STOP=""
+17 SET OIX=$PIECE($GET(@(F_".2)")),"^")
if (DDLX<1)
SET DDLX="1L"
SET LASTD=$$DOSES^PSIVCAL(DDLX,.P)
+18 IF LASTD
IF $GET(P(2))
SET DAYS=$$FMDIFF^XLFDT(LASTD,P(2),2)
IF DAYS>0
SET DAYS=DAYS/86400
+19 IF DAYS>0
SET LIM=DAYS*1440
End DoDot:1
+20 IF (",h,d,")[(","_$EXTRACT(LIM)_",")
SET LIM=$SELECT($EXTRACT(LIM)="d":(1440*$EXTRACT(LIM,2,99)),1:(60*$EXTRACT(LIM,2,99)))
QUIT
+21 QUIT LIM
