PSIVHYPL.m

PSIVHYPL ;BIR/PR-PRINT OUT LABELS ;26 FEB 97 / 3:20 PM

 ;;5.0;INPATIENT MEDICATIONS;**58,96,128,178,184,279,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(50.4 is supported by DBIA 2175.

 ; Reference to ^PS(51.2 is supported by DBIA 2178.

 ;

 ;NEEDS DFN, ON AND PSIVNOL (Total number of labels to print) and

 ;PSIVCT - $D(PSIVCT) NO COUNT LABEL

 ;*364 - add Hazardous Handle & Dispose flags alert message.

 ;

SSWARD ;Get patient SS# and ward location

 N ZGSN

 N X0,PSJIO,I,PSIVCLAB

 S I=0 F  S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I  S X0=^(I,0),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 S VADM(2)=$E(VADM(2),6,9),PSIVWD=$S(+VAIN(4):$P(VAIN(4),U,2),$G(PSIVCLIN)&($G(PSIVCLAB)]""):PSIVCLAB,$G(PSIVCLIN)&($P($G(PSIVCLIN),"^",2)]""):$P(PSIVCLIN,"^",2),1:"Opt. IV")

 ;D ENIV^PSJAC S VADM(2)=$E(VADM(2),6,9),PSIVWD=$S((+VAIN(4)&'$G(PSIVCLDT)):$P(VAIN(4),U,2),$G(PSIVCLIN)>0:$P(PSIVCLIN,"^",2),1:"Opt. IV")

 I PSIVWD="",$P($G(^PS(55,DFN,"IV",+ON,0)),"^",22) S PSIVWD=$P($G(^DIC(42,+$P($G(^PS(55,DFN,"IV",+ON,0)),"^",22),0)),"^")

 G:PSIVNOL<1 Q D SETP,^PSIVHYP 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")

 I $P(PSIVSITE,U,7) 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" LINE 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 PRNTL S X="Additive: _______________" D PRNTL

 . 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

 K PSIVFLAG,PSIVSH

START F PSIV1=1:1:PSIVNOL D

 . S LINE=0 D RE

 . 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 HYPL,LINE,MESS,P16,PDATE,PDOSE,PSIV,PSIVA,PSIV1,PSIV2,PSIVCT,PSIVDOSE,PSIVFLAG,PSIVRM,PSIVWD,TVOL,HYPLPRT,PSIMESS Q

RE I PSIV1 S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=1440/P(15)+.5\1

 K DO

 I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")

 I PSIV1 S PSJBCID=$$BCMA^PSIVBCID(DFN,ON,$D(PSIVCT),$G(PSIV1),$G(PSIV2),$G(PSIVNOL)) 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 PRNTL

 S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_"  "_$S(VAIN(5)]"":VAIN(5),1:"NF") D PRNTL S X=" " D PRNTL

 D:$P(PSIVSITE,U,12) TVOL

 S X="",$P(X,"=",PSIVRM-1)="" D PRNTL

 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),U),1:"*********")_"  "_$P(Y,U,2)_" " S:$P(Y,U,3)]"" X=X_" ("_$P(Y,U,3)_")" D

 . D PRNTL,HAZ(1),MESS     ;*364

 I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"SOL",PSIV)) Q:'PSIV  S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D

 . D SOL1,PRNTL,HAZ(2)     ;*364

 . S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X="   "_X D PRNTL

 G:$D(PSIVFLAG) SOL

 F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"SOL",PSIV)) Q:'PSIV  S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D

 . D SOL1,PRNTL,HAZ(2) I PSIV1 D UP3^PSIVBCID(DFN,PSJBLN,PSIV,YY)     ;*364

 . S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X="   "_X D PRNTL

 F I=0:0 S I=$O(HYPL(I)) Q:'I  S PSIV="" D

 . F I=I:0 S PSIV=$O(HYPL(I,PSIV)) Q:PSIV=""  S Y="",X=0 D

 .. X "F ZZ=0:0 S Y=$O(HYPL(I,PSIV,Y)) Q:Y=""""  I Y=""ALL""!(Y=""***"")!(Y[P(16)) S X=X+$P(HYPL(I,PSIV,Y),U),PSIVP=HYPL(I,PSIV,Y) D UPD"

 .. I X D HYP

 K HYPAD

SOL S X="",$P(X,"=",PSIVRM-1)="" D PRNTL

 S X=" " D PRNTL 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^PSIVLABL 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 PRNTL

 ;

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]"" PRNTL

 I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),U) D:X]"" PRNTL

 S X=P(9) D:X]"" PRNTL

 S X=P(11) D:X]"" PRNTL

 ;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 PRNTL

 I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X=""  D PRNTL

 S X=PSIV1_"["_PSIVNOL_"]" D PRNTL

 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 PRNTL

 Q

 ;

PRNTL N I 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

TVOL ;

 S PSIV=TVOL F X=0:0 S X=$O(^PS(55,DFN,"IV",+ON,"AD",X)) Q:'X  S X=X_"^"_^(X,0) S:$P(X,U,4)[P(16)!($P(X,U,4)="")!'PSIV1 PSIV=PSIV+$S($P(^PS(52.6,$P(X,U,2),0),U,10):$P(X,U,3)/$P(^(0),U,10),1:0)

 S X="Total Volume: "_(PSIV+.5\1) D PRNTL

 Q

SOL1 S X=$S($D(^PS(52.7,$P(PSIV,U,2),0)):$P(^(0),U)_" "_$P(^PS(55,DFN,"IV",+ON,"SOL",+PSIV,0),U,2),1:"**********") Q

HYP ;

 I PSIV="*" S X="*** Error in "_$S(I=50.4:"electrolyte",I=52.7:"solution",1:"additive") D PRNTL Q

 S PSIVA=$S(I=50.4:PSIV,I=52.7:+$G(^PS(55,DFN,"IV",+ON,"SOL",PSIV,0)),1:+$G(^PS(55,DFN,"IV",+ON,"AD",PSIV,0)))

 S X=$S($D(^PS(I,PSIVA,0)):$P(^(0),U),1:"Undefined "_$S(I=50.4:"electrolyte",I=52.7:"solution",1:"additive"))_" "_$S(X<1:"0"_(X+.005\.01/100),1:(X+.005\.01/100))_" "_$P($P(HYPL(I,PSIV,$O(HYPL(I,PSIV,""))),U)," ",2)

 D PRNTL,HAZ(1):I=52.6,HAZ(2):I=52.7     ;*364

 Q

SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)

 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

UPD N X,Y,PSIVEL,PSIVAD

 S PSIVEL=$P(PSIVP,"^",2)

 I I=50.4 F PSIVAD=0:0 S PSIVAD=$O(HYPLRPT(PSIVEL,"AD",PSIVAD)) Q:'PSIVAD  D

 .I $D(HYPAD(+PSIVAD)) Q

 .S YY=$G(^PS(55,DFN,"IV",+ON,"AD",+PSIVAD,0))

 .S HYPAD(+PSIVAD)=""

 .I +$P(YY,U,3),(+$P(YY,U,3)'=P(16)) Q

 .D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY)

 I I'=50.4 S YY=$G(^PS(55,DFN,"IV",+ON,"AD",+PSIV,0)) D UP2^PSIVBCID(DFN,PSJBLN,PSIV,YY)

 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 ---PSIVHYPL   8618     printed  Feb 18, 2025@23:30:37                                                                                                                                                                                                    Page 2

PSIVHYPL  ;BIR/PR-PRINT OUT LABELS ;26 FEB 97 / 3:20 PM

 +1       ;;5.0;INPATIENT MEDICATIONS;**58,96,128,178,184,279,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(50.4 is supported by DBIA 2175.

 +8       ; Reference to ^PS(51.2 is supported by DBIA 2178.

 +9       ;

 +10      ;NEEDS DFN, ON AND PSIVNOL (Total number of labels to print) and

 +11      ;PSIVCT - $D(PSIVCT) NO COUNT LABEL

 +12      ;*364 - add Hazardous Handle & Dispose flags alert message.

 +13      ;

SSWARD    ;Get patient SS# and ward location

 +1        NEW ZGSN

 +2        NEW X0,PSJIO,I,PSIVCLAB

 +3        SET I=0

           FOR 

               SET I=$ORDER(^%ZIS(2,IOST(0),55,I))

               if 'I

                   QUIT 

               SET X0=^(I,0)

               SET PSJIO($PIECE(X0,"^"))=^(1)

 +4        SET PSJIO=$SELECT('$DATA(PSJIO):0,1:1)

 +5        NEW PSIVCLIN,PSIVCLDT

           SET PSIVCLIN=+$GET(^PS(55,DFN,"IV",+ON,"DSS"))

           if '(PSIVCLIN>0)

               SET PSIVCLIN=""

           IF PSIVCLIN

               Begin DoDot:1

 +6                SET PSIVCLDT=$PIECE(PSIVCLIN,"^",2)

                   SET $PIECE(PSIVCLIN,"^",2)=$PIECE($GET(^SC(+PSIVCLIN,0)),"^")

               End DoDot:1

 +7        IF $GET(PSIVCLIN)

               SET PSIVCLAB=$PIECE($GET(^SC(+PSIVCLIN,0)),"^",2)

 +8        DO ENIV^PSJAC

           SET VADM(2)=$EXTRACT(VADM(2),6,9)

           SET PSIVWD=$SELECT(+VAIN(4):$PIECE(VAIN(4),U,2),$GET(PSIVCLIN)&($GET(PSIVCLAB)]""):PSIVCLAB,$GET(PSIVCLIN)&($PIECE($GET(PSIVCLIN),"^",2)]""):$PIECE(PSIVCLIN,"^",2),1:"Opt. IV")

 +9       ;D ENIV^PSJAC S VADM(2)=$E(VADM(2),6,9),PSIVWD=$S((+VAIN(4)&'$G(PSIVCLDT)):$P(VAIN(4),U,2),$G(PSIVCLIN)>0:$P(PSIVCLIN,"^",2),1:"Opt. IV")

 +10       IF PSIVWD=""

               IF $PIECE($GET(^PS(55,DFN,"IV",+ON,0)),"^",22)

                   SET PSIVWD=$PIECE($GET(^DIC(42,+$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),"^",22),0)),"^")

 +11       if PSIVNOL<1

               GOTO Q

           DO SETP

           DO ^PSIVHYP

           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

 +12       IF PSJIO

               IF $GET(PSJIO("FI"))]""

                   XECUTE PSJIO("FI")

 +13       IF $PIECE(PSIVSITE,U,7)

               Begin DoDot:1

 +14               SET PSIVFLAG=1

                   SET (LINE,PSIV1)=0

                   SET PSIV2=PSIVNOL

                   SET PSIVNOL=0

                   DO RE

 +15               SET PSIVRP=""

                   SET PSIVRT=""

 +16               IF $DATA(^PS(55,DFN,"IV",+ON,.2))

                       SET PSIVRP=$PIECE(^PS(55,DFN,"IV",+ON,.2),U,3)

                       Begin DoDot:2

 +17      ;QUIT IF "DOSE DUE AT" LINE 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 

 +18                       SET PSIVRT=$PIECE(^PS(51.2,PSIVRP,0),U,1)

 +19                       SET X="ROUTE: "_PSIVRT

                           if X]""

                               DO PMR

                       End DoDot:2

 +20               SET X="Solution: _______________"

                   DO PRNTL

                   SET X="Additive: _______________"

                   DO PRNTL

 +21               SET PSIVNOL=PSIV2

 +22               IF 'PSJIO

                       FOR LINE=LINE+1:1:(PSIVSITE+$PIECE(PSIVSITE,U,16))

                           WRITE !

 +23               IF PSJIO

                       IF $GET(PSJIO("EL"))]""

                           XECUTE PSJIO("EL")

               End DoDot:1

 +24       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)+PSIVNOL

 +25       KILL PSIVFLAG,PSIVSH

START      FOR PSIV1=1:1:PSIVNOL

               Begin DoDot:1

 +1                SET LINE=0

                   DO RE

 +2                if $DATA(PSIVFLAG)

                       QUIT 

 +3                IF 'PSJIO

                       FOR LINE=LINE+1:1:(PSIVSITE+$PIECE(PSIVSITE,U,16))

                           WRITE !

 +4                IF PSJIO

                       IF $GET(PSJIO("EL"))]""

                           XECUTE PSJIO("EL")

               End DoDot:1

 +5        IF PSJIO

               IF $GET(PSJIO("FE"))]""

                   XECUTE PSJIO("FE")

 +6        if '$DATA(PSIVCT)

               DO ^PSIVSTAT

Q          KILL HYPL,LINE,MESS,P16,PDATE,PDOSE,PSIV,PSIVA,PSIV1,PSIV2,PSIVCT,PSIVDOSE,PSIVFLAG,PSIVRM,PSIVWD,TVOL,HYPLPRT,PSIMESS

           QUIT 

RE         IF PSIV1

               if P(15)>2880!('P(15))

                   SET P(15)=2880

               SET P(16)=P16+PSIV1#(1440/P(15)+.5\1)

               if 'P(16)

                   SET P(16)=1440/P(15)+.5\1

 +1        KILL DO

 +2        IF PSJIO

               IF $GET(PSJIO("SL"))]""

                   XECUTE PSJIO("SL")

 +3        IF PSIV1

               SET PSJBCID=$$BCMA^PSIVBCID(DFN,ON,$DATA(PSIVCT),$GET(PSIV1),$GET(PSIV2),$GET(PSIVNOL))

               DO BARCODE

 +4        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)

 +5        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

 +6                                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

 +7        DO PRNTL

 +8        SET X=VADM(1)

           if $PIECE(PSIVSITE,U,9)

               SET X=X_"  "_$SELECT(VAIN(5)]"":VAIN(5),1:"NF")

           DO PRNTL

           SET X=" "

           DO PRNTL

 +9        if $PIECE(PSIVSITE,U,12)

               DO TVOL

 +10       SET X=""

           SET $PIECE(X,"=",PSIVRM-1)=""

           DO PRNTL

 +11       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),U),1:"*********")_"  "_$PIECE(Y,U,2)_" "

                   if $PIECE(Y,U,3)]""

                       SET X=X_" ("_$PIECE(Y,U,3)_")"

                   Begin DoDot:1

 +12      ;*364

                       DO PRNTL

                       DO HAZ(1)

                       DO MESS

                   End DoDot:1

 +13       IF $DATA(PSIVFLAG)

               FOR PSIV=0:0

                   SET PSIV=$ORDER(^PS(55,DFN,"IV",+ON,"SOL",PSIV))

                   if 'PSIV

                       QUIT 

                   SET PSIV=PSIV_"^"_+^(PSIV,0)

                   SET YY=^(0)

                   Begin DoDot:1

 +14      ;*364

                       DO SOL1

                       DO PRNTL

                       DO HAZ(2)

 +15                   SET X=$PIECE(^PS(52.7,$PIECE(PSIV,U,2),0),U,4)

                       IF X]""

                           SET X="   "_X

                           DO PRNTL

                   End DoDot:1

 +16       if $DATA(PSIVFLAG)

               GOTO SOL

 +17       FOR PSIV=0:0

               SET PSIV=$ORDER(^PS(55,DFN,"IV",+ON,"SOL",PSIV))

               if 'PSIV

                   QUIT 

               SET PSIV=PSIV_"^"_+^(PSIV,0)

               SET YY=^(0)

               Begin DoDot:1

 +18      ;*364

                   DO SOL1

                   DO PRNTL

                   DO HAZ(2)

                   IF PSIV1

                       DO UP3^PSIVBCID(DFN,PSJBLN,PSIV,YY)

 +19               SET X=$PIECE(^PS(52.7,$PIECE(PSIV,U,2),0),U,4)

                   IF X]""

                       SET X="   "_X

                       DO PRNTL

               End DoDot:1

 +20       FOR I=0:0

               SET I=$ORDER(HYPL(I))

               if 'I

                   QUIT 

               SET PSIV=""

               Begin DoDot:1

 +21               FOR I=I:0

                       SET PSIV=$ORDER(HYPL(I,PSIV))

                       if PSIV=""

                           QUIT 

                       SET Y=""

                       SET X=0

                       Begin DoDot:2

 +22                       XECUTE "F ZZ=0:0 S Y=$O(HYPL(I,PSIV,Y)) Q:Y=""""  I Y=""ALL""!(Y=""***"")!(Y[P(16)) S X=X+$P(HYPL(I,PSIV,Y),U),PSIVP=HYPL(I,PSIV,Y) D UPD"

 +23                       IF X

                               DO HYP

                       End DoDot:2

               End DoDot:1

 +24       KILL HYPAD

SOL        SET X=""

           SET $PIECE(X,"=",PSIVRM-1)=""

           DO PRNTL

 +1        SET X=" "

           DO PRNTL

           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

 +2        if '$DATA(PSIVDOSE)

               SET PSIVDOSE=""

           SET X=$PIECE(PSIVDOSE," ",PSIV1)

           if $EXTRACT(X)="."

               DO CONVER^PSIVLABL

           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 PRNTL

 +3       ;

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 PRNTL

 +1        IF $DATA(^PS(55,DFN,"IV",+ON,3))

               SET X=$PIECE(^(3),U)

               if X]""

                   DO PRNTL

 +2        SET X=P(9)

           if X]""

               DO PRNTL

 +3        SET X=P(11)

           if X]""

               DO PRNTL

 +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 PRNTL

 +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 PRNTL

 +7        SET X=PSIV1_"["_PSIVNOL_"]"

           DO PRNTL

 +8        QUIT 

 +9       ;

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 PRNTL

 +8        QUIT 

 +9       ;

PRNTL      NEW I

           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