source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOBZ.m@ 846

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1PSBOBZ ;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 ;
9EN ;
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 ;
54LABEL ;Get Barcode Label Type
55 ;Barcode Type
56 S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
57 ;
58INIT ;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 ;
76END ; Close Label or End of Label
77 I $G(PSBCODE("EL"))]"" X PSBCODE("EL")
78 H 2
79 Q
80 ;
81START ;Start Label Print Process
82 I $G(PSBCODE("SL"))]"" X PSBCODE("SL")
83 Q
84 ;
85PRINT ;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 ;
97PROCESS ;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 ;
102INPTR ;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
Note: See TracBrowser for help on using the repository browser.