| 1 | PSXLBL ;BIR/HTW,BAB-CMOP Host Label Print..User Input ; [ 05/01/97 11:47 AM ]
|
|---|
| 2 | ;;2.0;CMOP;**1**;11 Apr 97
|
|---|
| 3 | START ;
|
|---|
| 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
|
|---|
| 9 | SS I ^PSX(553,1,"S")="S" S ^PSX(553,1,"P")="R"
|
|---|
| 10 | L -^PSX(553)
|
|---|
| 11 | SS1 W @IOF,!
|
|---|
| 12 | SS2 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"
|
|---|
| 16 | ENTER 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
|
|---|
| 25 | CHECK 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
|
|---|
| 27 | END 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
|
|---|
| 32 | DEVICE 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
|
|---|
| 36 | TOF 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
|
|---|
| 40 | P2 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
|
|---|
| 49 | QUE 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
|
|---|
| 54 | Q1 W:$D(ZTSK) !!,"LABELS Queued to Print!!"
|
|---|
| 55 | Q
|
|---|
| 56 | MSG 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
|
|---|
| 59 | REPRINT S REPRINT=1 G START
|
|---|
| 60 | REJECT S REJECT=1 G START
|
|---|
