Routine: PSBOBZ

PSBOBZ ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;26-Feb-2013 11:55;PLS

 ;;3.0;BAR CODE MED ADMIN;**2,1015**;Mar 2004;Build 62

 ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 ; Reference/IA

 ; ^%ZIS(2/3435

 ; File 50/221

 ; Modified - IHS/MSC/PLS - 02/07/2013 - Line EN+24

EN ;

 N PSBI,PSBIENS,PSBQTY,PSBDOSE,PSBDRUG,PSBNAME,PSBNODE3,PSBWARD,PSBLOT,PSBBAR,PSBTLE,SL

 N PSBEXP,PSBFD,PSBMFG,PSBCB,PSBFB,PSBFCB,PSBCNT,PSBANS,PSBORD,PSBPRE,PSBX,PSBY,PSBSYM,TEXT

 N PSBXX,PSBYY,PSBCODE

 S PSBXX=0 F  S PSBXX=$O(^%ZIS(2,IOST(0),55,PSBXX)) Q:'PSBXX  S PSBYY=$G(^(PSBXX,0)) I PSBYY]"" S PSBX=$P(PSBYY,"^"),PSBY=^(1),PSBCODE(PSBX)=PSBY

 ;The PSBRPT variable and PSBRPT(.3) array are set in the PSBO routine.  It is the internal

 ;entry number from the BCMA REPORT REQUEST file (#53.69). This entry is created

 ;when the user submits the completed ScreenMan form from the Label Print option.

 S PSBIENS=PSBRPT_","

 S PSBBAR=$P($P($G(PSBRPT(.3)),U,1),"~",2)

 S PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")

 S:PSBPRE]"" PSBBAR=PSBPRE_$S(PSBPRE?1.N:"-",1:"")_PSBBAR

 S PSBDRUG=$P($P($G(PSBRPT(.3)),U,1),"~",1)

 S PSBQTY=+$P($G(PSBRPT(.3)),U,5)

 S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"

 I PSBQTY=0 S PSBDRUG=PSBDRUG_" (Qty:      )"

 S PSBDOSE=$P($G(PSBRPT(.3)),U,9)

 I PSBDOSE]"" S PSBDOSE="Dose:"_PSBDOSE

 I PSBDOSE="" S PSBDOSE="Dose:"

 S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)

 ;IHS/MSC/PLS - 02/07/13

 ;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"

 I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$S(DUZ("AG")="I":$$HRN^AUPNPAT($P($G(^PSB(53.69,+PSBIENS,.1)),U,2),$P(^(0),U,4)),1:$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9))_")"

 I PSBNAME="" S PSBNAME="Patient:"

 S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)

 I PSBWARD]"" S PSBWARD="Ward: "_PSBWARD

 I PSBWARD="" S PSBWARD="Ward: "

 S PSBLOT=$P($G(PSBRPT(.3)),U,2)

 I PSBLOT]"" S PSBLOT="Lot: "_PSBLOT

 I PSBLOT="" S PSBLOT="Lot: "

 S PSBFD=$P($G(PSBRPT(.3)),U,3)

 S PSBEXP=$$FMTE^XLFDT(PSBFD,5)

 I PSBEXP]"" S PSBEXP="Exp: "_PSBEXP

 I PSBEXP="" S PSBEXP="Exp: "

 S PSBMFG=$P($G(PSBRPT(.3)),U,4)

 I PSBMFG]"" S PSBMFG="Mfg: "_PSBMFG

 I PSBMFG="" S PSBMFG="Mfg: "

 S PSBFB=$P($G(PSBRPT(.3)),U,6) I PSBFB="" S PSBFB="_____"

 S PSBCB=$P($G(PSBRPT(.3)),U,7) I PSBCB="" S PSBCB="_____"

 S PSBFCB=PSBFB_"/"_PSBCB

 F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL

LABEL ;Get Barcode Label Type

 ;Barcode Type

 S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")

INIT ;Initialize barcode printer

 I $D(PSBCODE("FI")) X PSBCODE("FI")

 I $D(PSBCODE("FI1")) X PSBCODE("FI1")

 I $D(PSBCODE("FI2")) X PSBCODE("FI2")

 ;Additional format settings

 I PSBSYM]"",$D(PSBCODE("SBF")) X PSBCODE("SBF")

 I PSBSYM="",$D(PSBCODE("EBF")) X PSBCODE("EBF")

 D START ;execute control codes to start label

 D PRINT ;execute control codes to print label

 ;Print Barcode Strip

 ;If barcode type is defined.

 I PSBSYM]"",$D(PSBCODE("SB")) S TEXT=PSBBAR X PSBCODE("SB")

 ;If barcode type is not define.

 I PSBSYM="",$D(PSBCODE("SB")) S TEXT="*NO BARCODE TYPE*" X PSBCODE("SB")

END ; Close Label or End of Label

 I $G(PSBCODE("EL"))]"" X PSBCODE("EL")

H 2

START ;Start Label Print Process

 I $G(PSBCODE("SL"))]"" X PSBCODE("SL")

PRINT ;Print barcode label

 I PSBDRUG]"" S PSBTLE="PSBDRUG",TEXT="Drug: "_PSBDRUG  D PROCESS

 I PSBDOSE]"" S PSBTLE="PSBDOSE",TEXT=PSBDOSE D PROCESS

 I PSBNAME]"" S PSBTLE="PSBNAME",TEXT=PSBNAME  D PROCESS

 I PSBWARD]"" S PSBTLE="PSBWARD",TEXT=PSBWARD  D PROCESS

 I PSBLOT]"" S PSBTLE="PSBLOT",TEXT=PSBLOT  D PROCESS

 I PSBEXP]"" S PSBTLE="PSBEXP",TEXT=PSBEXP  D PROCESS

 I PSBMFG]"" S PSBTLE="PSBMFG",TEXT=PSBMFG  D PROCESS

 I PSBFCB]"" S PSBTLE="PSBFCB",TEXT="Filled/Checked By: "_PSBFCB  D PROCESS

PROCESS ;Process control code and field data.

 I $D(PSBCODE("STF")) X PSBCODE("STF")

 I $D(PSBCODE("ST")) X PSBCODE("ST")

INPTR ;Input transform for DRUG field (#.31) in file 53.69.

 N PSBIAD,PSBDEA,D,Y

 K:$L(X)>40!($L(X)<1) X  I $D(X) D

 .S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 .N DIC S DIC="^PSDRUG(",DIC(0)="EQNM",D="B^C^VAPN^VAC^NDC^XATC"

 .S DIC("S")="I (($P($G(^PSDRUG(+Y,2)),U,3)[""I"")!($P($G(^(2)),U,3)[""U"")),(('$G(^PSDRUG(+Y,""I"")))!(DT'>$G(^(""I""))))"

 .D:+X'>0 MIX^DIC1

 .D:+X>0 ^DIC

 .S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X

PSBOBZ    ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;26-Feb-2013 11:55;PLS

 +1       ;;3.0;BAR CODE MED ADMIN;**2,1015**;Mar 2004;Build 62

 +2       ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 +3       ;

 +4       ; Reference/IA

 +5       ; ^%ZIS(2/3435

 +6       ; File 50/221

 +7       ;

 +8       ; Modified - IHS/MSC/PLS - 02/07/2013 - Line EN+24

EN        ;

 +1        NEW PSBI,PSBIENS,PSBQTY,PSBDOSE,PSBDRUG,PSBNAME,PSBNODE3,PSBWARD,PSBLOT,PSBBAR,PSBTLE,SL

 +2        NEW PSBEXP,PSBFD,PSBMFG,PSBCB,PSBFB,PSBFCB,PSBCNT,PSBANS,PSBORD,PSBPRE,PSBX,PSBY,PSBSYM,TEXT

 +3       ;

 +4        NEW PSBXX,PSBYY,PSBCODE

 +5        SET PSBXX=0

FOR

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

               IF 'PSBXX

                   QUIT

               SET PSBYY=$GET(^(PSBXX,0))

               IF PSBYY]""

                   SET PSBX=$PIECE(PSBYY,"^")

                   SET PSBY=^(1)

                   SET PSBCODE(PSBX)=PSBY

 +6       ;

 +7       ;The PSBRPT variable and PSBRPT(.3) array are set in the PSBO routine.  It is the internal

 +8       ;entry number from the BCMA REPORT REQUEST file (#53.69). This entry is created

 +9       ;when the user submits the completed ScreenMan form from the Label Print option.

 +10      ;

 +11      ;

 +12       SET PSBIENS=PSBRPT_","

 +13       SET PSBBAR=$PIECE($PIECE($GET(PSBRPT(.3)),U,1),"~",2)

 +14       SET PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")

 +15       IF PSBPRE]""

               SET PSBBAR=PSBPRE_$SELECT(PSBPRE?1.N:"-",1:"")_PSBBAR

 +16       SET PSBDRUG=$PIECE($PIECE($GET(PSBRPT(.3)),U,1),"~",1)

 +17       SET PSBQTY=+$PIECE($GET(PSBRPT(.3)),U,5)

 +18       IF PSBQTY

               SET PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"

 +19       IF PSBQTY=0

               SET PSBDRUG=PSBDRUG_" (Qty:      )"

 +20       SET PSBDOSE=$PIECE($GET(PSBRPT(.3)),U,9)

 +21       IF PSBDOSE]""

               SET PSBDOSE="Dose:"_PSBDOSE

 +22       IF PSBDOSE=""

               SET PSBDOSE="Dose:"

 +23       SET PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)

 +24      ;IHS/MSC/PLS - 02/07/13

 +25      ;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"

 +26       IF PSBNAME]""

               SET PSBNAME=PSBNAME_" ("_$SELECT(DUZ("AG")="I":$$HRN^AUPNPAT($PIECE($GET(^PSB(53.69,+PSBIENS,.1)),U,2),$PIECE(^(0),U,4)),1:$EXTRACT($$GET1^DIQ(53.69,PSBIENS,.121),6,9))_")"

 +27       IF PSBNAME=""

               SET PSBNAME="Patient:"

 +28       SET PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)

 +29       IF PSBWARD]""

               SET PSBWARD="Ward: "_PSBWARD

 +30       IF PSBWARD=""

               SET PSBWARD="Ward: "

 +31       SET PSBLOT=$PIECE($GET(PSBRPT(.3)),U,2)

 +32       IF PSBLOT]""

               SET PSBLOT="Lot: "_PSBLOT

 +33       IF PSBLOT=""

               SET PSBLOT="Lot: "

 +34       SET PSBFD=$PIECE($GET(PSBRPT(.3)),U,3)

 +35       SET PSBEXP=$$FMTE^XLFDT(PSBFD,5)

 +36       IF PSBEXP]""

               SET PSBEXP="Exp: "_PSBEXP

 +37       IF PSBEXP=""

               SET PSBEXP="Exp: "

 +38       SET PSBMFG=$PIECE($GET(PSBRPT(.3)),U,4)

 +39       IF PSBMFG]""

               SET PSBMFG="Mfg: "_PSBMFG

 +40       IF PSBMFG=""

               SET PSBMFG="Mfg: "

 +41       SET PSBFB=$PIECE($GET(PSBRPT(.3)),U,6)

           IF PSBFB=""

               SET PSBFB="_____"

 +42       SET PSBCB=$PIECE($GET(PSBRPT(.3)),U,7)

           IF PSBCB=""

               SET PSBCB="_____"

 +43       SET PSBFCB=PSBFB_"/"_PSBCB

 +44       FOR PSBCNT=1:1:+$PIECE(PSBRPT(.3),U,8)

               DO LABEL

 +45       QUIT

 +46      ;

LABEL     ;Get Barcode Label Type

 +1       ;Barcode Type

 +2        SET PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")

 +3       ;

INIT      ;Initialize barcode printer

 +1        IF $DATA(PSBCODE("FI"))

               XECUTE PSBCODE("FI")

 +2        IF $DATA(PSBCODE("FI1"))

               XECUTE PSBCODE("FI1")

 +3        IF $DATA(PSBCODE("FI2"))

               XECUTE PSBCODE("FI2")

 +4       ;

 +5       ;Additional format settings

 +6        IF PSBSYM]""

               IF $DATA(PSBCODE("SBF"))

                   XECUTE PSBCODE("SBF")

 +7        IF PSBSYM=""

               IF $DATA(PSBCODE("EBF"))

                   XECUTE PSBCODE("EBF")

 +8       ;

 +9       ;execute control codes to start label

           DO START

 +10      ;execute control codes to print label

           DO PRINT

 +11      ;

 +12      ;Print Barcode Strip

 +13      ;If barcode type is defined.

 +14       IF PSBSYM]""

               IF $DATA(PSBCODE("SB"))

                   SET TEXT=PSBBAR

                   XECUTE PSBCODE("SB")

 +15      ;If barcode type is not define.

 +16       IF PSBSYM=""

               IF $DATA(PSBCODE("SB"))

                   SET TEXT="*NO BARCODE TYPE*"

                   XECUTE PSBCODE("SB")

 +17      ;

END       ; Close Label or End of Label

 +1        IF $GET(PSBCODE("EL"))]""

               XECUTE PSBCODE("EL")

 +2        HANG 2

 +3        QUIT

 +4       ;

START     ;Start Label Print Process

 +1        IF $GET(PSBCODE("SL"))]""

               XECUTE PSBCODE("SL")

 +2        QUIT

 +3       ;

PRINT     ;Print barcode label

 +1       ;

 +2        IF PSBDRUG]""

               SET PSBTLE="PSBDRUG"

               SET TEXT="Drug: "_PSBDRUG

               DO PROCESS

 +3        IF PSBDOSE]""

               SET PSBTLE="PSBDOSE"

               SET TEXT=PSBDOSE

               DO PROCESS

 +4        IF PSBNAME]""

               SET PSBTLE="PSBNAME"

               SET TEXT=PSBNAME

               DO PROCESS

 +5        IF PSBWARD]""

               SET PSBTLE="PSBWARD"

               SET TEXT=PSBWARD

               DO PROCESS

 +6        IF PSBLOT]""

               SET PSBTLE="PSBLOT"

               SET TEXT=PSBLOT

               DO PROCESS

 +7        IF PSBEXP]""

               SET PSBTLE="PSBEXP"

               SET TEXT=PSBEXP

               DO PROCESS

 +8        IF PSBMFG]""

               SET PSBTLE="PSBMFG"

               SET TEXT=PSBMFG

               DO PROCESS

 +9        IF PSBFCB]""

               SET PSBTLE="PSBFCB"

               SET TEXT="Filled/Checked By: "_PSBFCB

               DO PROCESS

 +10       QUIT

 +11      ;

PROCESS   ;Process control code and field data.

 +1        IF $DATA(PSBCODE("STF"))

               XECUTE PSBCODE("STF")

 +2        IF $DATA(PSBCODE("ST"))

               XECUTE PSBCODE("ST")

 +3        QUIT

 +4       ;

INPTR     ;Input transform for DRUG field (#.31) in file 53.69.

 +1        NEW PSBIAD,PSBDEA,D,Y

 +2        IF $LENGTH(X)>40!($LENGTH(X)<1)

               KILL X

           IF $DATA(X)

               Begin DoDot:1

 +3                SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +4                NEW DIC

                   SET DIC="^PSDRUG("

                   SET DIC(0)="EQNM"

                   SET D="B^C^VAPN^VAC^NDC^XATC"

 +5                SET DIC("S")="I (($P($G(^PSDRUG(+Y,2)),U,3)[""I"")!($P($G(^(2)),U,3)[""U"")),(('$G(^PSDRUG(+Y,""I"")))!(DT'>$G(^(""I""))))"

 +6                IF +X'>0

                       DO MIX^DIC1

 +7                IF +X>0

                       DO ^DIC

 +8                IF +Y>0

                       SET X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y

                   IF +Y<1

                       KILL X

               End DoDot:1

 +9        QUIT

PSBOBZ.m