PSIVORLB ;BIR/MLM-PRINT OUT LABELS ; 8/5/08 9:22am
;;5.0;INPATIENT MEDICATIONS;**58,184,279**;16 DEC 97;Build 150
;
; Reference to ^PS(52.6 is supported by DBIA 1231.
; Reference to ^PS(52.7 is supported by DBIA 2173.
;
ENX ;Print example label
I ($G(VAIN(4))="") D CLINIC^PSIVOREN
D FULL^VALM1
S PSIVFLAG=1,PSIVRM=$P(PSIVSITE,U,13) S:PSIVRM<1 PSIVRM=30 D:$E(P("OT"))="I" ORFLDS^PSIVEDT1 W:$E(P("OT"))'="I" !,"Med Route: ",$P(P("MR"),U,2),!
START F PSIV1=1:1:PSIVNOL S LINE=0 D RE I '$D(PSIVFLAG) F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
Q K PSIVDOSE,P16,LINE,MESS,PSIVCT,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS,PSIVCLAB Q
RE ;
D:'$D(VADM(2)) DEM^VADPT
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)=1440/P(15)+.5\1
W DFN,!
N PSIVCLIN,PSIVCLDT S PSIVCLIN=$S($G(P("CLIN")):P("CLIN"),($G(ON55)["V"):+$G(^PS(55,DFN,"IV",+ON55,"DSS")),($G(ON55)["P"):+$G(^PS(53.1,+ON55,"DSS")),1:"") S:'(PSIVCLIN>0) PSIVCLIN="" I PSIVCLIN D
.S PSIVCLDT=$P(PSIVCLIN,"^",2) S $P(PSIVCLIN,"^",2)=$P($G(^SC(+PSIVCLIN,0)),"^")
I $G(PSIVCLIN) N PSIVCLAB S PSIVCLAB=$P($G(^SC(+PSIVCLIN,0)),"^",2)
S X=$S(P("PON")["V":"["_+P("PON")_"]",1:"")_$P($P(VADM(2),U,2),"-",3) D
.S X=X_" "_$S($G(PSIVCLIN)&($G(PSIVCLAB)]""):PSIVCLAB,$G(PSIVCLIN)&($P(PSIVCLIN,"^",2)'=""):$P(PSIVCLIN,"^",2),+VAIN(4):$P(VAIN(4),U,2),1:"Opt IV")_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
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(DRG("AD",PSIV)) Q:'PSIV S Y=DRG("AD",PSIV),X=$S($P(Y,U,2)]"":$P(Y,U,2),1:"*********")_" "_$P(Y,U,3)_" " S:$P(Y,U,4)]"" X=X_" ("_$P(Y,U,4)_")" D P,MESS
G:$D(PSIVFLAG) SOL
F PSIV=0:0 S PSIV=$O(DRG("AD",PSIV)) Q:'PSIV S Y=DRG("AD",PSIV),X=$S($P(Y,U,2)]"":$P(Y,U,2),1:"********")_" "_$P(Y,U,3) I ","_$P(Y,U,4)_","[(","_P(16)_",")!('$P(Y,U,4)) D P,MESS
SOL F PSIV=0:0 S PSIV=$O(DRG("SOL",PSIV)) Q:'PSIV S Y=DRG("SOL",PSIV) D SOL1,P S X=$P(^PS(52.7,+$P(Y,U),0),U,4) I X]"" S X=" "_X D P
I P(23)'=""!(P(4)="S") S X="In Syringe: "_$E(P("SYRS"),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 INF
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
INF S X=$P(P(8),"@") D:X]"" P I P("OPI")]"" S X=$P(P("OPI"),"^") D 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_"["_PSIVNOL_"]" D P
Q
P F LINE=LINE+1:1 X:LINE>+PSIVSITE "S LINE=1 F ZZ=1:1 Q:ZZ>$P(PSIVSITE,""^"",16) W !" K ZZ W $E(X,1,PSIVRM),! S X=$E(X,PSIVRM+1,999) Q:$L(X)<1
Q
SOL1 S X=$S($P(Y,U,2)]"":$P(Y,U,2)_" "_$P(Y,U,3),1:"**********") Q
MESS ; PSJ*5*184 - make MESS a local array so all messages display for all additives.
I $P(^PS(52.6,+$P(Y,U),0),U,9)]"" S MESS($P(^PS(52.6,+$P(Y,U),0),U,9))=""
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVORLB 3653 printed Dec 13, 2024@02:04:46 Page 2
PSIVORLB ;BIR/MLM-PRINT OUT LABELS ; 8/5/08 9:22am
+1 ;;5.0;INPATIENT MEDICATIONS;**58,184,279**;16 DEC 97;Build 150
+2 ;
+3 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+4 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+5 ;
ENX ;Print example label
+1 IF ($GET(VAIN(4))="")
DO CLINIC^PSIVOREN
+2 DO FULL^VALM1
+3 SET PSIVFLAG=1
SET PSIVRM=$PIECE(PSIVSITE,U,13)
if PSIVRM<1
SET PSIVRM=30
if $EXTRACT(P("OT"))="I"
DO ORFLDS^PSIVEDT1
if $EXTRACT(P("OT"))'="I"
WRITE !,"Med Route: ",$PIECE(P("MR"),U,2),!
START FOR PSIV1=1:1:PSIVNOL
SET LINE=0
DO RE
IF '$DATA(PSIVFLAG)
FOR LINE=LINE+1:1:(PSIVSITE+$PIECE(PSIVSITE,U,16))
WRITE !
Q KILL PSIVDOSE,P16,LINE,MESS,PSIVCT,PSIV2,PSIVFLAG,PSIVRM,PSIV1,PDOSE,PDATE,XX1,XX2,BAG,CX,PSIMESS,PSIVCLAB
QUIT
RE ;
+1 if '$DATA(VADM(2))
DO DEM^VADPT
+2 IF PSIV1
IF P(4)="A"!(P(5)=0)
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
+3 WRITE DFN,!
+4 NEW PSIVCLIN,PSIVCLDT
SET PSIVCLIN=$SELECT($GET(P("CLIN")):P("CLIN"),($GET(ON55)["V"):+$GET(^PS(55,DFN,"IV",+ON55,"DSS")),($GET(ON55)["P"):+$GET(^PS(53.1,+ON55,"DSS")),1:"")
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)
NEW PSIVCLAB
SET PSIVCLAB=$PIECE($GET(^SC(+PSIVCLIN,0)),"^",2)
+7 SET X=$SELECT(P("PON")["V":"["_+P("PON")_"]",1:"")_$PIECE($PIECE(VADM(2),U,2),"-",3)
Begin DoDot:1
+8 SET X=X_" "_$SELECT($GET(PSIVCLIN)&($GET(PSIVCLAB)]""):PSIVCLAB,$GET(PSIVCLIN)&($PIECE(PSIVCLIN,"^",2)'=""):$PIECE(PSIVCLIN,"^",2),+VAIN(4):$PIECE(VAIN(4),U,2),1:"Opt IV")_" "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
End DoDot:1
+9 DO P
+10 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
+11 IF $DATA(PSIVFLAG)
FOR PSIV=0:0
SET PSIV=$ORDER(DRG("AD",PSIV))
if 'PSIV
QUIT
SET Y=DRG("AD",PSIV)
SET X=$SELECT($PIECE(Y,U,2)]"":$PIECE(Y,U,2),1:"*********")_" "_$PIECE(Y,U,3)_" "
if $PIECE(Y,U,4)]""
SET X=X_" ("_$PIECE(Y,U,4)_")"
DO P
DO MESS
+12 if $DATA(PSIVFLAG)
GOTO SOL
+13 FOR PSIV=0:0
SET PSIV=$ORDER(DRG("AD",PSIV))
if 'PSIV
QUIT
SET Y=DRG("AD",PSIV)
SET X=$SELECT($PIECE(Y,U,2)]"":$PIECE(Y,U,2),1:"********")_" "_$PIECE(Y,U,3)
IF ","_$PIECE(Y,U,4)_","[(","_P(16)_",")!('$PIECE(Y,U,4))
DO P
DO MESS
SOL FOR PSIV=0:0
SET PSIV=$ORDER(DRG("SOL",PSIV))
if 'PSIV
QUIT
SET Y=DRG("SOL",PSIV)
DO SOL1
DO P
SET X=$PIECE(^PS(52.7,+$PIECE(Y,U),0),U,4)
IF X]""
SET X=" "_X
DO P
+1 IF P(23)'=""!(P(4)="S")
SET X="In Syringe: "_$EXTRACT(P("SYRS"),1,25)
if P(4)="S"!(P(23)="S")
DO P
SET X="*CAUTION* - CHEMOTHERAPY"
if P(23)'=""
DO P
+2 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 INF
+3 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
INF SET X=$PIECE(P(8),"@")
if X]""
DO P
IF P("OPI")]""
SET X=$PIECE(P("OPI"),"^")
DO P
+1 SET X=P(9)
if X]""
DO P
+2 SET X=P(11)
if X]""
DO P
+3 ; PSJ*5*184 - Display all messages if more than one additive has a message.
+4 IF $DATA(MESS)
SET PSIMESS=""
FOR
SET PSIMESS=$ORDER(MESS(PSIMESS))
if PSIMESS=""
QUIT
SET X=PSIMESS
DO P
+5 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
+6 SET X=PSIV1_"["_PSIVNOL_"]"
DO P
+7 QUIT
P FOR LINE=LINE+1:1
if LINE>+PSIVSITE
XECUTE "S LINE=1 F ZZ=1:1 Q:ZZ>$P(PSIVSITE,""^"",16) W !"
KILL ZZ
WRITE $EXTRACT(X,1,PSIVRM),!
SET X=$EXTRACT(X,PSIVRM+1,999)
if $LENGTH(X)<1
QUIT
+1 QUIT
SOL1 SET X=$SELECT($PIECE(Y,U,2)]"":$PIECE(Y,U,2)_" "_$PIECE(Y,U,3),1:"**********")
QUIT
MESS ; PSJ*5*184 - make MESS a local array so all messages display for all additives.
+1 IF $PIECE(^PS(52.6,+$PIECE(Y,U),0),U,9)]""
SET MESS($PIECE(^PS(52.6,+$PIECE(Y,U),0),U,9))=""
+2 QUIT
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
