PSXLBL.m

PSXLBL ;BIR/HTW,BAB-CMOP Host Label Print..User Input ; [ 05/01/97  11:47 AM ]

 ;;2.0;CMOP;**1**;11 Apr 97

START ;

 L +^PSX(553):1 I '$T D MSG Q

 I ^PSX(553,1,"S")="R" D MSG Q

 G:'$D(^PSX(554,"AB")) SS

 S R554=$O(^PSX(554,"AB",""))

 I $P($G(^PSX(554,1,1,R554,0)),"^",4)="R" S ZH="F" D MSG Q

SS I ^PSX(553,1,"S")="S" S ^PSX(553,1,"P")="R"

 L -^PSX(553)

SS1 W @IOF,!

SS2 S DIC=552.1,DIC(0)="AEQMZ",DIC("A")="Print Facility-Batch #: "

 I $G(REPRINT) S DIC("S")="I $P(^(0),U,2)=""3""",PSXREF="AP" G ENTER

 I $G(REJECT) S DIC("S")="I $P(^(0),U,2)'=""2""",PSXREF="AR" G ENTER

 S DIC("S")="I $P(^(0),U,2)=""2""",PSXREF="AQ"

ENTER D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(""[X)!(X["^") G END

 S BATREF=($P(Y,U,2)),N514=+Y K X,Y,DIC

 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

 I $G(REPRINT) D  K J,N G CHECK

 .S N="",(J,PSXBEG,PSXEND)=0

 .F  S N=$O(^PSX(552.2,"AP",N)) Q:($G(N)']"")  I N[BATREF D

 ..F J=0:0 S J=$O(^PSX(552.2,"AP",N,J)) Q:'J  D

 ...S:J>PSXEND PSXEND=J S:PSXBEG=0 PSXBEG=J

 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

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

 K X D DEVICE

END S ^PSX(553,1,"P")="S"

 K PSXBEG,PSXEND,BATREF,Z,ER,NTE,Q,V,C,ZZ,Z,X,Y,G,A,CT,CH1,L,PSXST

 K ZY,IEN14,CNT,R554,DUOUT,DTOUT,DIRUT,DIROUT,N514

 K PSXLAP,PSXREF,REPRINT,PSXBLR,POP,PSXBAR,PSXIOS,REJECT

 Q

DEVICE W !! S %ZIS="MNQ",%ZIS("A")="Select Label Printer: ",%ZIS("B")=""

 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

 S PSXLAP=ION D PSET^%ZISP I $G(IOBARON)]"" S PSXBAR=1,PSXIOS=IOS

 D ^%ZISC K J,C

TOF S DIR("A")="OK TO ASSUME LABEL ALIGNMENT IS CORRECT ?"

 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."

 D ^DIR K DIR G:$D(DIRUT) END

 G:("Yy"[$E(Y)) QUE

P2 S IOP=$G(PSXLAP) D ^%ZIS K IOP I POP W !?5,"PRINTER IS BUSY. " G TOF

 U IO(0) W !,"ALIGN LABELS SO THAT A PERFORATION IS AT THE TOP OF THE"

 W !,"PRINT HEAD AND THE LEFT SIDE IS AT COLUMN ZERO."

 R !,"PRESS RETURN WHEN READY:",X:DTIME Q:"^"=X!'$T  D PTEST^PSXLBLPT D ^%ZISC

 S DIR("A")="IS THIS CORRECT ?",DIR("B")="YES"

 S DIR(0)="SB^Y:YES;N:NO",DIR("?")="Enter Y if labels are OK, N if they need to be aligned."

 D ^DIR K DIR G:$D(DIRUT) END

 K DIR G:("Yy"[$E(Y)) QUE

 G P2

QUE S ZTSAVE("PSXBEG")="",ZTSAVE("PSXEND")="",ZTSAVE("BATREF")=""

 S ZTSAVE("PSXBAR")="",ZTSAVE("REPRINT")=""

 S ZTSAVE("N514")="",ZTIO=PSXLAP,ZTSAVE("RESET")="",ZTSAVE("PSXREF")=""

 S ZTSAVE("PSXBLR")="",ZTSAVE("IOBARON")="",ZTSAVE("IOBAROFF")=""

 S ZTRTN="^PSXLBL1",ZTDESC="CMOP Host Label Print" D ^%ZTLOAD

Q1 W:$D(ZTSK) !!,"LABELS Queued to Print!!"

 Q

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)

 K ZH

 Q

REPRINT S REPRINT=1 G START

REJECT S REJECT=1 G START

PSXLBL    ;BIR/HTW,BAB-CMOP Host Label Print..User Input ; [ 05/01/97  11:47 AM ]

 +1       ;;2.0;CMOP;**1**;11 Apr 97

START     ;

 +1        LOCK +^PSX(553):1

           IF '$TEST

               DO MSG

               QUIT 

 +2        IF ^PSX(553,1,"S")="R"

               DO MSG

               QUIT 

 +3        IF '$DATA(^PSX(554,"AB"))

               GOTO SS

 +4        SET R554=$ORDER(^PSX(554,"AB",""))

 +5        IF $PIECE($GET(^PSX(554,1,1,R554,0)),"^",4)="R"

               SET ZH="F"

               DO MSG

               QUIT 

SS         IF ^PSX(553,1,"S")="S"

               SET ^PSX(553,1,"P")="R"

 +1        LOCK -^PSX(553)

SS1        WRITE @IOF,!

SS2        SET DIC=552.1

           SET DIC(0)="AEQMZ"

           SET DIC("A")="Print Facility-Batch #: "

 +1        IF $GET(REPRINT)

               SET DIC("S")="I $P(^(0),U,2)=""3"""

               SET PSXREF="AP"

               GOTO ENTER

 +2        IF $GET(REJECT)

               SET DIC("S")="I $P(^(0),U,2)'=""2"""

               SET PSXREF="AR"

               GOTO ENTER

 +3        SET DIC("S")="I $P(^(0),U,2)=""2"""

           SET PSXREF="AQ"

ENTER      DO ^DIC

           KILL DIC

           IF $DATA(DUOUT)!($DATA(DTOUT))!(""[X)!(X["^")

               GOTO END

 +1        SET BATREF=($PIECE(Y,U,2))

           SET N514=+Y

           KILL X,Y,DIC

 +2        IF $DATA(^PSX(552.1,"APR",BATREF))

               WRITE !!,"BATCH "_BATREF_" is currently being printed.",!,"Please select another batch or ""^"" to exit.",!!

               KILL N514,X,Y,DIC

               GOTO SS2

 +3        IF $GET(REPRINT)

               Begin DoDot:1

 +4                SET N=""

                   SET (J,PSXBEG,PSXEND)=0

 +5                FOR 

                       SET N=$ORDER(^PSX(552.2,"AP",N))

                       IF ($GET(N)']"")

                           QUIT 

                       IF N[BATREF

                           Begin DoDot:2

 +6                            FOR J=0:0

                                   SET J=$ORDER(^PSX(552.2,"AP",N,J))

                                   IF 'J

                                       QUIT 

                                   Begin DoDot:3

 +7                                    IF J>PSXEND

                                           SET PSXEND=J

                                       IF PSXBEG=0

                                           SET PSXBEG=J

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

               KILL J,N

               GOTO CHECK

 +8        IF $DATA(^PSX(552.2,PSXREF,BATREF))

               SET (PSXBEG,X)=0

               FOR 

                   SET X=$ORDER(^PSX(552.2,PSXREF,BATREF,X))

                   IF 'X

                       QUIT 

                   IF PSXBEG=0

                       SET PSXBEG=X

                   SET PSXEND=X

CHECK      IF '$GET(PSXBEG)!('$GET(PSXEND))

               SET ^PSX(553,1,"P")="S"

               WRITE !!,"No data to "_$SELECT($GET(REPRINT):"reprint",1:"print")_" for CMOP Msg # ",BATREF,".  Select another batch.",!

               HANG 3

               GOTO START

 +1        KILL X

           DO DEVICE

END        SET ^PSX(553,1,"P")="S"

 +1        KILL PSXBEG,PSXEND,BATREF,Z,ER,NTE,Q,V,C,ZZ,Z,X,Y,G,A,CT,CH1,L,PSXST

 +2        KILL ZY,IEN14,CNT,R554,DUOUT,DTOUT,DIRUT,DIROUT,N514

 +3        KILL PSXLAP,PSXREF,REPRINT,PSXBLR,POP,PSXBAR,PSXIOS,REJECT

 +4        QUIT 

DEVICE     WRITE !!

           SET %ZIS="MNQ"

           SET %ZIS("A")="Select Label Printer: "

           SET %ZIS("B")=""

 +1        DO ^%ZIS

           KILL %ZIS,IO("Q"),IOP

           IF POP

               GOTO END

           IF $EXTRACT(IOST,1,2)["C-"

               WRITE !,"You must choose a printer or ""^"" to exit"

               GOTO DEVICE

 +2        SET PSXLAP=ION

           DO PSET^%ZISP

           IF $GET(IOBARON)]""

               SET PSXBAR=1

               SET PSXIOS=IOS

 +3        DO ^%ZISC

           KILL J,C

TOF        SET DIR("A")="OK TO ASSUME LABEL ALIGNMENT IS CORRECT ?"

 +1        SET DIR("B")="YES"

           SET DIR(0)="SB^Y:YES;N:NO"

           SET DIR("?")="Enter Y if labels are OK, N if they need to be aligned."

 +2        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

 +3        IF ("Yy"[$EXTRACT(Y))

               GOTO QUE

P2         SET IOP=$GET(PSXLAP)

           DO ^%ZIS

           KILL IOP

           IF POP

               WRITE !?5,"PRINTER IS BUSY. "

               GOTO TOF

 +1        USE IO(0)

           WRITE !,"ALIGN LABELS SO THAT A PERFORATION IS AT THE TOP OF THE"

 +2        WRITE !,"PRINT HEAD AND THE LEFT SIDE IS AT COLUMN ZERO."

 +3        READ !,"PRESS RETURN WHEN READY:",X:DTIME

           IF "^"=X!'$TEST

               QUIT 

           DO PTEST^PSXLBLPT

           DO ^%ZISC

 +4        SET DIR("A")="IS THIS CORRECT ?"

           SET DIR("B")="YES"

 +5        SET DIR(0)="SB^Y:YES;N:NO"

           SET DIR("?")="Enter Y if labels are OK, N if they need to be aligned."

 +6        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

 +7        KILL DIR

           IF ("Yy"[$EXTRACT(Y))

               GOTO QUE

 +8        GOTO P2

QUE        SET ZTSAVE("PSXBEG")=""

           SET ZTSAVE("PSXEND")=""

           SET ZTSAVE("BATREF")=""

 +1        SET ZTSAVE("PSXBAR")=""

           SET ZTSAVE("REPRINT")=""

 +2        SET ZTSAVE("N514")=""

           SET ZTIO=PSXLAP

           SET ZTSAVE("RESET")=""

           SET ZTSAVE("PSXREF")=""

 +3        SET ZTSAVE("PSXBLR")=""

           SET ZTSAVE("IOBARON")=""

           SET ZTSAVE("IOBAROFF")=""

 +4        SET ZTRTN="^PSXLBL1"

           SET ZTDESC="CMOP Host Label Print"

           DO ^%ZTLOAD

Q1         IF $DATA(ZTSK)

               WRITE !!,"LABELS Queued to Print!!"

 +1        QUIT 

MSG        WRITE !!,"Labels may NOT be printed while the CMOP "_$SELECT($GET(ZH)="F":"Background Filer ",1:"Interface ")_"is running.",!!,"Please try again later...",!!

           LOCK -^PSX(553)

 +1        KILL ZH

 +2        QUIT 

REPRINT    SET REPRINT=1

           GOTO START

REJECT     SET REJECT=1

           GOTO START