Routine: LRHY01

LRHY01 ;VA/DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:02am

 ;;5.2;LAB SERVICE;**405,435**;NOV 01, 1997;Build 31

PICK ;

 ;  pick the site from Howdy Site FILE 69.86

 S LREND=0

 S DIC(0)="AEMQZ"

 S DIC=69.86

 D ^DIC

 I Y=-1 S LREND=1 QUIT

 S LRHYSITE=+Y

 K DIC

 N LRHY S LRHY="NUL" S LRHY=$O(^%ZIS(1,"B",LRHY))

 S LRDEV=$O(^%ZIS(1,"B",LRHY,0))

 D BINGO

 G ALT

 ; Pick a printer

 S LRDEV=0

 K DIC

 S DIC(0)="EMQZ" K Y S LRHYCT2=1

 F  S LRDEV=$O(^LRHY(69.86,LRHYSITE,10,"B",LRDEV)) Q:+LRDEV'>0  D

 .  W !,LRHYCT2,". ",$P(^%ZIS(1,LRDEV,0),U)

 .  S LRX(LRHYCT2)=LRDEV S LRHYCT2=LRHYCT2+1

CHOOO W !,"Choose a label printer: " R X:DTIME W !

 I X="" W !,"NOTHING SELECTED" S LREND=1 QUIT

 I U[X S LREND=1 QUIT

 I 'X I $G(X)'="" W !,"enter the number please" G CHOOO

 S LRDEV=LRX(X)

ALT ;

 W ?11,$P(^%ZIS(1,LRDEV,0),U) H 2

 K DIC

 K LRHYCT2

 QUIT

VET ; Primary API for Howdy!  Called by [LRHY PATIENT CARD SCAN] option.

 D XTMP^LRHYU

 N LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD

 N LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI

 N LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND

 N LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU

 N LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN

 N LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ

 N LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT

 N LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99

 N LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X

 K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3

 K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT

 K LRHY3DT3

 K LRHY3DT3

 K LRCCOMX

 K LRFINX

VET1 ; Code below executes to handle Patient episode.

 ; Then, Howdy waits here for next Patient

 I '$G(LRDEV) D PICK Q:LREND

 K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD

 K ^TMP("LRHYDY",$J)

 D ^LRPARAM ; Set Howdy up as Lab user

 S LRHOWDY=1

 S LRHYCT=$G(LRHYCT,0)

 I LRHYCT=2 W !,"Please ask the clerk for assistance." K LRHYCT QUIT

 S LRODT=DT

 W @IOF

K X

 W !!,"Please swipe your ID CARD or Type SSN: "

 ;  %ZOSF("EOFF") = U $I:NOECHO

 ;  %ZOSF("EON") = U $I:ECHO

 X ^%ZOSF("EOFF")

 R X:9999999 W !

 I X=U X ^%ZOSF("EON") D BAKUSER^LRHYU QUIT

 X ^%ZOSF("EON")

 ; Code is set to read all types of VIC card as of 9/05/2005

 ;I $E(X,1,9)["-" D

 ;.  S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)

 ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)

 ;I $L(X)>10 S X=$E(X,2,10)

 ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET

 K DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT

 ;S DFN=$O(^DPT("SSN",X,0))

 ; NEW CODE FOR VIC 4.0

 D RPCVIC^DPTLK(.DFN,X)

 I DFN<1 W !,"No record for this person." R X:15 G VET

 S LRDFN=$G(^DPT(DFN,"LR"))

 I LRDFN D PT^LRX

 I 'LRDFN W !,"No Lab Data Available... Please check with clerk at the Desk." H 5 D LOG K X G VET

 K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN)

 ; this call checks order against the 69.86

 D ORDCHK^LRHYB

 I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G VET

 I '$G(LRORD) S LREND=1 W !,$G(LRCTYPE)," No Orders found. Please check with clerk at the Desk" H 5 D LOG K X G VET

 D NOW^%DTC

PRT1 ;

 W @IOF

 D SCRNON^LRHYUTL

 S PNMALL="Howdy "_$P(PNM,",",2)_" "_$P(PNM,",")

W !

 W IODHLT,"     ",PNMALL

W !

 W IODHLB,"     ",PNMALL

W !

 W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,40)),IOM)

 W !,$$CJ^XLFSTR("Your Host is: "_$G(^LRHY(69.86,LRHYSITE,42)),IOM)

 W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,44)),IOM)

W !

 W IODHLT,"    Orders for date: "_$$Y2K^LRX(DT)

W !

 W IODHLB,"    Orders for date: "_$$Y2K^LRX(DT)

W !

 S LRXYZ=0

 F  S LRXYZ=$O(^LRHY(69.86,LRHYSITE,32,LRXYZ)) Q:+LRXYZ'>0  D

 .  W !

 .  W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM)

 .  W !

 W *7 H 1 W *7 H 1 W *7

 I $D(^LRHY(69.86,LRHYSITE,54,"B")) D LRHYBING

H 5

QUITH ;

 D SCRNOFF^LRHYUTL ; Turn off screen variables

 K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT

 K LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI

 K LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND

 K LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU

 K LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN

 K LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ

 K LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT

 K LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99

 K LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X

 K VAIN

 G VET1

ORDCHK ; This block to be used for future version

 QUIT

LOG ; Howdy will default to the clerks judgement when multiple orders found.

 Q:$G(LRSKIPNO)

 W !,"NO ORDERS"

 K LRDPF,PNM

 D PT^LRX

 D NOW^%DTC

 I '$G(LRDFN) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(DFN) QUIT

 S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)

 QUIT

LOG1 ; Howdy will default to the clerks judgement when multiple orders found.

 K LRORD,LRDPT,PNM

 W !,"MULTIPLE ORDERS"

 K LRDPF,PNM

 D PT^LRX

 D NOW^%DTC

 S ^TMP("LRHYDY",$J,"LR MULTIPLE ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)

 S LRSKIPNO=1

 QUIT

ORDERS ;

 QUIT

BINGO ;

 S LRBINGO=0

 K DIC S DIC(0)="EMQZ" K Y S LRHYCT3=1

 F  S LRBINGO=$O(^LRHY(69.86,LRHYSITE,54,"B",LRBINGO)) Q:+LRBINGO'>0  D

 .  W !!,LRHYCT3,". ",$P(^%ZIS(1,LRBINGO,0),U) W !

 .  S LRX(LRHYCT3)=LRBINGO S LRHYCT3=LRHYCT3+1

 N LRHYX W !,"Choose PPOC Bingo Board: " R LRHYX:DTIME W !

 I LRHYX[U W !,"NOTHING SELECTED " QUIT

 I LRHYX="" W !,"NOTHING SELECTED " QUIT

 I '+LRHYX W !,"CHOOSE A NUMBER " H 2 G BINGO

 Q:LRHYX[U

 I $G(LRHYX)["?" W !,"Choose  NUMBER " H 2 G BINGO

 I $D(LRX) S LRBINGO=LRX(LRHYX)

 Q:$G(LRBINGO)=""

 W !!

 W $P(^%ZIS(1,LRBINGO,0),U)

W !

 S LRBINGO=$P(^%ZIS(1,LRBINGO,0),U)

 QUIT

LRHYBING ;

 ; Display Patient on Bingo board.

 W !,"SENDING TO BINGO BOARD ",LRBINGO H 2

 S ZTSAVE("PNM")=""

 S ZTRTN="PRIBB^LRHY01"

 S ZTDTH=$H

 S ZTDESC="PPOC BINGO PRINT"

 S ZTIO=$G(LRBINGO)

 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD

 QUIT

PRIBB ;

 W !,$G(PNM)

 QUIT

LRHY01    ;VA/DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:02am

 +1       ;;5.2;LAB SERVICE;**405,435**;NOV 01, 1997;Build 31

 +2       ;

PICK      ;

 +1       ;  pick the site from Howdy Site FILE 69.86

 +2        SET LREND=0

 +3        SET DIC(0)="AEMQZ"

 +4        SET DIC=69.86

 +5        DO ^DIC

 +6        IF Y=-1

               SET LREND=1

               QUIT

 +7        SET LRHYSITE=+Y

 +8        KILL DIC

 +9       ;

 +10       NEW LRHY

           SET LRHY="NUL"

           SET LRHY=$ORDER(^%ZIS(1,"B",LRHY))

 +11       SET LRDEV=$ORDER(^%ZIS(1,"B",LRHY,0))

 +12       DO BINGO

 +13       GOTO ALT

 +14      ;

 +15      ; Pick a printer

 +16       SET LRDEV=0

 +17       KILL DIC

 +18       SET DIC(0)="EMQZ"

           KILL Y

           SET LRHYCT2=1

 +19       FOR

               SET LRDEV=$ORDER(^LRHY(69.86,LRHYSITE,10,"B",LRDEV))

               IF +LRDEV'>0

                   QUIT

               Begin DoDot:1

 +20               WRITE !,LRHYCT2,". ",$PIECE(^%ZIS(1,LRDEV,0),U)

 +21               SET LRX(LRHYCT2)=LRDEV

                   SET LRHYCT2=LRHYCT2+1

               End DoDot:1

CHOOO      WRITE !,"Choose a label printer: "

           READ X:DTIME

           WRITE !

 +1        IF X=""

               WRITE !,"NOTHING SELECTED"

               SET LREND=1

               QUIT

 +2        IF U[X

               SET LREND=1

               QUIT

 +3        IF 'X

               IF $GET(X)'=""

                   WRITE !,"enter the number please"

                   GOTO CHOOO

 +4        SET LRDEV=LRX(X)

 +5       ;

ALT       ;

 +1        WRITE ?11,$PIECE(^%ZIS(1,LRDEV,0),U)

           HANG 2

 +2        KILL DIC

 +3        KILL LRHYCT2

 +4       ;

 +5        QUIT

 +6       ;

VET       ; Primary API for Howdy!  Called by [LRHY PATIENT CARD SCAN] option.

 +1        DO XTMP^LRHYU

 +2        NEW LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD

 +3        NEW LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI

 +4        NEW LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND

 +5        NEW LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU

 +6        NEW LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN

 +7        NEW LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ

 +8        NEW LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT

 +9        NEW LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99

 +10       NEW LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X

 +11       KILL LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3

 +12       KILL LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT

 +13       KILL LRHY3DT3

 +14       KILL LRHY3DT3

 +15       KILL LRCCOMX

 +16       KILL LRFINX

 +17      ;

VET1      ; Code below executes to handle Patient episode.

 +1       ; Then, Howdy waits here for next Patient

 +2        IF '$GET(LRDEV)

               DO PICK

               IF LREND

                   QUIT

 +3        KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD

 +4        KILL ^TMP("LRHYDY",$JOB)

 +5       ; Set Howdy up as Lab user

           DO ^LRPARAM

 +6        SET LRHOWDY=1

 +7        SET LRHYCT=$GET(LRHYCT,0)

 +8        IF LRHYCT=2

               WRITE !,"Please ask the clerk for assistance."

               KILL LRHYCT

               QUIT

 +9        SET LRODT=DT

 +10       WRITE @IOF

 +11       KILL X

 +12      ;

 +13       WRITE !!,"Please swipe your ID CARD or Type SSN: "

 +14      ;  %ZOSF("EOFF") = U $I:NOECHO

 +15      ;  %ZOSF("EON") = U $I:ECHO

 +16       XECUTE ^%ZOSF("EOFF")

 +17       READ X:9999999

           WRITE !

 +18       IF X=U

               XECUTE ^%ZOSF("EON")

               DO BAKUSER^LRHYU

               QUIT

 +19       XECUTE ^%ZOSF("EON")

 +20      ; Code is set to read all types of VIC card as of 9/05/2005

 +21      ;I $E(X,1,9)["-" D

 +22      ;.  S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)

 +23      ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)

 +24      ;I $L(X)>10 S X=$E(X,2,10)

 +25      ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET

 +26       KILL DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT

 +27      ;

 +28      ;S DFN=$O(^DPT("SSN",X,0))

 +29      ;

 +30      ; NEW CODE FOR VIC 4.0

 +31       DO RPCVIC^DPTLK(.DFN,X)

 +32      ;

 +33       IF DFN<1

               WRITE !,"No record for this person."

               READ X:15

               GOTO VET

 +34       SET LRDFN=$GET(^DPT(DFN,"LR"))

 +35      ;

 +36       IF LRDFN

               DO PT^LRX

 +37       IF 'LRDFN

               WRITE !,"No Lab Data Available... Please check with clerk at the Desk."

               HANG 5

               DO LOG

               KILL X

               GOTO VET

 +38       KILL ^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN)

 +39      ;

 +40      ; this call checks order against the 69.86

 +41       DO ORDCHK^LRHYB

 +42      ;

 +43      ;

 +44      ;

 +45       IF $GET(LRMULT)

               WRITE !!!,"Please check with clerk at the Desk"

               HANG 5

               DO LOG

               KILL X

               GOTO VET

 +46       IF '$GET(LRORD)

               SET LREND=1

               WRITE !,$GET(LRCTYPE)," No Orders found. Please check with clerk at the Desk"

               HANG 5

               DO LOG

               KILL X

               GOTO VET

 +47       DO NOW^%DTC

 +48      ;

 +49      ;

 +50      ;

PRT1      ;

 +1       ;

 +2        WRITE @IOF

 +3        DO SCRNON^LRHYUTL

 +4        SET PNMALL="Howdy "_$PIECE(PNM,",",2)_" "_$PIECE(PNM,",")

 +5        WRITE !

 +6        WRITE IODHLT,"     ",PNMALL

 +7        WRITE !

 +8        WRITE IODHLB,"     ",PNMALL

 +9        WRITE !

 +10       WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,40)),IOM)

 +11       WRITE !,$$CJ^XLFSTR("Your Host is: "_$GET(^LRHY(69.86,LRHYSITE,42)),IOM)

 +12       WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,44)),IOM)

 +13       WRITE !

 +14       WRITE IODHLT,"    Orders for date: "_$$Y2K^LRX(DT)

 +15       WRITE !

 +16       WRITE IODHLB,"    Orders for date: "_$$Y2K^LRX(DT)

 +17       WRITE !

 +18       SET LRXYZ=0

 +19       FOR

               SET LRXYZ=$ORDER(^LRHY(69.86,LRHYSITE,32,LRXYZ))

               IF +LRXYZ'>0

                   QUIT

               Begin DoDot:1

 +20               WRITE !

 +21               WRITE !,$$CJ^XLFSTR($GET(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM)

 +22               WRITE !

               End DoDot:1

 +23       WRITE *7

           HANG 1

           WRITE *7

           HANG 1

           WRITE *7

 +24      ;

 +25       IF $DATA(^LRHY(69.86,LRHYSITE,54,"B"))

               DO LRHYBING

 +26       HANG 5

QUITH     ;

 +1       ; Turn off screen variables

           DO SCRNOFF^LRHYUTL

 +2        KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT

 +3        KILL LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI

 +4        KILL LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND

 +5        KILL LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU

 +6        KILL LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN

 +7        KILL LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ

 +8        KILL LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT

 +9        KILL LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99

 +10       KILL LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X

 +11       KILL VAIN

 +12      ;

 +13      ;

 +14       GOTO VET1

 +15      ;

 +16      ;

 +17      ;

ORDCHK    ; This block to be used for future version

 +1        QUIT

LOG       ; Howdy will default to the clerks judgement when multiple orders found.

 +1        IF $GET(LRSKIPNO)

               QUIT

 +2       ;

 +3        WRITE !,"NO ORDERS"

 +4       ;

 +5        KILL LRDPF,PNM

 +6        DO PT^LRX

 +7        DO NOW^%DTC

 +8        IF '$GET(LRDFN)

               SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(DFN)

               QUIT

 +9        SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(PNM)_U_$GET(^LR(LRDFN,.1))_U_$GET(SSN)

 +10       QUIT

 +11      ;

 +12      ;

LOG1      ; Howdy will default to the clerks judgement when multiple orders found.

 +1        KILL LRORD,LRDPT,PNM

 +2        WRITE !,"MULTIPLE ORDERS"

 +3        KILL LRDPF,PNM

 +4        DO PT^LRX

 +5        DO NOW^%DTC

 +6        SET ^TMP("LRHYDY",$JOB,"LR MULTIPLE ORDERS",%)=$GET(PNM)_U_$GET(^LR(LRDFN,.1))_U_$GET(SSN)

 +7        SET LRSKIPNO=1

 +8        QUIT

ORDERS    ;

 +1        QUIT

 +2       ;

BINGO     ;

 +1        SET LRBINGO=0

 +2        KILL DIC

           SET DIC(0)="EMQZ"

           KILL Y

           SET LRHYCT3=1

 +3        FOR

               SET LRBINGO=$ORDER(^LRHY(69.86,LRHYSITE,54,"B",LRBINGO))

               IF +LRBINGO'>0

                   QUIT

               Begin DoDot:1

 +4                WRITE !!,LRHYCT3,". ",$PIECE(^%ZIS(1,LRBINGO,0),U)

                   WRITE !

 +5                SET LRX(LRHYCT3)=LRBINGO

                   SET LRHYCT3=LRHYCT3+1

               End DoDot:1

 +6        NEW LRHYX

           WRITE !,"Choose PPOC Bingo Board: "

           READ LRHYX:DTIME

           WRITE !

 +7        IF LRHYX[U

               WRITE !,"NOTHING SELECTED "

               QUIT

 +8        IF LRHYX=""

               WRITE !,"NOTHING SELECTED "

               QUIT

 +9        IF '+LRHYX

               WRITE !,"CHOOSE A NUMBER "

               HANG 2

               GOTO BINGO

 +10       IF LRHYX[U

               QUIT

 +11       IF $GET(LRHYX)["?"

               WRITE !,"Choose  NUMBER "

               HANG 2

               GOTO BINGO

 +12       IF $DATA(LRX)

               SET LRBINGO=LRX(LRHYX)

 +13       IF $GET(LRBINGO)=""

               QUIT

 +14       WRITE !!

 +15       WRITE $PIECE(^%ZIS(1,LRBINGO,0),U)

 +16       WRITE !

 +17       SET LRBINGO=$PIECE(^%ZIS(1,LRBINGO,0),U)

 +18       QUIT

LRHYBING  ;

 +1       ; Display Patient on Bingo board.

 +2        WRITE !,"SENDING TO BINGO BOARD ",LRBINGO

           HANG 2

 +3        SET ZTSAVE("PNM")=""

 +4        SET ZTRTN="PRIBB^LRHY01"

 +5        SET ZTDTH=$HOROLOG

 +6        SET ZTDESC="PPOC BINGO PRINT"

 +7        SET ZTIO=$GET(LRBINGO)

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           DO ^%ZTLOAD

 +9       ;

 +10       QUIT

PRIBB     ;

 +1        WRITE !,$GET(PNM)

 +2        QUIT

LRHY01.m