| 1 | PSBOBZ ;BIRMINGHAM/TTH-BAR CODE LABELS (MAIN) ;Mar 2004
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**2**;Mar 2004;Build 22
|
|---|
| 3 | ;;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Reference/IA
|
|---|
| 6 | ; ^%ZIS(2/3435
|
|---|
| 7 | ; File 50/221
|
|---|
| 8 | ;
|
|---|
| 9 | EN ;
|
|---|
| 10 | N PSBI,PSBIENS,PSBQTY,PSBDOSE,PSBDRUG,PSBNAME,PSBNODE3,PSBWARD,PSBLOT,PSBBAR,PSBTLE,SL
|
|---|
| 11 | N PSBEXP,PSBFD,PSBMFG,PSBCB,PSBFB,PSBFCB,PSBCNT,PSBANS,PSBORD,PSBPRE,PSBX,PSBY,PSBSYM,TEXT
|
|---|
| 12 | ;
|
|---|
| 13 | N PSBXX,PSBYY,PSBCODE
|
|---|
| 14 | 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
|
|---|
| 15 | ;
|
|---|
| 16 | ;The PSBRPT variable and PSBRPT(.3) array are set in the PSBO routine. It is the internal
|
|---|
| 17 | ;entry number from the BCMA REPORT REQUEST file (#53.69). This entry is created
|
|---|
| 18 | ;when the user submits the completed ScreenMan form from the Label Print option.
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | S PSBIENS=PSBRPT_","
|
|---|
| 22 | S PSBBAR=$P($P($G(PSBRPT(.3)),U,1),"~",2)
|
|---|
| 23 | S PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
|
|---|
| 24 | S:PSBPRE]"" PSBBAR=PSBPRE_$S(PSBPRE?1.N:"-",1:"")_PSBBAR
|
|---|
| 25 | S PSBDRUG=$P($P($G(PSBRPT(.3)),U,1),"~",1)
|
|---|
| 26 | S PSBQTY=+$P($G(PSBRPT(.3)),U,5)
|
|---|
| 27 | S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
|
|---|
| 28 | I PSBQTY=0 S PSBDRUG=PSBDRUG_" (Qty: )"
|
|---|
| 29 | S PSBDOSE=$P($G(PSBRPT(.3)),U,9)
|
|---|
| 30 | I PSBDOSE]"" S PSBDOSE="Dose:"_PSBDOSE
|
|---|
| 31 | I PSBDOSE="" S PSBDOSE="Dose:"
|
|---|
| 32 | S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
|
|---|
| 33 | I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
|
|---|
| 34 | I PSBNAME="" S PSBNAME="Patient:"
|
|---|
| 35 | S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
|
|---|
| 36 | I PSBWARD]"" S PSBWARD="Ward: "_PSBWARD
|
|---|
| 37 | I PSBWARD="" S PSBWARD="Ward: "
|
|---|
| 38 | S PSBLOT=$P($G(PSBRPT(.3)),U,2)
|
|---|
| 39 | I PSBLOT]"" S PSBLOT="Lot: "_PSBLOT
|
|---|
| 40 | I PSBLOT="" S PSBLOT="Lot: "
|
|---|
| 41 | S PSBFD=$P($G(PSBRPT(.3)),U,3)
|
|---|
| 42 | S PSBEXP=$$FMTE^XLFDT(PSBFD,5)
|
|---|
| 43 | I PSBEXP]"" S PSBEXP="Exp: "_PSBEXP
|
|---|
| 44 | I PSBEXP="" S PSBEXP="Exp: "
|
|---|
| 45 | S PSBMFG=$P($G(PSBRPT(.3)),U,4)
|
|---|
| 46 | I PSBMFG]"" S PSBMFG="Mfg: "_PSBMFG
|
|---|
| 47 | I PSBMFG="" S PSBMFG="Mfg: "
|
|---|
| 48 | S PSBFB=$P($G(PSBRPT(.3)),U,6) I PSBFB="" S PSBFB="_____"
|
|---|
| 49 | S PSBCB=$P($G(PSBRPT(.3)),U,7) I PSBCB="" S PSBCB="_____"
|
|---|
| 50 | S PSBFCB=PSBFB_"/"_PSBCB
|
|---|
| 51 | F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | LABEL ;Get Barcode Label Type
|
|---|
| 55 | ;Barcode Type
|
|---|
| 56 | S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
|
|---|
| 57 | ;
|
|---|
| 58 | INIT ;Initialize barcode printer
|
|---|
| 59 | I $D(PSBCODE("FI")) X PSBCODE("FI")
|
|---|
| 60 | I $D(PSBCODE("FI1")) X PSBCODE("FI1")
|
|---|
| 61 | I $D(PSBCODE("FI2")) X PSBCODE("FI2")
|
|---|
| 62 | ;
|
|---|
| 63 | ;Additional format settings
|
|---|
| 64 | I PSBSYM]"",$D(PSBCODE("SBF")) X PSBCODE("SBF")
|
|---|
| 65 | I PSBSYM="",$D(PSBCODE("EBF")) X PSBCODE("EBF")
|
|---|
| 66 | ;
|
|---|
| 67 | D START ;execute control codes to start label
|
|---|
| 68 | D PRINT ;execute control codes to print label
|
|---|
| 69 | ;
|
|---|
| 70 | ;Print Barcode Strip
|
|---|
| 71 | ;If barcode type is defined.
|
|---|
| 72 | I PSBSYM]"",$D(PSBCODE("SB")) S TEXT=PSBBAR X PSBCODE("SB")
|
|---|
| 73 | ;If barcode type is not define.
|
|---|
| 74 | I PSBSYM="",$D(PSBCODE("SB")) S TEXT="*NO BARCODE TYPE*" X PSBCODE("SB")
|
|---|
| 75 | ;
|
|---|
| 76 | END ; Close Label or End of Label
|
|---|
| 77 | I $G(PSBCODE("EL"))]"" X PSBCODE("EL")
|
|---|
| 78 | H 2
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | START ;Start Label Print Process
|
|---|
| 82 | I $G(PSBCODE("SL"))]"" X PSBCODE("SL")
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | PRINT ;Print barcode label
|
|---|
| 86 | ;
|
|---|
| 87 | I PSBDRUG]"" S PSBTLE="PSBDRUG",TEXT="Drug: "_PSBDRUG D PROCESS
|
|---|
| 88 | I PSBDOSE]"" S PSBTLE="PSBDOSE",TEXT=PSBDOSE D PROCESS
|
|---|
| 89 | I PSBNAME]"" S PSBTLE="PSBNAME",TEXT=PSBNAME D PROCESS
|
|---|
| 90 | I PSBWARD]"" S PSBTLE="PSBWARD",TEXT=PSBWARD D PROCESS
|
|---|
| 91 | I PSBLOT]"" S PSBTLE="PSBLOT",TEXT=PSBLOT D PROCESS
|
|---|
| 92 | I PSBEXP]"" S PSBTLE="PSBEXP",TEXT=PSBEXP D PROCESS
|
|---|
| 93 | I PSBMFG]"" S PSBTLE="PSBMFG",TEXT=PSBMFG D PROCESS
|
|---|
| 94 | I PSBFCB]"" S PSBTLE="PSBFCB",TEXT="Filled/Checked By: "_PSBFCB D PROCESS
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | PROCESS ;Process control code and field data.
|
|---|
| 98 | I $D(PSBCODE("STF")) X PSBCODE("STF")
|
|---|
| 99 | I $D(PSBCODE("ST")) X PSBCODE("ST")
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | INPTR ;Input transform for DRUG field (#.31) in file 53.69.
|
|---|
| 103 | N PSBIAD,PSBDEA,D,Y
|
|---|
| 104 | K:$L(X)>40!($L(X)<1) X I $D(X) D
|
|---|
| 105 | .S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 106 | .N DIC S DIC="^PSDRUG(",DIC(0)="EQNM",D="B^C^VAPN^VAC^NDC^XATC"
|
|---|
| 107 | .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""))))"
|
|---|
| 108 | .D:+X'>0 MIX^DIC1
|
|---|
| 109 | .D:+X>0 ^DIC
|
|---|
| 110 | .S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X
|
|---|
| 111 | Q
|
|---|
