LRLABLIO ;DALOI/TGA/JMC - TESTS LABEL PRINTER ;May 21, 2007
;;5.2;LAB SERVICE;**107,161,218,350**;Sep 27, 1994;Build 230
;
; Reference to File #3.5 supported by DBIA #2469
;
1 ;
S U="^" Q:$D(LRLABLIO)
;
N %ZIS,DIR,DIRUT,DTOUT,DUOUT,IOP,LRLABEL,POP,X,Y
;
; Setup handle for user's "HOME" device.
D OPEN^%ZISUTL("LRHOME","HOME")
;
S %ZIS("B")=$$GET^XPAR("USR","LR LABEL PRINTER DEFAULT","`"_DUZ(2),"E")
I %ZIS("B")="" S %ZIS("B")="LABLABEL"
;
; Check if label device assigned to this user's HOME Device file entry.
I $G(IOS) D
. S X=$$GET1^DIQ(3.5,IOS_",",101,"E")
. I X'="" S %ZIS("B")=X
;
; Get this division's default printer
I %ZIS("B")="LABLABEL",$D(^LAB(69.9,1,3.5,+$G(DUZ(2)),0)) S %ZIS("B")=$P($G(^LAB(69.9,1,3.5,+DUZ(2),0)),U,3)
;
I %ZIS("B")="" S %ZIS("B")="LABLABEL"
S %ZIS("A")="Print labels on: ",%ZIS="NQ"
; Setup handle for user's LABEL device.
2 D OPEN^%ZISUTL("LRLABEL",,.%ZIS)
I POP!(IO=IO(0)) D BD Q
S LRLABLIO=ION_";"_IOST_";"_IOM_";"_IOSL
I $D(IO("Q")) S LRLABLIO("Q")=1
I $E(IOST,1)'="P" D G:Y'=1 2
. N DIR,DIRUT,DTOUT,DUOUT
. D USE^%ZISUTL("LRHOME")
. S DIR(0)="YAO",DIR("A",1)="NOT printing on a printer.",DIR("A")="Are you sure"
. D ^DIR
; Device on another cpu, can't test.
I $D(IOCPU) D Q
. N MSG
. S MSG="Device "_ION_" is on CPU '"_IOCPU_"' - Unable to test"
. D USE^%ZISUTL("LRHOME")
. D EN^DDIOL(MSG,"","!?5")
. D K
;
3 I $D(LRLABLIO("Q")) D K Q
D USE^%ZISUTL("LRHOME")
W !
K DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YAO",DIR("A")="Do you wish to test the label printer: ",DIR("B")="NO"
S DIR("?")="Enter 'YES' if you want to test the printer, 'NO' if you do not."
D ^DIR
I $D(DIRUT) D BD Q
I Y<1 G K ; Don't want to test
D OPEN^%ZISUTL("LRLABEL",LRLABLIO)
I POP D G 1
. D USE^%ZISUTL("LRHOME")
. D EN^DDIOL("Device in use - try later","","!")
. K LRLABLIO
N LRAA
S LRAA=0
D LBLTYP^LRLABLD
;
T ; Print test label
D USE^%ZISUTL("LRHOME")
K DIR,DIRUT,DTOUT,DUOUT,X,Y
W !!,"Using label routine: ",LRLABEL,!
S DIR(0)="E"
S DIR("A",1)="Load and position label stock as appropriate for this printer."
S DIR("A")="Press return when ready"
D ^DIR
I Y'=1 D BD Q
;
N I,N,PNM,SSN
N LRACC,LRBAR,LRBARID,LRCE,LRDAT,LRINFW,LRLLOC,LRPREF,LRAN,LRRB,LRTOP,LRTS,LRUID,LRURG,LRURG0,LRURGA,LRXL
;
; Set up variables for test label
S PNM="TEST-LABEL-DO-NOT-USE",SSN="000-00-0000P",LRDAT="XX/XX/XX",LRLLOC="LAB",LRRB=1
S LRACC="SITE-TEST-LABEL",LRCE="9999999",LRPREF="SMALL "
S LRTOP="TEST-TUBE",LRTS(1)="Don't-use",LRTS(2)="this-label"
S LRINFW="Patient info field",(LRBARID,LRUID)="0000000000",LRAN="000",I=1,N=1,LRXL=0
S (LRURG,LRURG0)=1
S LRURGA=$$URGA^LRLABLD(LRURG0)
;
D LRBAR^LRLABLD
D USE^%ZISUTL("LRLABEL"),@LRLABEL
D USE^%ZISUTL("LRHOME")
;
K DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="YAO",DIR("A")="Label OK: ",DIR("B")="YES"
S DIR("?")="Enter 'YES' if label printed correctly, 'NO' if it did not."
D ^DIR
I $D(DIRUT) G BD
I Y=1 G K
;
K DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="YAO",DIR("A")="Test printer again: ",DIR("B")="YES"
S DIR("?")="Enter 'YES' to test label printing, 'NO' to quit testing."
D ^DIR
I $D(DIRUT) G BD
I Y=1 G T
G K
;
BD ; Bad device - abort, timeout, unsuccessful selection
K LRLABLIO
K ; Close devices
D CLOSE^%ZISUTL("LRLABEL")
D CLOSE^%ZISUTL("LRHOME")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABLIO 3410 printed Oct 16, 2024@18:16:51 Page 2
LRLABLIO ;DALOI/TGA/JMC - TESTS LABEL PRINTER ;May 21, 2007
+1 ;;5.2;LAB SERVICE;**107,161,218,350**;Sep 27, 1994;Build 230
+2 ;
+3 ; Reference to File #3.5 supported by DBIA #2469
+4 ;
1 ;
+1 SET U="^"
if $DATA(LRLABLIO)
QUIT
+2 ;
+3 NEW %ZIS,DIR,DIRUT,DTOUT,DUOUT,IOP,LRLABEL,POP,X,Y
+4 ;
+5 ; Setup handle for user's "HOME" device.
+6 DO OPEN^%ZISUTL("LRHOME","HOME")
+7 ;
+8 SET %ZIS("B")=$$GET^XPAR("USR","LR LABEL PRINTER DEFAULT","`"_DUZ(2),"E")
+9 IF %ZIS("B")=""
SET %ZIS("B")="LABLABEL"
+10 ;
+11 ; Check if label device assigned to this user's HOME Device file entry.
+12 IF $GET(IOS)
Begin DoDot:1
+13 SET X=$$GET1^DIQ(3.5,IOS_",",101,"E")
+14 IF X'=""
SET %ZIS("B")=X
End DoDot:1
+15 ;
+16 ; Get this division's default printer
+17 IF %ZIS("B")="LABLABEL"
IF $DATA(^LAB(69.9,1,3.5,+$GET(DUZ(2)),0))
SET %ZIS("B")=$PIECE($GET(^LAB(69.9,1,3.5,+DUZ(2),0)),U,3)
+18 ;
+19 IF %ZIS("B")=""
SET %ZIS("B")="LABLABEL"
+20 SET %ZIS("A")="Print labels on: "
SET %ZIS="NQ"
+21 ; Setup handle for user's LABEL device.
2 DO OPEN^%ZISUTL("LRLABEL",,.%ZIS)
+1 IF POP!(IO=IO(0))
DO BD
QUIT
+2 SET LRLABLIO=ION_";"_IOST_";"_IOM_";"_IOSL
+3 IF $DATA(IO("Q"))
SET LRLABLIO("Q")=1
+4 IF $EXTRACT(IOST,1)'="P"
Begin DoDot:1
+5 NEW DIR,DIRUT,DTOUT,DUOUT
+6 DO USE^%ZISUTL("LRHOME")
+7 SET DIR(0)="YAO"
SET DIR("A",1)="NOT printing on a printer."
SET DIR("A")="Are you sure"
+8 DO ^DIR
End DoDot:1
if Y'=1
GOTO 2
+9 ; Device on another cpu, can't test.
+10 IF $DATA(IOCPU)
Begin DoDot:1
+11 NEW MSG
+12 SET MSG="Device "_ION_" is on CPU '"_IOCPU_"' - Unable to test"
+13 DO USE^%ZISUTL("LRHOME")
+14 DO EN^DDIOL(MSG,"","!?5")
+15 DO K
End DoDot:1
QUIT
+16 ;
3 IF $DATA(LRLABLIO("Q"))
DO K
QUIT
+1 DO USE^%ZISUTL("LRHOME")
+2 WRITE !
+3 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="YAO"
SET DIR("A")="Do you wish to test the label printer: "
SET DIR("B")="NO"
+5 SET DIR("?")="Enter 'YES' if you want to test the printer, 'NO' if you do not."
+6 DO ^DIR
+7 IF $DATA(DIRUT)
DO BD
QUIT
+8 ; Don't want to test
IF Y<1
GOTO K
+9 DO OPEN^%ZISUTL("LRLABEL",LRLABLIO)
+10 IF POP
Begin DoDot:1
+11 DO USE^%ZISUTL("LRHOME")
+12 DO EN^DDIOL("Device in use - try later","","!")
+13 KILL LRLABLIO
End DoDot:1
GOTO 1
+14 NEW LRAA
+15 SET LRAA=0
+16 DO LBLTYP^LRLABLD
+17 ;
T ; Print test label
+1 DO USE^%ZISUTL("LRHOME")
+2 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !!,"Using label routine: ",LRLABEL,!
+4 SET DIR(0)="E"
+5 SET DIR("A",1)="Load and position label stock as appropriate for this printer."
+6 SET DIR("A")="Press return when ready"
+7 DO ^DIR
+8 IF Y'=1
DO BD
QUIT
+9 ;
+10 NEW I,N,PNM,SSN
+11 NEW LRACC,LRBAR,LRBARID,LRCE,LRDAT,LRINFW,LRLLOC,LRPREF,LRAN,LRRB,LRTOP,LRTS,LRUID,LRURG,LRURG0,LRURGA,LRXL
+12 ;
+13 ; Set up variables for test label
+14 SET PNM="TEST-LABEL-DO-NOT-USE"
SET SSN="000-00-0000P"
SET LRDAT="XX/XX/XX"
SET LRLLOC="LAB"
SET LRRB=1
+15 SET LRACC="SITE-TEST-LABEL"
SET LRCE="9999999"
SET LRPREF="SMALL "
+16 SET LRTOP="TEST-TUBE"
SET LRTS(1)="Don't-use"
SET LRTS(2)="this-label"
+17 SET LRINFW="Patient info field"
SET (LRBARID,LRUID)="0000000000"
SET LRAN="000"
SET I=1
SET N=1
SET LRXL=0
+18 SET (LRURG,LRURG0)=1
+19 SET LRURGA=$$URGA^LRLABLD(LRURG0)
+20 ;
+21 DO LRBAR^LRLABLD
+22 DO USE^%ZISUTL("LRLABEL")
DO @LRLABEL
+23 DO USE^%ZISUTL("LRHOME")
+24 ;
+25 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+26 WRITE !
+27 SET DIR(0)="YAO"
SET DIR("A")="Label OK: "
SET DIR("B")="YES"
+28 SET DIR("?")="Enter 'YES' if label printed correctly, 'NO' if it did not."
+29 DO ^DIR
+30 IF $DATA(DIRUT)
GOTO BD
+31 IF Y=1
GOTO K
+32 ;
+33 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+34 WRITE !
+35 SET DIR(0)="YAO"
SET DIR("A")="Test printer again: "
SET DIR("B")="YES"
+36 SET DIR("?")="Enter 'YES' to test label printing, 'NO' to quit testing."
+37 DO ^DIR
+38 IF $DATA(DIRUT)
GOTO BD
+39 IF Y=1
GOTO T
+40 GOTO K
+41 ;
BD ; Bad device - abort, timeout, unsuccessful selection
+1 KILL LRLABLIO
K ; Close devices
+1 DO CLOSE^%ZISUTL("LRLABEL")
+2 DO CLOSE^%ZISUTL("LRHOME")
+3 QUIT
