- LRLABLIO ;SLC/TGA- TESTS LABEL PRINTER ; 8/22/88 11:53 ;8/19/88 2:09 PM
- ;;V~3.051~
- 1 Q:$D(LRLABLIO)
- S U="^"
- S IOP=$I,%IS="N" D ^%ZIS S X=$S('POP:+IOS,1:0),X=$S($D(^%ZIS(1,+X,101)):+^(101),1:0),X=$S($D(^%ZIS(1,+X,0)):$P(^(0),U,1),1:"LABLABEL") ;AC/SFISC
- 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 X ^%ZIS("C") 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 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> K...X=$S
- ;with> S IOP=$I,%IS="N" D ^%ZIS S X=$S('POP:+IOS,1:0),X=$S
- ;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 ; 8/22/88 11:53 ;8/19/88 2:09 PM
- +1 ;;V~3.051~
- 1 IF $DATA(LRLABLIO)
- QUIT
- +1 SET U="^"
- +2 ;AC/SFISC
- SET IOP=$IO
- SET %IS="N"
- DO ^%ZIS
- SET X=$SELECT('POP:+IOS,1:0)
- 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")
- +3 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
- XECUTE ^%ZIS("C")
- 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 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> K...X=$S
- +6 ;with> S IOP=$I,%IS="N" D ^%ZIS S X=$S('POP:+IOS,1:0),X=$S
- +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
