Routine: LRLABLIO

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")

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

LRLABLIO.m