LRLABLIO ;DALOI/TGA/JMC - TESTS LABEL PRINTER ;JUL 06, 2010 3:14 PM
;;5.2;LAB SERVICE;**1018,1022,1027**;NOV 01, 1997
;;5.2;LAB SERVICE;**107,161,218**;Sep 27, 1994
;
; 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")="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 $L(X) S %ZIS("B")=X
;
I %ZIS("B")="LABLABEL",$D(^LAB(69.9,1,3.5,+$G(DUZ(2)),0)) D
. ; Get this division's default printer
. 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
;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
; If OR half of the above IF statement, (IO=IO(0)), is left in,
; then it is impossible to test printer to the screen.
I POP D BD Q
;----- END IHS/OIT/MKK MOD LR*5.2*1022
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?"
. ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
. S DIR(0)="YAO"
. S DIR("A",1)=" NOT printing on a printer."
. S DIR("A",2)=" "
. S DIR("A")=" Is this correct? "
. S DIR("B")="YES"
. ;----- END IHS/OIT/MKK MOD LR*5.2*1022
. 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
NEW DOB,SEX ; IHS/OIT/MKK - LR*5.2*1027
;
; 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)
; ----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
S LRAA=0
S LRAD=0
S PROV="TEST,PROV"
S DOB="XX/XX/XX"
S SEX="X"
; ----- END IHS/OIT/MKK MOD LR*5.2*1022
;
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
LRLABLIO ;DALOI/TGA/JMC - TESTS LABEL PRINTER ;JUL 06, 2010 3:14 PM
+1 ;;5.2;LAB SERVICE;**1018,1022,1027**;NOV 01, 1997
+2 ;;5.2;LAB SERVICE;**107,161,218**;Sep 27, 1994
+3 ;
+4 ; Reference to File #3.5 supported by DBIA #2469
+5 ;
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")="LABLABEL"
+9 ;
+10 ; Check if label device assigned to this user's HOME Device file entry.
+11 IF $GET(IOS)
Begin DoDot:1
+12 SET X=$$GET1^DIQ(3.5,IOS_",",101,"E")
+13 IF $LENGTH(X)
SET %ZIS("B")=X
End DoDot:1
+14 ;
+15 IF %ZIS("B")="LABLABEL"
IF $DATA(^LAB(69.9,1,3.5,+$GET(DUZ(2)),0))
Begin DoDot:1
+16 ; Get this division's default printer
+17 SET %ZIS("B")=$PIECE($GET(^LAB(69.9,1,3.5,+DUZ(2),0)),U,3)
End DoDot:1
+18 IF %ZIS("B")=""
SET %ZIS("B")="LABLABEL"
+19 SET %ZIS("A")="Print labels on: "
SET %ZIS="NQ"
+20 ; Setup handle for user's LABEL device.
2 DO OPEN^%ZISUTL("LRLABEL",,.%ZIS)
+1 ; I POP!(IO=IO(0)) D BD Q
+2 ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
+3 ; If OR half of the above IF statement, (IO=IO(0)), is left in,
+4 ; then it is impossible to test printer to the screen.
+5 IF POP
DO BD
QUIT
+6 ;----- END IHS/OIT/MKK MOD LR*5.2*1022
+7 SET LRLABLIO=ION_";"_IOST_";"_IOM_";"_IOSL
+8 IF $DATA(IO("Q"))
SET LRLABLIO("Q")=1
+9 IF $EXTRACT(IOST,1)'="P"
Begin DoDot:1
+10 NEW DIR,DIRUT,DTOUT,DUOUT
+11 DO USE^%ZISUTL("LRHOME")
+12 ;S DIR(0)="YAO",DIR("A",1)="NOT printing on a printer.",DIR("A")="Are you sure?"
+13 ;----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
+14 SET DIR(0)="YAO"
+15 SET DIR("A",1)=" NOT printing on a printer."
+16 SET DIR("A",2)=" "
+17 SET DIR("A")=" Is this correct? "
+18 SET DIR("B")="YES"
+19 ;----- END IHS/OIT/MKK MOD LR*5.2*1022
+20 DO ^DIR
End DoDot:1
IF Y'=1
GOTO 2
+21 ; Device on another cpu, can't test.
+22 IF $DATA(IOCPU)
Begin DoDot:1
+23 NEW MSG
+24 SET MSG="Device "_ION_" is on CPU '"_IOCPU_"' - Unable to test"
+25 DO USE^%ZISUTL("LRHOME")
+26 DO EN^DDIOL(MSG,"","!?5")
+27 DO K
End DoDot:1
QUIT
+28 ;
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 ; IHS/OIT/MKK - LR*5.2*1027
NEW DOB,SEX
+13 ;
+14 ; Set up variables for test label
+15 SET PNM="TEST-LABEL-DO-NOT-USE"
SET SSN="000-00-0000P"
SET LRDAT="XX/XX/XX"
SET LRLLOC="LAB"
SET LRRB=1
+16 SET LRACC="SITE-TEST-LABEL"
SET LRCE="9999999"
SET LRPREF="SMALL "
+17 SET LRTOP="TEST-TUBE"
SET LRTS(1)="Don't-use"
SET LRTS(2)="this-label"
+18 SET LRINFW="Patient-info-field"
SET (LRBARID,LRUID)="0000000000"
SET LRAN="000"
SET I=1
SET N=1
SET LRXL=0
+19 SET (LRURG,LRURG0)=1
+20 SET LRURGA=$$URGA^LRLABLD(LRURG0)
+21 ; ----- BEGIN IHS/OIT/MKK MOD LR*5.2*1022
+22 SET LRAA=0
+23 SET LRAD=0
+24 SET PROV="TEST,PROV"
+25 SET DOB="XX/XX/XX"
+26 SET SEX="X"
+27 ; ----- END IHS/OIT/MKK MOD LR*5.2*1022
+28 ;
+29 DO LRBAR^LRLABLD
+30 DO USE^%ZISUTL("LRLABEL")
DO @LRLABEL
+31 DO USE^%ZISUTL("LRHOME")
+32 ;
+33 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+34 WRITE !
+35 SET DIR(0)="YAO"
SET DIR("A")="Label OK: "
SET DIR("B")="YES"
+36 SET DIR("?")="Enter 'YES' if label printed correctly, 'NO' if it did not."
+37 DO ^DIR
+38 IF $DATA(DIRUT)
GOTO BD
+39 IF Y=1
GOTO K
+40 ;
+41 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+42 WRITE !
+43 SET DIR(0)="YAO"
SET DIR("A")="Test printer again: "
SET DIR("B")="YES"
+44 SET DIR("?")="Enter 'YES' to test label printing, 'NO' to quit testing."
+45 DO ^DIR
+46 IF $DATA(DIRUT)
GOTO BD
+47 IF Y=1
GOTO T
+48 GOTO K
+49 ;
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
