110 lines
3.1 KiB
Mathematica
110 lines
3.1 KiB
Mathematica
LRLABLIO ;DALOI/TGA/JMC - TESTS LABEL PRINTER ;8/8/89 11:17
|
|
;;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
|
|
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
|