PSIVORLB.m

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