PSIVORLB ;BIR/MLM-PRINT OUT LABELS ;03-Apr-2013 14:13;PLS
;;5.0; INPATIENT MEDICATIONS ;**58,184,1015**;16 DEC 97;Build 62
;
; Reference to ^PS(52.6 is supported by DBIA 1231.
; Reference to ^PS(52.7 is supported by DBIA 2173.
;
; Modified - IHS/CIA/PLS - 12/05/03 - Line RE+4
; - IHS/MSC/PB - 2/11/13 - Line INF+7 to INF+10 and Line Tag OFFSET added to print the Beyond Use Date data to the sample iv label
ENX ;Print example label
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 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,!
; IHS/CIA/PLS - 12/05/03 - Commented out next line and changed from SSN to HRN
;S X=$S(P("PON")["V":"["_+P("PON")_"]",1:"")_$P($P(VADM(2),U,2),"-",3)_" "_$S(+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=$S(P("PON")["V":"["_+P("PON")_"]",1:"")_$G(VA("BID"))_" "_$S(+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
;ISH/MSC/PB - 2/11/13 Next block of below added to add the Beyond Use Date information to the sample label
;IHS/MSC/PLS - 04/02/13
I $P($G(^PS(59.5,PSIVSN,9999999)),U)=1 D
.I $G(P("OFFSET"))>0 D
..S X="Do Not Use After: "_$$FMTE^XLFDT($$FMADD^XLFDT($$DT^XLFDT(),P("OFFSET")),"5Z")
..D:X]"" P
.E D
..N TEXT1
..S X=""
..D OFFSET
..S:$L(TEXT1) X="Do Not Use After: "_$G(TEXT1) D:X]"" P
;IHS/MSC/PLS - 04/02/13
;IHS/MSC/PB - 2/11/13 End mods for printing Beyond Use Date.
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
OFFSET ;IHS/MSC/PB - 2/11/13 code block added to compute the Beyond use date for printing on the sample label printed to the screen.
N XX1,EXDT
S TEXT1="________"
I $P($G(^PS(55,DFN,"IV",+$G(ON),9999999)),U)'="" D
.Q:$P($G(^PS(55,DFN,"IV",+ON,9999999)),U)<1 ;S TEXT1="________" Q
.S XX1=$P(^PS(55,DFN,"IV",+ON,9999999),U),EXDT=$$FMADD^XLFDT($$DT^XLFDT(),XX1)
.S TEXT1=$$FMTE^XLFDT(EXDT,"5Z")
Q
PSIVORLB ;BIR/MLM-PRINT OUT LABELS ;03-Apr-2013 14:13;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**58,184,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+4 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+5 ;
+6 ; Modified - IHS/CIA/PLS - 12/05/03 - Line RE+4
+7 ; - IHS/MSC/PB - 2/11/13 - Line INF+7 to INF+10 and Line Tag OFFSET added to print the Beyond Use Date data to the sample iv label
ENX ;Print example label
+1 DO FULL^VALM1
+2 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
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 ; IHS/CIA/PLS - 12/05/03 - Commented out next line and changed from SSN to HRN
+5 ;S X=$S(PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P("PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">PON")["V":"["_+PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P("PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">PON")_"]",1:"")_$PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P($PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P(VADM(2),U,2),"-",3)_" "_$S(+VAIN(4):$PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P(VAIN(4),U,2),1:"Opt IV")_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) D PSIVORLB_source.html#xP">PSIVORLB_source.html#xPSIVORLB_source.html#xP">P">PSIVORLB_source.html#xP">P
+6 SET X=$SELECT(P("PON")["V":"["_+P("PON")_"]",1:"")_$GET(VA("BID"))_" "_$SELECT(+VAIN(4):$PIECE(VAIN(4),U,2),1:"Opt IV")_" "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
DO P
+7 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
+8 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
+9 IF $DATA(PSIVFLAG)
GOTO SOL
+10 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 ;ISH/MSC/PB - 2/11/13 Next block of below added to add the Beyond Use Date information to the sample label
+8 ;IHS/MSC/PLS - 04/02/13
+9 IF $PIECE($GET(^PS(59.5,PSIVSN,9999999)),U)=1
Begin DoDot:1
+10 IF $GET(P("OFFSET"))>0
Begin DoDot:2
+11 SET X="Do Not Use After: "_$$FMTE^XLFDT($$FMADD^XLFDT($$DT^XLFDT(),P("OFFSET")),"5Z")
+12 IF X]""
DO P
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 NEW TEXT1
+15 SET X=""
+16 DO OFFSET
+17 IF $LENGTH(TEXT1)
SET X="Do Not Use After: "_$GET(TEXT1)
IF X]""
DO P
End DoDot:2
End DoDot:1
+18 ;IHS/MSC/PLS - 04/02/13
+19 ;IHS/MSC/PB - 2/11/13 End mods for printing Beyond Use Date.
+20 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
OFFSET ;IHS/MSC/PB - 2/11/13 code block added to compute the Beyond use date for printing on the sample label printed to the screen.
+1 NEW XX1,EXDT
+2 SET TEXT1="________"
+3 IF $PIECE($GET(^PS(55,DFN,"IV",+$GET(ON),9999999)),U)'=""
Begin DoDot:1
+4 ;S TEXT1="________" Q
IF $PIECE($GET(^PS(55,DFN,"IV",+ON,9999999)),U)<1
QUIT
+5 SET XX1=$PIECE(^PS(55,DFN,"IV",+ON,9999999),U)
SET EXDT=$$FMADD^XLFDT($$DT^XLFDT(),XX1)
+6 SET TEXT1=$$FMTE^XLFDT(EXDT,"5Z")
End DoDot:1
+7 QUIT
