PSIVLABR ;BIR/PR-REPRINT LABELS ;30 May 2001 12:36 PM
;;5.0;INPATIENT MEDICATIONS;**58,82,178,184,279,331,364**;16 DEC 97;Build 47
;
; Reference to ^%ZIS(2 is supported by DBIA 3435.
; 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.
; Reference to ^PS(51.2 is supported by DBIA 2178.
;
;Needs DFN,ON, and PSIVNOL NOTE: If PSIVCT is defined then we do
;not count labels in the STATs file or increment cummulative doses or
;the last fill field.
;PSIVCT will be defined if reprinting scheduled labels, the suspense
;list, or if printing individual labels and they do not count.
;
;*364 - add Hazardous Handle & Dispose flags alert message.
;
DEM ;Get demographics and see if label is example only
N X0,PSJIO,I,PSIVCLAB
S I=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSJIO($P(X0,"^"))=^(1)
S PSJIO=$S('$D(PSJIO):0,1:1)
N PSIVCLIN,PSIVCLDT S PSIVCLIN=$G(^PS(55,DFN,"IV",+ON,"DSS")) S:'(PSIVCLIN>0) PSIVCLIN="" I PSIVCLIN D
.S PSIVCLDT=$P(PSIVCLIN,"^",2) S $P(PSIVCLIN,"^",2)=$P($G(^SC(+PSIVCLIN,0)),"^")
I $G(PSIVCLIN) S PSIVCLAB=$P($G(^SC(+PSIVCLIN,0)),"^",2)
D ENIV^PSJAC,NOW^%DTC S PSIVNOW=$$ENDTC^PSGMI(%),VADM(2)=$E(VADM(2),6,9)
S PSIVWD=$S((+VAIN(4)&'$G(PSIVCLDT)):$P(VAIN(4),U,2),$G(PSIVCLIN)&($G(PSIVCLAB)]""):PSIVCLAB,$G(PSIVCLIN)&($P($G(PSIVCLIN),"^",2)]""):$P(PSIVCLIN,"^",2),1:"Opt. IV") I $D(PSIVEXAM) G ENX
;
;;NEW PSIVNOL,PSIV1 S (PSIVNOL,PSIV1)=1
NEW PSIV1 S PSIV1=1
G:PSIVNOL<1 Q D SETP S PSIVRM=$P(PSIVSITE,U,13),P16=$P($G(^PS(55,DFN,"IV",+ON,9)),U,3) S:PSIVRM<1 PSIVRM=30 I $D(PSIVCT),PSIVCT'=1 K PSIVCT
I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
;PSJRPHD is defined in REPRT^PSIVLBRP so header only print once.
I $P(PSIVSITE,U,7),'$D(PSJRPHD) D
. S PSIVFLAG=1,(LINE,PSIV1)=0,PSIV2=PSIVNOL,PSIVNOL=0 D RE
. S PSIVRP="",PSIVRT=""
. I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
.. I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) Q ;QUIT IF "DOSE DUE AT" IS SET TO NOT PRINT
.. S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
.. S X="ROUTE: "_PSIVRT D:X]"" PMR
. S X="Solution: _______________" D P S X="Additive: _______________" D P
. S PSIVNOL=PSIV2
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
;;I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+PSIVNOL
I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+1
K PSIVFLAG,PSIVSH G START
SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)
Q
ENX ;Print example label
D SETP S PSIVFLAG=1,PSIVRM=$P(PSIVSITE,U,13) S:PSIVRM<1 PSIVRM=30
START S PSIV1=1,LINE=0 D RE D
. Q:$D(PSIVFLAG)
. I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
. I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
D:'$D(PSIVCT) ^PSIVSTAT
Q K PSIV,PSIVDOSE,PSIVCT,PSIVWD,P16,LINE,MESS,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS Q
RE ;
;NEED THE CODE BELOW?
;;I PSIV1,P(4)="A"!(P(5)=0) S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=PSIV1
I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
I PSIV1 D BARCODE
S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_PSIVWD_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
I ($G(PSIVCLIN)>0),$L($G(PSIVRM)),'$G(VAIN(4)) N PSJTRNC S PSJTRNC=$L(X)-+$G(PSIVRM) I PSJTRNC>0,($L(PSIVWD)>PSJTRNC) D
. S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_$E(PSIVWD,1,$L(PSIVWD)-PSJTRNC)_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
D P
;D
;.N PSJICW,TMPX,TMPX1,TMPX2 S TMPX=X,TMPX1="" I $L(TMPX)>(PSIVRM-1) F PSJICW=1:1:$L(TMPX," ") S TMPX1=TMPX1_$S(PSJICW=1:"",1:" ")_$P(TMPX," ",PSJICW) I $L(TMPX1)+$L($P(TMPX," ",PSJICW+1))>(PSIVRM-1) S X=TMPX1 D P S TMPX1="",X=""
;.I TMPX1]"" S X=TMPX1 D P
S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_" "_$S(VAIN(5)]"":VAIN(5),1:"NF") D P S X=" " D P
I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),"^"),1:"*********")_" "_$P(Y,U,2)_" " S:$P(Y,U,3)]"" X=X_" ("_$P(Y,U,3)_")" D
. D P,MESS,HAZ(1)
G:$D(PSIVFLAG) SOL
F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",PSIV)) Q:'PSIV S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),U),1:"********")_" "_$P(Y,U,2) D
. D P,MESS,HAZ(1)
SOL F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
. D SOL1,P,HAZ(2)
. S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X=" "_X D P
I P(23)'=""!(P(4)="S") S X="In Syringe: "_$E($P(^PS(55,DFN,"IV",+ON,2),U,4),1,25) D:P(4)="S"!(P(23)="S") P S X="*CAUTION* - CHEMOTHERAPY" D:P(23)'="" P
S X=" " D P I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) G MEDRT
S:'$D(PSIVDOSE) PSIVDOSE="" S X=$P(PSIVDOSE," ",PSIV1) D:$E(X)="." CONVER S X="Dose due at: "_$S(X="":"________",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X#1_"000",2,5)) D P
;
MEDRT ;Find Medication Route
S PSIVRP="",PSIVRT=""
I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
.S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
.S X="ROUTE: "_PSIVRT D:X]"" PMR
;
INF S X=$P(P(8),"@") D:X]"" P
I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),"^") D:X]"" P
S X=P(9) D:X]"" P
S X=P(11) D:X]"" P
;PSJ*5*184 - Display all messages if more than one additive has a message.
I $D(MESS) S PSIMESS="" F S PSIMESS=$O(MESS(PSIMESS)) Q:PSIMESS="" S X=PSIMESS D P
I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X="" D P
;S X=PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]"_" "_$S('PSIV1:PSIVNOW,1:"") D P
S X=PSIVBAG D P
Q
P F LINE=LINE+1:1 D Q:$L(X)<1
. I LINE>PSIVSITE D
.. S LINE=1
.. I 'PSJIO D Q
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
. K ZZ
. F I="ST","STF" I $G(PSJIO(I))]"" X PSJIO(I)
. W $E(X,1,PSIVRM)
. F I="ETF","ET" I $G(PSJIO(I))]"" X PSJIO(I)
. I 'PSJIO W !
. S X=$E(X,PSIVRM+1,999)
Q
PMR ; Print Med Route on label
;
F LINE=LINE+1:1 D Q:$L(X)<1
. I LINE>PSIVSITE D
.. S LINE=1
.. I 'PSJIO D Q
... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16) W !
.. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
. K ZZ
. ;
. F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
. W $E(X,1,PSIVRM)
. F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
. I 'PSJIO W !
. S X=$E(X,PSIVRM+1,999)
Q
SOL1 S X=$S($D(^PS(52.7,$P(PSIV,U,2),0)):$P(^(0),"^")_" "_$P(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",+PSIV,0),U,2),1:"**********") Q
MESS ;PSJ*5*184 -make MESS a local array so all messages display for all additives.
I $P(^PS(52.6,+Y,0),U,9)]"" S MESS($P(^PS(52.6,+Y,0),U,9))=""
Q
HAZ(TYP) ; Printing hazardous to handle/dispose warnings *364
; TYP=1 ADDITIVES | TYPE=2 SOLUTIONS
N DIEN,FIL,HAZ,TSUB,VAR
S FIL=$S($G(TYP)=1:52.6,$G(TYP)=2:52.7,1:"") Q:FIL="" ; No type passed in
S TSUB=$S(TYP=1:"AD",TYP=2:"SOL",1:"NONE")
S VAR=^PS(55,DFN,"IV",+ON,TSUB,+PSIV,0) S DIEN=$P($G(^PS(FIL,+VAR,0)),"^",2),HAZ=$$HAZ^PSSUTIL(DIEN)
S X=$S($P(HAZ,"^"):"<<HAZ Handle>> ",1:"")_$S($P(HAZ,"^",2):"<<HAZ Dispose>>",1:"")
I X]"" D P
Q
;
CONVER ;Expand dose to date.dose and set in X
I P(15)>1440 S X=$$CONVER1^PSIVORE2($P(PSIVDOSE," "),P(15),(PSIV1-1)) Q
S PDOSE=X S:PSIV1=2 PDATE=$E($P(PSIVDOSE," "),1,7)
I $P(PSIVDOSE," ",PSIV1-1)#1'<PDOSE!(P(15)>1440) S:$D(X1) XX1=X1 S:$D(X2) XX2=X2 S X1=PDATE,X2=1 D C^%DTC S PDATE=X,X=X_PDOSE S:$D(XX1) X1=XX1 S:$D(XX2) X2=XX2 Q
S X=PDATE_PDOSE
Q
BARCODE D PSET^%ZISP
I 'PSJIO D
. I IOBARON]"" W @IOBARON
. W PSJBCID
. I IOBAROFF]"" W @IOBAROFF
. W !
I PSJIO D
. F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
. W PSJBCID
. F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVLABR 8031 printed Jan 18, 2025@03:05:32 Page 2
PSIVLABR ;BIR/PR-REPRINT LABELS ;30 May 2001 12:36 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**58,82,178,184,279,331,364**;16 DEC 97;Build 47
+2 ;
+3 ; Reference to ^%ZIS(2 is supported by DBIA 3435.
+4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+6 ; Reference to ^PS(55 is supported by DBIA 2191.
+7 ; Reference to ^PS(51.2 is supported by DBIA 2178.
+8 ;
+9 ;Needs DFN,ON, and PSIVNOL NOTE: If PSIVCT is defined then we do
+10 ;not count labels in the STATs file or increment cummulative doses or
+11 ;the last fill field.
+12 ;PSIVCT will be defined if reprinting scheduled labels, the suspense
+13 ;list, or if printing individual labels and they do not count.
+14 ;
+15 ;*364 - add Hazardous Handle & Dispose flags alert message.
+16 ;
DEM ;Get demographics and see if label is example only
+1 NEW X0,PSJIO,I,PSIVCLAB
+2 SET I=0
FOR
SET I=$ORDER(^%ZIS(2,IOST(0),55,I))
if 'I
QUIT
SET X0=$GET(^(I,0))
IF X0]""
SET PSJIO($PIECE(X0,"^"))=^(1)
+3 SET PSJIO=$SELECT('$DATA(PSJIO):0,1:1)
+4 NEW PSIVCLIN,PSIVCLDT
SET PSIVCLIN=$GET(^PS(55,DFN,"IV",+ON,"DSS"))
if '(PSIVCLIN>0)
SET PSIVCLIN=""
IF PSIVCLIN
Begin DoDot:1
+5 SET PSIVCLDT=$PIECE(PSIVCLIN,"^",2)
SET $PIECE(PSIVCLIN,"^",2)=$PIECE($GET(^SC(+PSIVCLIN,0)),"^")
End DoDot:1
+6 IF $GET(PSIVCLIN)
SET PSIVCLAB=$PIECE($GET(^SC(+PSIVCLIN,0)),"^",2)
+7 DO ENIV^PSJAC
DO NOW^%DTC
SET PSIVNOW=$$ENDTC^PSGMI(%)
SET VADM(2)=$EXTRACT(VADM(2),6,9)
+8 SET PSIVWD=$SELECT((+VAIN(4)&'$GET(PSIVCLDT)):$PIECE(VAIN(4),U,2),$GET(PSIVCLIN)&($GET(PSIVCLAB)]""):PSIVCLAB,$GET(PSIVCLIN)&($PIECE($GET(PSIVCLIN),"^",2)]""):$PIECE(PSIVCLIN,"^",2),1:"Opt. IV")
IF $DATA(PSIVEXAM)
GOTO ENX
+9 ;
+10 ;;NEW PSIVNOL,PSIV1 S (PSIVNOL,PSIV1)=1
+11 NEW PSIV1
SET PSIV1=1
+12 if PSIVNOL<1
GOTO Q
DO SETP
SET PSIVRM=$PIECE(PSIVSITE,U,13)
SET P16=$PIECE($GET(^PS(55,DFN,"IV",+ON,9)),U,3)
if PSIVRM<1
SET PSIVRM=30
IF $DATA(PSIVCT)
IF PSIVCT'=1
KILL PSIVCT
+13 IF PSJIO
IF $GET(PSJIO("FI"))]""
XECUTE PSJIO("FI")
+14 ;PSJRPHD is defined in REPRT^PSIVLBRP so header only print once.
+15 IF $PIECE(PSIVSITE,U,7)
IF '$DATA(PSJRPHD)
Begin DoDot:1
+16 SET PSIVFLAG=1
SET (LINE,PSIV1)=0
SET PSIV2=PSIVNOL
SET PSIVNOL=0
DO RE
+17 SET PSIVRP=""
SET PSIVRT=""
+18 IF $DATA(^PS(55,DFN,"IV",+ON,.2))
SET PSIVRP=$PIECE(^PS(55,DFN,"IV",+ON,.2),U,3)
Begin DoDot:2
+19 ;QUIT IF "DOSE DUE AT" IS SET TO NOT PRINT
IF PSIV1'>0!'$PIECE(PSIVSITE,U,3)!($PIECE(PSIVSITE,U,3)=1&(P(4)'="P"))!($PIECE(PSIVSITE,U,3)=2&("AH"'[P(4)))
QUIT
+20 SET PSIVRT=$PIECE(^PS(51.2,PSIVRP,0),U,1)
+21 SET X="ROUTE: "_PSIVRT
if X]""
DO PMR
End DoDot:2
+22 SET X="Solution: _______________"
DO P
SET X="Additive: _______________"
DO P
+23 SET PSIVNOL=PSIV2
+24 IF 'PSJIO
FOR LINE=LINE+1:1:(PSIVSITE+$PIECE(PSIVSITE,U,16))
WRITE !
+25 IF PSJIO
IF $GET(PSJIO("EL"))]""
XECUTE PSJIO("EL")
End DoDot:1
+26 ;;I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+PSIVNOL
+27 IF '$DATA(PSIVCT)
DO NOW^%DTC
SET Y=%
SET $PIECE(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL
SET $PIECE(^(9),U,3)=$PIECE(^(9),U,3)+1
+28 KILL PSIVFLAG,PSIVSH
GOTO START
SETP SET Y=^PS(55,DFN,"IV",+ON,0)
FOR X=1:1:23
SET P(X)=$PIECE(Y,U,X)
+1 QUIT
ENX ;Print example label
+1 DO SETP
SET PSIVFLAG=1
SET PSIVRM=$PIECE(PSIVSITE,U,13)
if PSIVRM<1
SET PSIVRM=30
START SET PSIV1=1
SET LINE=0
DO RE
Begin DoDot:1
+1 if $DATA(PSIVFLAG)
QUIT
+2 IF 'PSJIO
FOR LINE=LINE+1:1:(PSIVSITE+$PIECE(PSIVSITE,U,16))
WRITE !
+3 IF PSJIO
IF $GET(PSJIO("EL"))]""
XECUTE PSJIO("EL")
End DoDot:1
+4 IF PSJIO
IF $GET(PSJIO("FE"))]""
XECUTE PSJIO("FE")
+5 if '$DATA(PSIVCT)
DO ^PSIVSTAT
Q KILL PSIV,PSIVDOSE,PSIVCT,PSIVWD,P16,LINE,MESS,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS
QUIT
RE ;
+1 ;NEED THE CODE BELOW?
+2 ;;I PSIV1,P(4)="A"!(P(5)=0) S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=PSIV1
+3 IF PSJIO
IF $GET(PSJIO("SL"))]""
XECUTE PSJIO("SL")
+4 IF PSIV1
DO BARCODE
+5 SET X="["_$PIECE(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_PSIVWD_" "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+6 IF ($GET(PSIVCLIN)>0)
IF $LENGTH($GET(PSIVRM))
IF '$GET(VAIN(4))
NEW PSJTRNC
SET PSJTRNC=$LENGTH(X)-+$GET(PSIVRM)
IF PSJTRNC>0
IF ($LENGTH(PSIVWD)>PSJTRNC)
Begin DoDot:1
+7 SET X="["_$PIECE(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_" "_$EXTRACT(PSIVWD,1,$LENGTH(PSIVWD)-PSJTRNC)_" "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
End DoDot:1
+8 DO P
+9 ;D
+10 ;.N PSJICW,TMPX,TMPX1,TMPX2 S TMPX=X,TMPX1="" I $L(TMPX)>(PSIVRM-1) F PSJICW=1:1:$L(TMPX," ") S TMPX1=TMPX1_$S(PSJICW=1:"",1:" ")_$P(TMPX," ",PSJICW) I $L(TMPX1)+$L($P(TMPX," ",PSJICW+1))>(PSIVRM-1) S X=TMPX1 D P S TMPX1="",X=""
+11 ;.I TMPX1]"" S X=TMPX1 D P
+12 SET X=VADM(1)
if $PIECE(PSIVSITE,U,9)
SET X=X_" "_$SELECT(VAIN(5)]"":VAIN(5),1:"NF")
DO P
SET X=" "
DO P
+13 IF $DATA(PSIVFLAG)
FOR PSIV=0:0
SET PSIV=$ORDER(^PS(55,DFN,"IV",+ON,"AD",PSIV))
if 'PSIV
QUIT
SET Y=^(PSIV,0)
SET X=$SELECT($DATA(^PS(52.6,+Y,0)):$PIECE(^(0),"^"),1:"*********")_" "_$PIECE(Y,U,2)_" "
if $PIECE(Y,U,3)]""
SET X=X_" ("_$PIECE(Y,U,3)_")"
Begin DoDot:1
+14 DO P
DO MESS
DO HAZ(1)
End DoDot:1
+15 if $DATA(PSIVFLAG)
GOTO SOL
+16 FOR PSIV=0:0
SET PSIV=$ORDER(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",PSIV))
if 'PSIV
QUIT
SET Y=^(PSIV,0)
SET X=$SELECT($DATA(^PS(52.6,+Y,0)):$PIECE(^(0),U),1:"********")_" "_$PIECE(Y,U,2)
Begin DoDot:1
+17 DO P
DO MESS
DO HAZ(1)
End DoDot:1
SOL FOR PSIV=0:0
SET PSIV=$ORDER(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSIV))
if 'PSIV
QUIT
SET PSIV=PSIV_"^"_+^(PSIV,0)
SET YY=^(0)
Begin DoDot:1
+1 DO SOL1
DO P
DO HAZ(2)
+2 SET X=$PIECE(^PS(52.7,$PIECE(PSIV,U,2),0),U,4)
IF X]""
SET X=" "_X
DO P
End DoDot:1
+3 IF P(23)'=""!(P(4)="S")
SET X="In Syringe: "_$EXTRACT($PIECE(^PS(55,DFN,"IV",+ON,2),U,4),1,25)
if P(4)="S"!(P(23)="S")
DO P
SET X="*CAUTION* - CHEMOTHERAPY"
if P(23)'=""
DO P
+4 SET X=" "
DO P
IF PSIV1'>0!'$PIECE(PSIVSITE,U,3)!($PIECE(PSIVSITE,U,3)=1&(P(4)'="P"))!($PIECE(PSIVSITE,U,3)=2&("AH"'[P(4)))
GOTO MEDRT
+5 if '$DATA(PSIVDOSE)
SET PSIVDOSE=""
SET X=$PIECE(PSIVDOSE," ",PSIV1)
if $EXTRACT(X)="."
DO CONVER
SET X="Dose due at: "_$SELECT(X="":"________",1:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_" "_$EXTRACT(X#1_"000",2,5))
DO P
+6 ;
MEDRT ;Find Medication Route
+1 SET PSIVRP=""
SET PSIVRT=""
+2 IF $DATA(^PS(55,DFN,"IV",+ON,.2))
SET PSIVRP=$PIECE(^PS(55,DFN,"IV",+ON,.2),U,3)
Begin DoDot:1
+3 SET PSIVRT=$PIECE(^PS(51.2,PSIVRP,0),U,1)
+4 SET X="ROUTE: "_PSIVRT
if X]""
DO PMR
End DoDot:1
+5 ;
INF SET X=$PIECE(P(8),"@")
if X]""
DO P
+1 IF $DATA(^PS(55,DFN,"IV",+ON,3))
SET X=$PIECE(^(3),"^")
if X]""
DO P
+2 SET X=P(9)
if X]""
DO P
+3 SET X=P(11)
if X]""
DO P
+4 ;PSJ*5*184 - Display all messages if more than one additive has a message.
+5 IF $DATA(MESS)
SET PSIMESS=""
FOR
SET PSIMESS=$ORDER(MESS(PSIMESS))
if PSIMESS=""
QUIT
SET X=PSIMESS
DO P
+6 IF $DATA(^PS(59.5,PSIVSN,4))
SET Y=^(4)
FOR PSIV=1:1
SET X=$PIECE(Y,U,PSIV)
if X=""
QUIT
DO P
+7 ;S X=PSIV1_"["_$S(PSIV1:PSIVNOL,1:PSIV2)_"]"_" "_$S('PSIV1:PSIVNOW,1:"") D P
+8 SET X=PSIVBAG
DO P
+9 QUIT
P FOR LINE=LINE+1:1
Begin DoDot:1
+1 IF LINE>PSIVSITE
Begin DoDot:2
+2 SET LINE=1
+3 IF 'PSJIO
Begin DoDot:3
+4 FOR ZZ=1:1
if ZZ>$PIECE(PSIVSITE,"^",16)
QUIT
WRITE !
End DoDot:3
QUIT
+5 FOR I="EL","SL"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
End DoDot:2
+6 KILL ZZ
+7 FOR I="ST","STF"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
+8 WRITE $EXTRACT(X,1,PSIVRM)
+9 FOR I="ETF","ET"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
+10 IF 'PSJIO
WRITE !
+11 SET X=$EXTRACT(X,PSIVRM+1,999)
End DoDot:1
if $LENGTH(X)<1
QUIT
+12 QUIT
PMR ; Print Med Route on label
+1 ;
+2 FOR LINE=LINE+1:1
Begin DoDot:1
+3 IF LINE>PSIVSITE
Begin DoDot:2
+4 SET LINE=1
+5 IF 'PSJIO
Begin DoDot:3
+6 FOR ZZ=1:1
if ZZ>$PIECE(PSIVSITE,"^",16)
QUIT
WRITE !
End DoDot:3
QUIT
+7 FOR I="EL","SL"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
End DoDot:2
+8 KILL ZZ
+9 ;
+10 FOR I="ST","STF","SM","SMF"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
+11 WRITE $EXTRACT(X,1,PSIVRM)
+12 FOR I="ETF","ET","EMF","EM"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
+13 IF 'PSJIO
WRITE !
+14 SET X=$EXTRACT(X,PSIVRM+1,999)
End DoDot:1
if $LENGTH(X)<1
QUIT
+15 QUIT
SOL1 SET X=$SELECT($DATA(^PS(52.7,$PIECE(PSIV,U,2),0)):$PIECE(^(0),"^")_" "_$PIECE(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",+PSIV,0),U,2),1:"**********")
QUIT
MESS ;PSJ*5*184 -make MESS a local array so all messages display for all additives.
+1 IF $PIECE(^PS(52.6,+Y,0),U,9)]""
SET MESS($PIECE(^PS(52.6,+Y,0),U,9))=""
+2 QUIT
HAZ(TYP) ; Printing hazardous to handle/dispose warnings *364
+1 ; TYP=1 ADDITIVES | TYPE=2 SOLUTIONS
+2 NEW DIEN,FIL,HAZ,TSUB,VAR
+3 ; No type passed in
SET FIL=$SELECT($GET(TYP)=1:52.6,$GET(TYP)=2:52.7,1:"")
if FIL=""
QUIT
+4 SET TSUB=$SELECT(TYP=1:"AD",TYP=2:"SOL",1:"NONE")
+5 SET VAR=^PS(55,DFN,"IV",+ON,TSUB,+PSIV,0)
SET DIEN=$PIECE($GET(^PS(FIL,+VAR,0)),"^",2)
SET HAZ=$$HAZ^PSSUTIL(DIEN)
+6 SET X=$SELECT($PIECE(HAZ,"^"):"<<HAZ Handle>> ",1:"")_$SELECT($PIECE(HAZ,"^",2):"<<HAZ Dispose>>",1:"")
+7 IF X]""
DO P
+8 QUIT
+9 ;
CONVER ;Expand dose to date.dose and set in X
+1 IF P(15)>1440
SET X=$$CONVER1^PSIVORE2($PIECE(PSIVDOSE," "),P(15),(PSIV1-1))
QUIT
+2 SET PDOSE=X
if PSIV1=2
SET PDATE=$EXTRACT($PIECE(PSIVDOSE," "),1,7)
+3 IF $PIECE(PSIVDOSE," ",PSIV1-1)#1'<PDOSE!(P(15)>1440)
if $DATA(X1)
SET XX1=X1
if $DATA(X2)
SET XX2=X2
SET X1=PDATE
SET X2=1
DO C^%DTC
SET PDATE=X
SET X=X_PDOSE
if $DATA(XX1)
SET X1=XX1
if $DATA(XX2)
SET X2=XX2
QUIT
+4 SET X=PDATE_PDOSE
+5 QUIT
BARCODE DO PSET^%ZISP
+1 IF 'PSJIO
Begin DoDot:1
+2 IF IOBARON]""
WRITE @IOBARON
+3 WRITE PSJBCID
+4 IF IOBAROFF]""
WRITE @IOBAROFF
+5 WRITE !
End DoDot:1
+6 IF PSJIO
Begin DoDot:1
+7 FOR I="SB","SBF"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
+8 WRITE PSJBCID
+9 FOR I="EBF","EB"
IF $GET(PSJIO(I))]""
XECUTE PSJIO(I)
End DoDot:1
+10 QUIT
