LRHY0 ;VA/DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am
;;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
;
I $G(^LRHY(69.86,LRHYSITE,0))["ALTER" S LRDEV=$O(^%ZIS(1,"B","NULL DEVICE",0)) 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 U[X S LREND=1 QUIT
I X="" W !,"NOTHING SELECTED" S LREND=1 H 1 QUIT
I '$D(LRX(X)) W !,"NUMBER NOT IN RANGE" H 1 G CHOOO
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
D USER^LRHYU
;
;
QUIT
;
VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option.
D XTMP^LRHYU
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 LRCCOMX,LRDUX,LREDT,LRDX,DIB,DIK
K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT
K LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM
K LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD
K LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0
K LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN
K LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK
K LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7
K LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT
K LR3NX0,LR3ODT,M9,V,LRHYORDZ
K LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS
K LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX
K LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD
K LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0
K LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX
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,7,54,"B")) D BINBRD^LRHYBC1
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.
I $G(LRMULT) QUIT
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
LRHY0 ;VA/DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am
+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 IF $GET(^LRHY(69.86,LRHYSITE,0))["ALTER"
SET LRDEV=$ORDER(^%ZIS(1,"B","NULL DEVICE",0))
GOTO ALT
+11 ;
+12 ; Pick a printer
+13 SET LRDEV=0
+14 KILL DIC
+15 SET DIC(0)="EMQZ"
KILL Y
SET LRHYCT2=1
+16 FOR
SET LRDEV=$ORDER(^LRHY(69.86,LRHYSITE,10,"B",LRDEV))
IF +LRDEV'>0
QUIT
Begin DoDot:1
+17 WRITE !,LRHYCT2,". ",$PIECE(^%ZIS(1,LRDEV,0),U)
+18 SET LRX(LRHYCT2)=LRDEV
SET LRHYCT2=LRHYCT2+1
End DoDot:1
CHOOO WRITE !,"Choose a label printer: "
READ X:DTIME
WRITE !
+1 IF U[X
SET LREND=1
QUIT
+2 IF X=""
WRITE !,"NOTHING SELECTED"
SET LREND=1
HANG 1
QUIT
+3 IF '$DATA(LRX(X))
WRITE !,"NUMBER NOT IN RANGE"
HANG 1
GOTO CHOOO
+4 IF U[X
SET LREND=1
QUIT
+5 IF 'X
IF $GET(X)'=""
WRITE !,"enter the number please"
GOTO CHOOO
+6 SET LRDEV=LRX(X)
+7 ;
+8 ;
ALT ;
+1 WRITE ?11,$PIECE(^%ZIS(1,LRDEV,0),U)
HANG 2
+2 KILL DIC
+3 KILL LRHYCT2
+4 DO USER^LRHYU
+5 ;
+6 ;
+7 QUIT
+8 ;
VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option.
+1 DO XTMP^LRHYU
+2 NEW LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
+3 NEW LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
+4 NEW LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
+5 NEW LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN
+6 NEW LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
+7 NEW LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
+8 NEW LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
+9 NEW LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X
+10 KILL LRCCOMX,LRDUX,LREDT,LRDX,DIB,DIK
+11 KILL LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
+12 KILL LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT
+13 KILL LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM
+14 KILL LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD
+15 KILL LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0
+16 KILL LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN
+17 KILL LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK
+18 KILL LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7
+19 KILL LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT
+20 KILL LR3NX0,LR3ODT,M9,V,LRHYORDZ
+21 KILL LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS
+22 KILL LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX
+23 KILL LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD
+24 KILL LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0
+25 KILL LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX
+26 KILL LRFINX
+27 ;
VET1 ; Code below executes to handle Patient episode.
+1 ; Then, Howdy waits here for next Patient
+2 ;
+3 IF '$GET(LRDEV)
DO PICK
IF LREND
QUIT
+4 ;
+5 KILL LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD
+6 KILL ^TMP("LRHYDY",$JOB)
+7 ; Set Howdy up as Lab user
DO ^LRPARAM
+8 SET LRHOWDY=1
+9 SET LRHYCT=$GET(LRHYCT,0)
+10 IF LRHYCT=2
WRITE !,"Please ask the clerk for assistance."
KILL LRHYCT
QUIT
+11 SET LRODT=DT
+12 WRITE @IOF
+13 KILL X
+14 ;
+15 WRITE !!,"Please swipe your ID CARD or Type SSN: "
+16 ; %ZOSF("EOFF") = U $I:NOECHO
+17 ; %ZOSF("EON") = U $I:ECHO
+18 XECUTE ^%ZOSF("EOFF")
+19 READ X:9999999
WRITE !
+20 IF X=U
XECUTE ^%ZOSF("EON")
DO BAKUSER^LRHYU
QUIT
+21 XECUTE ^%ZOSF("EON")
+22 ; Code is set to read all types of VIC card as of 9/05/2005
+23 ;I $E(X,1,9)["-" D
+24 ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)
+25 ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)
+26 ;I $L(X)>10 S X=$E(X,2,10)
+27 ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET
+28 ;
+29 KILL DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT
+30 ;
+31 ;S DFN=$O(^DPT("SSN",X,0))
+32 ;
+33 ; NEW CODE FOR VIC 4.0
+34 DO RPCVIC^DPTLK(.DFN,X)
+35 ;
+36 IF DFN<1
WRITE !,"No record for this person."
READ X:15
GOTO VET
+37 SET LRDFN=$GET(^DPT(DFN,"LR"))
+38 ;
+39 IF LRDFN
DO PT^LRX
+40 IF 'LRDFN
WRITE !,"No Lab Data Available... Please check with clerk at the Desk."
HANG 5
DO LOG
KILL X
GOTO VET
+41 KILL ^TMP("LRHYDY",$JOB,"LRHYDY",$JOB,LRDFN)
+42 ;
+43 ; this call checks order against the 69.86
+44 DO ORDCHK^LRHYB
+45 ;
+46 ;
+47 ;
+48 IF $GET(LRMULT)
WRITE !!!,"Please check with clerk at the Desk"
HANG 5
DO LOG
KILL X
GOTO VET
+49 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
+50 DO NOW^%DTC
+51 ;
+52 ;
+53 ;
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,7,54,"B"))
DO BINBRD^LRHYBC1
+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(LRMULT)
QUIT
+2 IF $GET(LRSKIPNO)
QUIT
+3 ;
+4 WRITE !,"NO ORDERS"
+5 ;
+6 KILL LRDPF,PNM
+7 DO PT^LRX
+8 DO NOW^%DTC
+9 IF '$GET(LRDFN)
SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(DFN)
QUIT
+10 SET ^TMP("LRHYDY",$JOB,"LR NO ORDERS",%)=$GET(PNM)_U_$GET(^LR(LRDFN,.1))_U_$GET(SSN)
+11 QUIT
+12 ;
+13 ;
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
