source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOBL.m@ 1154

Last change on this file since 1154 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
3 ;
4 ; Reference/IA
5 ; File 50/221
6 ;
7EN ;
8 N PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
9 N PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD
10 S PSBIENS=PSBRPT_","
11 S PSBBAR=$P($P($G(^PSB(53.69,PSBRPT,.3)),U,1),"~",2)
12 ;
13 S PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
14 S:PSBPRE]"" PSBBAR=PSBPRE_$S(PSBPRE?1.N:"-",1:"")_PSBBAR
15 ;
16 S PSBDRUG=$$GET1^DIQ(53.69,PSBIENS,.31)
17 S PSBQTY=+$$GET1^DIQ(53.69,PSBIENS,.35)
18 S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
19 S PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
20 S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
21 I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
22 S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
23 S PSBLOT=$$GET1^DIQ(53.69,PSBIENS,.32)
24 S PSBEXP=$$GET1^DIQ(53.69,PSBIENS,.33)
25 S PSBMFG=$$GET1^DIQ(53.69,PSBIENS,.34)
26 S PSBFCB=$$GET1^DIQ(53.69,PSBIENS,.36)_"/"_$$GET1^DIQ(53.69,PSBIENS,.37)
27 S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
28 F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL
29 Q
30 ;
31LABEL ; Print the Label
32 W "^XA"
33 W !,"^LH0,0^FS"
34 W $$DATA(20,25,"Drug:")
35 W $$DATA(100,25,PSBDRUG)
36 I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
37 I PSBNAME]"" W $$DATA(350,60,PSBNAME)
38 I PSBWARD]"" W $$DATA(350,90,"Ward:") W $$DATA(400,90,PSBWARD)
39 I PSBLOT]"" W $$DATA(350,120,"Lot#:") W $$DATA(400,120,PSBLOT)
40 I PSBEXP]"" W $$DATA(500,120,"Exp:") W $$DATA(550,120,PSBEXP)
41 I PSBMFG]"" W $$DATA(350,150,"Mfg:") W $$DATA(400,150,PSBMFG)
42 W $$DATA(350,180,"Filled/Checked By:") W $$DATA(520,180,PSBFCB)
43 ;
44 ; Code 39
45 I PSBSYM="C39" W !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
46 ;
47 ; Code 128
48 I PSBSYM="128" W !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
49 ;
50 ; Code I 2 of 5
51 I PSBSYM="I25" W !,"^BY2,3.0^FO20,100^B2N,80,Y,N,N^FR^FD"_PSBBAR_"^FS"
52 ;
53 I PSBSYM="" W $$DATA(20,100,"PSB DEFAULT BARCODE FORMAT Undefined.")
54 ;
55 ; Close Label
56 W !,"^XZ",!
57 H 2
58 Q
59 ;
60DATA(X,Y,TEXT) ; Code to place the data on the label
61 W !,"^FO"_X_","_Y_"^A0N,30,20^CI13^FR^FD"_TEXT_"^FS"
62 Q ""
63 ;
64INPTR ;Input transform for DRUG field (#.31) in file 53.69.
65 K:$L(X)>40!($L(X)<1) X I $D(X) D
66 .S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
67 .N DIC S DIC="^PSDRUG(",DIC(0)="EQNM",D="B^C^VAPN^VAC^NDC^XATC"
68 .S DIC("S")="I '$G(^PSDRUG(+Y,""I""))!($G(^(""I""))>DT),$P($G(^PSDRUG(+Y,2)),U,3)[""I""!($P($G(^PSDRUG(+Y,2)),U,3)[""U"")"
69 .D:+X'>0 MIX^DIC1
70 .D:+X>0 ^DIC
71 .S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X
72 Q
73 ;
Note: See TracBrowser for help on using the repository browser.