LRZ4LABL.m

LRLABLIO ;SLC/TGA- TESTS LABEL PRINTER ; 9/15/88  16:04 ;8/22/88  10:55 AM

 ;;V~4.08~

1 Q:$D(LRLABLIO)

 S U="^"

 K IOP,%IS,%ZIS S IOP=$I,%IS="N" D ^%ZIS S X=$S('POP:+IOS,1:0) ;AC/SFISC

 S X=$S($D(^%ZIS(1,+X,101)):+^(101),1:0),X=$S($D(^%ZIS(1,+X,0)):$P(^(0),U,1),1:"LABLABEL")

 S %IS("A")="PRINT LABELS ON: ",%IS="NQ",%IS("B")=X

2 D ^%ZIS G BD:POP

 I $E(IOST,1)'="P" W !,*7,"NOT printing on a printer. ARE YOU SURE" S %=2 D YN^DICN G:%'=1 2

 S LRLABLIO=ION K %IS I ^%ZOSF("VOL")'=$P(^%ZIS(1,IOS,0),"^",9),$P(^%ZIS(1,IOS,0),"^",9)]"" G K ;AC/SFISC

3 G K:$D(IO("Q")) U IO(0) S %=2 W !,"DO YOU WISH TO TEST THE LABEL PRINTER" D YN^DICN W:%=0 !?5,"Enter 'Y' if you want to test the printer, 'N' if you do not.",! G 3:%=0,K:%'=1

 K %IS S IOP=LRLABLIO D ^%ZIS K IOP I POP W !,"DEVICE IN USE - TRY LATER" K LRLABLIO G 1

 S LABEL="^LRLABEL"_$P(^LAB(69.9,1,3),U,3)

T U IO(0) W !,"ALIGN THE PRINT HEAD ON THE FIRST LINE OF THE LABEL" R !,"PRESS RETURN WHEN READY: ",X:DTIME I X=U G BD

 S:'$D(LRLLOC) LRLLOC="" S L9=LRLLOC,PNM="TEST, LABEL",LRDAT="XX/XX/XX",SSN="000-00-0000",LRLLOC="LAB",LRACC="TEST LABEL",LRCE="000",LRRB=1,LRPREF="SMALL ",LRTOP="TEST TUBE",LRTS(1)="DON'T USE",LRTS(2)="This label"

 S LRINFW="",I=1,N=1,LRXL=0 D @LABEL S LRLLOC=L9 K L9

 U IO(0) H 1 W !," TEST COMPLETED",!," LABELS OK" S %=1 D YN^DICN I %=1 G K

T1 W !,"TEST PRINTER AGAIN" S %=2 D YN^DICN G T:%=1,K:%=2!(%=-1) W !,"ANSWER 'YES' OR 'NO'" G T1

BD K LRLABLIO

K X ^%ZIS("C") K %IS,POP,X,IOP,LABEL,LRTS Q

 ;*** NOTE ***

 ;PATCHES HAVE BEEN INSERTED INTO THIS ROUTINE IN ORDER TO RUN WITH KERNEL V6.

 ;INSERTED BY AC/SFISC 10-30-88.  UNVERIFIED PATCHES.

 ;Line> 1+2

 ;replace> S X=IOS

 ;with> S X=$S('POP:+IOS,1:0)

 ;Line> 2+2

 ;replace> G K:$P

 ;with> I ^%ZOSF("VOL")'=$P(^%ZIS(1,IOS,0),"^",9),$P

 ;replace> ]""

 ;with> ]"" G K

LRLABLIO  ;SLC/TGA- TESTS LABEL PRINTER ; 9/15/88  16:04 ;8/22/88  10:55 AM

 +1       ;;V~4.08~

1          IF $DATA(LRLABLIO)

               QUIT 

 +1        SET U="^"

 +2       ;AC/SFISC

           KILL IOP,%IS,%ZIS

           SET IOP=$IO

           SET %IS="N"

           DO ^%ZIS

           SET X=$SELECT('POP:+IOS,1:0)

 +3        SET X=$SELECT($DATA(^%ZIS(1,+X,101)):+^(101),1:0)

           SET X=$SELECT($DATA(^%ZIS(1,+X,0)):$PIECE(^(0),U,1),1:"LABLABEL")

 +4        SET %IS("A")="PRINT LABELS ON: "

           SET %IS="NQ"

           SET %IS("B")=X

2          DO ^%ZIS

           IF POP

               GOTO BD

 +1        IF $EXTRACT(IOST,1)'="P"

               WRITE !,*7,"NOT printing on a printer. ARE YOU SURE"

               SET %=2

               DO YN^DICN

               IF %'=1

                   GOTO 2

 +2       ;AC/SFISC

           SET LRLABLIO=ION

           KILL %IS

           IF ^%ZOSF("VOL")'=$PIECE(^%ZIS(1,IOS,0),"^",9)

               IF $PIECE(^%ZIS(1,IOS,0),"^",9)]""

                   GOTO K

3          IF $DATA(IO("Q"))

               GOTO K

           USE IO(0)

           SET %=2

           WRITE !,"DO YOU WISH TO TEST THE LABEL PRINTER"

           DO YN^DICN

           IF %=0

               WRITE !?5,"Enter 'Y' if you want to test the printer, 'N' if you do not.",!

           IF %=0

               GOTO 3

           IF %'=1

               GOTO K

 +1        KILL %IS

           SET IOP=LRLABLIO

           DO ^%ZIS

           KILL IOP

           IF POP

               WRITE !,"DEVICE IN USE - TRY LATER"

               KILL LRLABLIO

               GOTO 1

 +2        SET LABEL="^LRLABEL"_$PIECE(^LAB(69.9,1,3),U,3)

T          USE IO(0)

           WRITE !,"ALIGN THE PRINT HEAD ON THE FIRST LINE OF THE LABEL"

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

           IF X=U

               GOTO BD

 +1        IF '$DATA(LRLLOC)

               SET LRLLOC=""

           SET L9=LRLLOC

           SET PNM="TEST, LABEL"

           SET LRDAT="XX/XX/XX"

           SET SSN="000-00-0000"

           SET LRLLOC="LAB"

           SET LRACC="TEST LABEL"

           SET LRCE="000"

           SET LRRB=1

           SET LRPREF="SMALL "

           SET LRTOP="TEST TUBE"

           SET LRTS(1)="DON'T USE"

           SET LRTS(2)="This label"

 +2        SET LRINFW=""

           SET I=1

           SET N=1

           SET LRXL=0

           DO @LABEL

           SET LRLLOC=L9

           KILL L9

 +3        USE IO(0)

           HANG 1

           WRITE !," TEST COMPLETED",!," LABELS OK"

           SET %=1

           DO YN^DICN

           IF %=1

               GOTO K

T1         WRITE !,"TEST PRINTER AGAIN"

           SET %=2

           DO YN^DICN

           IF %=1

               GOTO T

           IF %=2!(%=-1)

               GOTO K

           WRITE !,"ANSWER 'YES' OR 'NO'"

           GOTO T1

BD         KILL LRLABLIO

K          XECUTE ^%ZIS("C")

           KILL %IS,POP,X,IOP,LABEL,LRTS

           QUIT 

 +1       ;*** NOTE ***

 +2       ;PATCHES HAVE BEEN INSERTED INTO THIS ROUTINE IN ORDER TO RUN WITH KERNEL V6.

 +3       ;INSERTED BY AC/SFISC 10-30-88.  UNVERIFIED PATCHES.

 +4       ;Line> 1+2

 +5       ;replace> S X=IOS

 +6       ;with> S X=$S('POP:+IOS,1:0)

 +7       ;Line> 2+2

 +8       ;replace> G K:$P

 +9       ;with> I ^%ZOSF("VOL")'=$P(^%ZIS(1,IOS,0),"^",9),$P

 +10      ;replace> ]""

 +11      ;with> ]"" G K