source: FOIAVistA/trunk/r/CMOP-PSX/PSXLBL.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PSXLBL ;BIR/HTW,BAB-CMOP Host Label Print..User Input ; [ 05/01/97 11:47 AM ]
2 ;;2.0;CMOP;**1**;11 Apr 97
3START ;
4 L +^PSX(553):1 I '$T D MSG Q
5 I ^PSX(553,1,"S")="R" D MSG Q
6 G:'$D(^PSX(554,"AB")) SS
7 S R554=$O(^PSX(554,"AB",""))
8 I $P($G(^PSX(554,1,1,R554,0)),"^",4)="R" S ZH="F" D MSG Q
9SS I ^PSX(553,1,"S")="S" S ^PSX(553,1,"P")="R"
10 L -^PSX(553)
11SS1 W @IOF,!
12SS2 S DIC=552.1,DIC(0)="AEQMZ",DIC("A")="Print Facility-Batch #: "
13 I $G(REPRINT) S DIC("S")="I $P(^(0),U,2)=""3""",PSXREF="AP" G ENTER
14 I $G(REJECT) S DIC("S")="I $P(^(0),U,2)'=""2""",PSXREF="AR" G ENTER
15 S DIC("S")="I $P(^(0),U,2)=""2""",PSXREF="AQ"
16ENTER D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(""[X)!(X["^") G END
17 S BATREF=($P(Y,U,2)),N514=+Y K X,Y,DIC
18 I $D(^PSX(552.1,"APR",BATREF)) W !!,"BATCH "_BATREF_" is currently being printed.",!,"Please select another batch or ""^"" to exit.",!! K N514,X,Y,DIC G SS2
19 I $G(REPRINT) D K J,N G CHECK
20 .S N="",(J,PSXBEG,PSXEND)=0
21 .F S N=$O(^PSX(552.2,"AP",N)) Q:($G(N)']"") I N[BATREF D
22 ..F J=0:0 S J=$O(^PSX(552.2,"AP",N,J)) Q:'J D
23 ...S:J>PSXEND PSXEND=J S:PSXBEG=0 PSXBEG=J
24 I $D(^PSX(552.2,PSXREF,BATREF)) S (PSXBEG,X)=0 F S X=$O(^PSX(552.2,PSXREF,BATREF,X)) Q:'X S:PSXBEG=0 PSXBEG=X S PSXEND=X
25CHECK I '$G(PSXBEG)!('$G(PSXEND)) S ^PSX(553,1,"P")="S" W !!,"No data to "_$S($G(REPRINT):"reprint",1:"print")_" for CMOP Msg # ",BATREF,". Select another batch.",! H 3 G START
26 K X D DEVICE
27END S ^PSX(553,1,"P")="S"
28 K PSXBEG,PSXEND,BATREF,Z,ER,NTE,Q,V,C,ZZ,Z,X,Y,G,A,CT,CH1,L,PSXST
29 K ZY,IEN14,CNT,R554,DUOUT,DTOUT,DIRUT,DIROUT,N514
30 K PSXLAP,PSXREF,REPRINT,PSXBLR,POP,PSXBAR,PSXIOS,REJECT
31 Q
32DEVICE W !! S %ZIS="MNQ",%ZIS("A")="Select Label Printer: ",%ZIS("B")=""
33 D ^%ZIS K %ZIS,IO("Q"),IOP G:POP END I $E(IOST,1,2)["C-" W !,"You must choose a printer or ""^"" to exit" G DEVICE
34 S PSXLAP=ION D PSET^%ZISP I $G(IOBARON)]"" S PSXBAR=1,PSXIOS=IOS
35 D ^%ZISC K J,C
36TOF S DIR("A")="OK TO ASSUME LABEL ALIGNMENT IS CORRECT ?"
37 S DIR("B")="YES",DIR(0)="SB^Y:YES;N:NO",DIR("?")="Enter Y if labels are OK, N if they need to be aligned."
38 D ^DIR K DIR G:$D(DIRUT) END
39 G:("Yy"[$E(Y)) QUE
40P2 S IOP=$G(PSXLAP) D ^%ZIS K IOP I POP W !?5,"PRINTER IS BUSY. " G TOF
41 U IO(0) W !,"ALIGN LABELS SO THAT A PERFORATION IS AT THE TOP OF THE"
42 W !,"PRINT HEAD AND THE LEFT SIDE IS AT COLUMN ZERO."
43 R !,"PRESS RETURN WHEN READY:",X:DTIME Q:"^"=X!'$T D PTEST^PSXLBLPT D ^%ZISC
44 S DIR("A")="IS THIS CORRECT ?",DIR("B")="YES"
45 S DIR(0)="SB^Y:YES;N:NO",DIR("?")="Enter Y if labels are OK, N if they need to be aligned."
46 D ^DIR K DIR G:$D(DIRUT) END
47 K DIR G:("Yy"[$E(Y)) QUE
48 G P2
49QUE S ZTSAVE("PSXBEG")="",ZTSAVE("PSXEND")="",ZTSAVE("BATREF")=""
50 S ZTSAVE("PSXBAR")="",ZTSAVE("REPRINT")=""
51 S ZTSAVE("N514")="",ZTIO=PSXLAP,ZTSAVE("RESET")="",ZTSAVE("PSXREF")=""
52 S ZTSAVE("PSXBLR")="",ZTSAVE("IOBARON")="",ZTSAVE("IOBAROFF")=""
53 S ZTRTN="^PSXLBL1",ZTDESC="CMOP Host Label Print" D ^%ZTLOAD
54Q1 W:$D(ZTSK) !!,"LABELS Queued to Print!!"
55 Q
56MSG W !!,"Labels may NOT be printed while the CMOP "_$S($G(ZH)="F":"Background Filer ",1:"Interface ")_"is running.",!!,"Please try again later...",!! L -^PSX(553)
57 K ZH
58 Q
59REPRINT S REPRINT=1 G START
60REJECT S REJECT=1 G START
Note: See TracBrowser for help on using the repository browser.