source: FOIAVistA/tag/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOBZ.m@ 636

PSBOBZ ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;Mar 2004
 ;;3.0;BAR CODE MED ADMIN;**2**;Mar 2004;Build 22
 ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
 ;
 ; Reference/IA
 ; ^%ZIS(2/3435
 ; File 50/221
 ;
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)
 I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$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
 Q
 ;
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
 Q
 ;
START ;Start Label Print Process
 I $G(PSBCODE("SL"))]"" X PSBCODE("SL")
 Q
 ;
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
 Q
 ;
PROCESS ;Process control code and field data.
 I $D(PSBCODE("STF")) X PSBCODE("STF")
 I $D(PSBCODE("ST")) X PSBCODE("ST")
 Q
 ;
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
 Q