LRHY01 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:02am
 ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6
 ;
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,LREXORD
 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
 ;
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 LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
 K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT
 K LRHY3DT3,LRCCOMX,LRFIN
 ;
 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 VET1
 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 VET1
 K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN)
 ;
 ; this call checks order against the 69.86
 D ORDCHK^LRHYB
 ;
 ;
 ;
 I $G(LRLOCS) W !!!,"Please check with clerk at the Desk" H 5 K X G QUITH
 I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G QUITH
 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 QUITH
 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,LREXORD
 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,LRLOCS
 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
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHY01   6256     printed  Sep 23, 2025@19:50:47                                                                                                                                                                                                      Page 2
LRHY01    ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:02am
 +1       ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6
 +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,LREXORD
 +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      ;
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       ;
 +4        KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD
 +5        KILL LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
 +6        KILL LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT
 +7        KILL LRHY3DT3,LRCCOMX,LRFIN
 +8       ;
 +9        KILL ^TMP("LRHYDY",$JOB)
 +10      ; Set Howdy up as Lab user
           DO ^LRPARAM
 +11       SET LRHOWDY=1
 +12       SET LRHYCT=$GET(LRHYCT,0)
 +13       IF LRHYCT=2
               WRITE !,"Please ask the clerk for assistance."
               KILL LRHYCT
               QUIT 
 +14       SET LRODT=DT
 +15       WRITE @IOF
 +16       KILL X
 +17      ; 
 +18       WRITE !!,"Please swipe your ID CARD or Type SSN: "
 +19      ;  %ZOSF("EOFF") = U $I:NOECHO
 +20      ;  %ZOSF("EON") = U $I:ECHO
 +21       XECUTE ^%ZOSF("EOFF")
 +22       READ X:9999999
           WRITE !
 +23       IF X=U
               XECUTE ^%ZOSF("EON")
               DO BAKUSER^LRHYU
               QUIT 
 +24       XECUTE ^%ZOSF("EON")
 +25      ; Code is set to read all types of VIC card as of 9/05/2005
 +26      ;I $E(X,1,9)["-" D
 +27      ;.  S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)
 +28      ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)
 +29      ;I $L(X)>10 S X=$E(X,2,10)
 +30      ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET
 +31       KILL DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT
 +32      ; 
 +33      ;S DFN=$O(^DPT("SSN",X,0))
 +34      ;
 +35      ; NEW CODE FOR VIC 4.0
 +36       DO RPCVIC^DPTLK(.DFN,X)
 +37      ;
 +38       IF DFN<1
               WRITE !,"No record for this person."
               READ X:15
               GOTO VET1
 +39       SET LRDFN=$GET(^DPT(DFN,"LR"))
 +40      ;
 +41       IF LRDFN
               DO PT^LRX
 +42       IF 'LRDFN
               WRITE !,"No Lab Data Available... Please check with clerk at the Desk."
               HANG 5
               DO LOG
               KILL X
               GOTO VET1
 +43       KILL ^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN)
 +44      ;
 +45      ; this call checks order against the 69.86
 +46       DO ORDCHK^LRHYB
 +47      ;
 +48      ;
 +49      ;
 +50       IF $GET(LRLOCS)
               WRITE !!!,"Please check with clerk at the Desk"
               HANG 5
               KILL X
               GOTO QUITH
 +51       IF $GET(LRMULT)
               WRITE !!!,"Please check with clerk at the Desk"
               HANG 5
               DO LOG
               KILL X
               GOTO QUITH
 +52       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 QUITH
 +53       DO NOW^%DTC
 +54      ;
 +55      ;
 +56      ;
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,LREXORD
 +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,LRLOCS
 +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