source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBARCF.m@ 1401

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1LRBARCF ;DALOI/JMC - Lab Label Configuration Utility ;1/13/97 12:36
2 ;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
3EN ;
4 ;
5 N %ZIS,DIC,DIR,DIRUT,DTOUT,DUOUT,J,X,Y
6 N LABEL,LRCLRFMT,LRFMT,LRLABEL,LRLABLIO,LRMSG,LRNODE,LRQUIT
7 ;
8 S LRQUIT=0,LRMSG=""
9 ;
10 S DIC="^LAB(69.9,1,3.6,",DIC(0)="AEMQZ",DIC("A")="Select LABEL DEVICE: "
11 D ^DIC Q:Y<1
12 S LRLABLIO=Y(0,0),LRNODE=+Y,LRNODE(0)=Y(0)
13 ;
14 F J=2:1:3 I $P(LRNODE(0),"^",J)="" D
15 . I J=2 S LRMSG="No printer type designated in file #69.9"
16 . I J=3 S LRMSG="No label stock designated in file #69.9"
17 . S LRQUIT=1
18 ;
19 I 'LRQUIT,$P(LRNODE(0),"^",2)<1 S LRMSG="This printer type not supported",LRQUIT=1
20 ;
21 I LRQUIT D Q
22 . I $L(LRMSG) D EN^DDIOL(LRMSG,"","!?12")
23 ;
24 S DIR(0)=""
25 F J=1:1 S LABEL="F"_J,X=$T(@LABEL) Q:X="" D
26 . I $L($P(X,";;",2+$P(LRNODE(0),"^",2))) S DIR(0)=DIR(0)_J_":"_$P(X,";;",2)_";"
27 S DIR("A")="Select format to program printer"
28 S DIR(0)="SO^"_DIR(0)
29 D ^DIR Q:$D(DIRUT)
30 ;
31 S LRFMT=+Y,LABEL="F"_LRFMT,LRLABEL=$P($T(@LABEL),";;",2+$P(LRNODE(0),"^",2))
32 I $P(LRNODE(0),"^",2)=1 D Q:LRQUIT
33 . N DIR,DIRUT,DTOUT,DUOUT,X,Y
34 . S DIR(0)="YO",DIR("A")="Do you want to clear all existing formats",DIR("B")="NO"
35 . D ^DIR
36 . I $D(DIRUT) S LRQUIT=1 Q
37 . S LRCLRFMT=+Y
38 ;
39 S IOP=LRLABLIO,%ZIS="Q" D ^%ZIS
40 I POP D HOME^%ZIS Q
41 I $D(IO("Q")) D Q
42 . N ZTSK
43 . S ZTRTN="DQ^LRBARCF",ZTDESC="Program Lab Label Printer"
44 . F J="LRFMT","LRLABEL","LRCLRFMT" S ZTSAVE(J)=""
45 . D ^%ZTLOAD,^%ZISC
46 . D EN^DDIOL("Task "_$S($G(ZTSK):"",1:"NOT ")_"Queued","","!")
47 ;
48DQ ; Start the programming
49 ;
50 I LRCLRFMT D CLRFMT^LRBARA
51 ;
52 I '$D(ZTQUEUED) D
53 . U IO(0)
54 . D EN^DDIOL("Programming format F"_LRFMT,"","!")
55 ;
56 U IO
57 D @LRLABEL
58 ;
59 I $D(ZTQUEUED) S ZTREQ="@"
60 E D ^%ZISC
61 ;
62 Q
63 ;
64 ;
65FORMATS ;;Type of label stock;;Download routine for Intermec 3000/4000 Series;;
66F1 ;;Local Use;;
67F2 ;;Local Use;;
68F3 ;;1x2 Plain (Old Style);;FMT^LRBARA;;
69F4 ;;1x2 Barcode (Old Style);;FMT^LRBARA;;
70F5 ;;1x2 Code 39/128 - UID;;FMT^LRBARA;;
71F6 ;;Local Use;;
72F7 ;;1x3 Plain (Old Style);;FMT^LRBARC;;
73F8 ;;1x3 Barcode (Old Style);;FMT^LRBARC;;
74F9 ;;1x3 Code 39/128 - UID;;FMT^LRBARC;;
75F10 ;;Local Use;;
76F11 ;;Local Use;;
77F12 ;;10 Part Barcode (Old Style);;FMT^LRBARB;;
78F13 ;;10 Part Code 39/128 - UID;;FMT^LRBARB;;
79F14 ;;Reserved - future use;;
80F15 ;;Reserved - future use;;
81F16 ;;Reserved - future use;;
82F17 ;;Reserved - future use;;
83F18 ;;Reserved - future use;;
84F19 ;;Reserved - future use;;
Note: See TracBrowser for help on using the repository browser.