Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRHY0

LRHY0.m

Go to the documentation of this file.
  1. LRHY0 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am
  1. ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6
  1. ;
  1. PICK ;
  1. ; pick the site from Howdy Site FILE 69.86
  1. S LREND=0
  1. S DIC(0)="AEMQZ"
  1. S DIC=69.86
  1. D ^DIC
  1. I Y=-1 S LREND=1 QUIT
  1. S LRHYSITE=+Y
  1. K DIC
  1. ;
  1. I $G(^LRHY(69.86,LRHYSITE,0))["ALTER" S LRDEV=$O(^%ZIS(1,"B","NULL DEVICE",0)) G ALT
  1. ;
  1. ; Pick a printer
  1. S LRDEV=0
  1. K DIC
  1. S DIC(0)="EMQZ" K Y S LRHYCT2=1
  1. F S LRDEV=$O(^LRHY(69.86,LRHYSITE,10,"B",LRDEV)) Q:+LRDEV'>0 D
  1. . W !,LRHYCT2,". ",$P(^%ZIS(1,LRDEV,0),U)
  1. . S LRX(LRHYCT2)=LRDEV S LRHYCT2=LRHYCT2+1
  1. CHOOO W !,"Choose a label printer: " R X:DTIME W !
  1. I U[X S LREND=1 QUIT
  1. I X="" W !,"NOTHING SELECTED" S LREND=1 H 1 QUIT
  1. I '$D(LRX(X)) W !,"NUMBER NOT IN RANGE" H 1 G CHOOO
  1. I U[X S LREND=1 QUIT
  1. I 'X I $G(X)'="" W !,"enter the number please" G CHOOO
  1. S LRDEV=LRX(X)
  1. ;
  1. ;
  1. ALT ;
  1. W ?11,$P(^%ZIS(1,LRDEV,0),U) H 2
  1. K DIC
  1. K LRHYCT2
  1. D USER^LRHYU
  1. ;
  1. ;
  1. QUIT
  1. ;
  1. VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option.
  1. D XTMP^LRHYU
  1. N LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
  1. N LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
  1. N LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
  1. N LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN
  1. N LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
  1. N LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
  1. N LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
  1. N LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X
  1. ;
  1. VET1 ; Code below executes to handle Patient episode.
  1. ; Then, Howdy waits here for next Patient
  1. ;
  1. K LRCCOMX,LRDUX,LREDT,LRDX,DIK
  1. K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3
  1. K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT,LREXORD
  1. K LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM
  1. K LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD
  1. K LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0
  1. K LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN
  1. K LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK
  1. K LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7
  1. K LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT
  1. K LR3NX0,LR3ODT,M9,V,LRHYORDZ
  1. K LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS
  1. K LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX
  1. K LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD
  1. K LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0
  1. K LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX
  1. K LRFINX
  1. ;
  1. I '$G(LRDEV) D PICK Q:LREND
  1. ;
  1. K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD
  1. K ^TMP("LRHYDY",$J)
  1. D ^LRPARAM ; Set Howdy up as Lab user
  1. S LRHOWDY=1
  1. S LRHYCT=$G(LRHYCT,0)
  1. I LRHYCT=2 W !,"Please ask the clerk for assistance." K LRHYCT QUIT
  1. S LRODT=DT
  1. W @IOF
  1. K X
  1. ;
  1. W !!,"Please swipe your ID CARD or Type SSN: "
  1. ; %ZOSF("EOFF") = U $I:NOECHO
  1. ; %ZOSF("EON") = U $I:ECHO
  1. X ^%ZOSF("EOFF")
  1. R X:9999999 W !
  1. I X=U X ^%ZOSF("EON") D BAKUSER^LRHYU QUIT
  1. X ^%ZOSF("EON")
  1. ; Code is set to read all types of VIC card as of 9/05/2005
  1. ;I $E(X,1,9)["-" D
  1. ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3)
  1. ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10)
  1. ;I $L(X)>10 S X=$E(X,2,10)
  1. ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET
  1. ;
  1. K DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT
  1. ;
  1. ;S DFN=$O(^DPT("SSN",X,0))
  1. ;
  1. ; NEW CODE FOR VIC 4.0
  1. D RPCVIC^DPTLK(.DFN,X)
  1. ;
  1. I DFN<1 W !,"No record for this person." R X:15 G VET1
  1. S LRDFN=$G(^DPT(DFN,"LR"))
  1. ;
  1. I LRDFN D PT^LRX
  1. I 'LRDFN W !,"No Lab Data Available... Please check with clerk at the Desk." H 5 D LOG K X G VET1
  1. K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN)
  1. ;
  1. ; this call checks order against the 69.86
  1. D ORDCHK^LRHYB
  1. ;
  1. ;
  1. ;
  1. I $G(LRLOCS) W !!!,"Please check with clerk at the Desk" H 5 K X G QUITH
  1. I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G QUITH
  1. 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
  1. D NOW^%DTC
  1. ;
  1. ;
  1. ;
  1. PRT1 ;
  1. ;
  1. W @IOF
  1. D SCRNON^LRHYUTL
  1. S PNMALL="Howdy "_$P(PNM,",",2)_" "_$P(PNM,",")
  1. W !
  1. W IODHLT," ",PNMALL
  1. W !
  1. W IODHLB," ",PNMALL
  1. W !
  1. W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,40)),IOM)
  1. W !,$$CJ^XLFSTR("Your Host is: "_$G(^LRHY(69.86,LRHYSITE,42)),IOM)
  1. W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,44)),IOM)
  1. W !
  1. W IODHLT," Orders for date: "_$$Y2K^LRX(DT)
  1. W !
  1. W IODHLB," Orders for date: "_$$Y2K^LRX(DT)
  1. W !
  1. S LRXYZ=0
  1. F S LRXYZ=$O(^LRHY(69.86,LRHYSITE,32,LRXYZ)) Q:+LRXYZ'>0 D
  1. . W !
  1. . W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM)
  1. . W !
  1. W *7 H 1 W *7 H 1 W *7
  1. ;
  1. I $D(^LRHY(69.86,7,54,"B")) D BINBRD^LRHYBC1
  1. H 5
  1. QUITH ;
  1. D SCRNOFF^LRHYUTL ; Turn off screen variables
  1. K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT
  1. K LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI
  1. K LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND
  1. K LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU
  1. K LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN,LREXORD
  1. K LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ
  1. K LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT
  1. K LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99
  1. K LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X,LRLOCS
  1. K VAIN
  1. ;
  1. ;
  1. G VET1
  1. ;
  1. ;
  1. ;
  1. ORDCHK ; This block to be used for future version
  1. QUIT
  1. LOG ; Howdy will default to the clerks judgement when multiple orders found.
  1. I $G(LRMULT) QUIT
  1. Q:$G(LRSKIPNO)
  1. ;
  1. W !,"NO ORDERS"
  1. ;
  1. K LRDPF,PNM
  1. D PT^LRX
  1. D NOW^%DTC
  1. I '$G(LRDFN) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(DFN) QUIT
  1. S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)
  1. QUIT
  1. ;
  1. ;
  1. LOG1 ; Howdy will default to the clerks judgement when multiple orders found.
  1. K LRORD,LRDPT,PNM
  1. W !,"MULTIPLE ORDERS"
  1. K LRDPF,PNM
  1. D PT^LRX
  1. D NOW^%DTC
  1. S ^TMP("LRHYDY",$J,"LR MULTIPLE ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN)
  1. S LRSKIPNO=1
  1. QUIT
  1. ORDERS ;
  1. QUIT