Released LR*5.2*457 SEQ #367 Extracted from mail message **KIDS**:LR*5.2*457^ **INSTALL NAME** LR*5.2*457 "BLD",9942,0) LR*5.2*457^LAB SERVICE^0^3160105^y "BLD",9942,1,0) ^^5^5^3150803^^^^ "BLD",9942,1,1,0) This is a general maintenance patch for the laboratory "BLD",9942,1,2,0) package by the Vista Maintenance team that addresses "BLD",9942,1,3,0) issues with the Howdy software relating to exclusionary "BLD",9942,1,4,0) functionality for clinics, deleting of same day duplicate "BLD",9942,1,5,0) tests and some other minor Howdy issues. "BLD",9942,4,0) ^9.64PA^^ "BLD",9942,6) 3^ "BLD",9942,6.3) 6 "BLD",9942,"ABPKG") n "BLD",9942,"KRN",0) ^9.67PA^779.2^20 "BLD",9942,"KRN",.4,0) .4 "BLD",9942,"KRN",.401,0) .401 "BLD",9942,"KRN",.402,0) .402 "BLD",9942,"KRN",.403,0) .403 "BLD",9942,"KRN",.5,0) .5 "BLD",9942,"KRN",.84,0) .84 "BLD",9942,"KRN",3.6,0) 3.6 "BLD",9942,"KRN",3.8,0) 3.8 "BLD",9942,"KRN",9.2,0) 9.2 "BLD",9942,"KRN",9.8,0) 9.8 "BLD",9942,"KRN",9.8,"NM",0) ^9.68A^7^5 "BLD",9942,"KRN",9.8,"NM",1,0) LRHY0^^0^B40046237 "BLD",9942,"KRN",9.8,"NM",2,0) LRHY01^^0^B42472273 "BLD",9942,"KRN",9.8,"NM",3,0) LRHYA^^0^B39254631 "BLD",9942,"KRN",9.8,"NM",4,0) LRHYB^^0^B43402214 "BLD",9942,"KRN",9.8,"NM",7,0) LRHYPH0^^0^B40393749 "BLD",9942,"KRN",9.8,"NM","B","LRHY0",1) "BLD",9942,"KRN",9.8,"NM","B","LRHY01",2) "BLD",9942,"KRN",9.8,"NM","B","LRHYA",3) "BLD",9942,"KRN",9.8,"NM","B","LRHYB",4) "BLD",9942,"KRN",9.8,"NM","B","LRHYPH0",7) "BLD",9942,"KRN",19,0) 19 "BLD",9942,"KRN",19,"NM",0) ^9.68A^^ "BLD",9942,"KRN",19.1,0) 19.1 "BLD",9942,"KRN",101,0) 101 "BLD",9942,"KRN",409.61,0) 409.61 "BLD",9942,"KRN",771,0) 771 "BLD",9942,"KRN",779.2,0) 779.2 "BLD",9942,"KRN",870,0) 870 "BLD",9942,"KRN",8989.51,0) 8989.51 "BLD",9942,"KRN",8989.52,0) 8989.52 "BLD",9942,"KRN",8994,0) 8994 "BLD",9942,"KRN","B",.4,.4) "BLD",9942,"KRN","B",.401,.401) "BLD",9942,"KRN","B",.402,.402) "BLD",9942,"KRN","B",.403,.403) "BLD",9942,"KRN","B",.5,.5) "BLD",9942,"KRN","B",.84,.84) "BLD",9942,"KRN","B",3.6,3.6) "BLD",9942,"KRN","B",3.8,3.8) "BLD",9942,"KRN","B",9.2,9.2) "BLD",9942,"KRN","B",9.8,9.8) "BLD",9942,"KRN","B",19,19) "BLD",9942,"KRN","B",19.1,19.1) "BLD",9942,"KRN","B",101,101) "BLD",9942,"KRN","B",409.61,409.61) "BLD",9942,"KRN","B",771,771) "BLD",9942,"KRN","B",779.2,779.2) "BLD",9942,"KRN","B",870,870) "BLD",9942,"KRN","B",8989.51,8989.51) "BLD",9942,"KRN","B",8989.52,8989.52) "BLD",9942,"KRN","B",8994,8994) "BLD",9942,"QUES",0) ^9.62^^ "BLD",9942,"REQB",0) ^9.611^2^2 "BLD",9942,"REQB",1,0) LR*5.2*405^2 "BLD",9942,"REQB",2,0) LR*5.2*446^2 "BLD",9942,"REQB","B","LR*5.2*405",1) "BLD",9942,"REQB","B","LR*5.2*446",2) "MBREQ") 0 "PKG",26,-1) 1^1 "PKG",26,0) LAB SERVICE^LR^CORE LAB SYSTEM "PKG",26,20,0) ^9.402P^1^1 "PKG",26,20,1,0) 2^^LRXDRPT "PKG",26,20,1,1) "PKG",26,20,"B",2,1) "PKG",26,22,0) ^9.49I^1^1 "PKG",26,22,1,0) 5.2^2940927^2950304 "PKG",26,22,1,"PAH",1,0) 457^3160105^15000140 "PKG",26,22,1,"PAH",1,1,0) ^^5^5^3160105 "PKG",26,22,1,"PAH",1,1,1,0) This is a general maintenance patch for the laboratory "PKG",26,22,1,"PAH",1,1,2,0) package by the Vista Maintenance team that addresses "PKG",26,22,1,"PAH",1,1,3,0) issues with the Howdy software relating to exclusionary "PKG",26,22,1,"PAH",1,1,4,0) functionality for clinics, deleting of same day duplicate "PKG",26,22,1,"PAH",1,1,5,0) tests and some other minor Howdy issues. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 5 "RTN","LRHY0") 0^1^B40046237^B38508481 "RTN","LRHY0",1,0) LRHY0 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:00am "RTN","LRHY0",2,0) ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6 "RTN","LRHY0",3,0) ; "RTN","LRHY0",4,0) PICK ; "RTN","LRHY0",5,0) ; pick the site from Howdy Site FILE 69.86 "RTN","LRHY0",6,0) S LREND=0 "RTN","LRHY0",7,0) S DIC(0)="AEMQZ" "RTN","LRHY0",8,0) S DIC=69.86 "RTN","LRHY0",9,0) D ^DIC "RTN","LRHY0",10,0) I Y=-1 S LREND=1 QUIT "RTN","LRHY0",11,0) S LRHYSITE=+Y "RTN","LRHY0",12,0) K DIC "RTN","LRHY0",13,0) ; "RTN","LRHY0",14,0) I $G(^LRHY(69.86,LRHYSITE,0))["ALTER" S LRDEV=$O(^%ZIS(1,"B","NULL DEVICE",0)) G ALT "RTN","LRHY0",15,0) ; "RTN","LRHY0",16,0) ; Pick a printer "RTN","LRHY0",17,0) S LRDEV=0 "RTN","LRHY0",18,0) K DIC "RTN","LRHY0",19,0) S DIC(0)="EMQZ" K Y S LRHYCT2=1 "RTN","LRHY0",20,0) F S LRDEV=$O(^LRHY(69.86,LRHYSITE,10,"B",LRDEV)) Q:+LRDEV'>0 D "RTN","LRHY0",21,0) . W !,LRHYCT2,". ",$P(^%ZIS(1,LRDEV,0),U) "RTN","LRHY0",22,0) . S LRX(LRHYCT2)=LRDEV S LRHYCT2=LRHYCT2+1 "RTN","LRHY0",23,0) CHOOO W !,"Choose a label printer: " R X:DTIME W ! "RTN","LRHY0",24,0) I U[X S LREND=1 QUIT "RTN","LRHY0",25,0) I X="" W !,"NOTHING SELECTED" S LREND=1 H 1 QUIT "RTN","LRHY0",26,0) I '$D(LRX(X)) W !,"NUMBER NOT IN RANGE" H 1 G CHOOO "RTN","LRHY0",27,0) I U[X S LREND=1 QUIT "RTN","LRHY0",28,0) I 'X I $G(X)'="" W !,"enter the number please" G CHOOO "RTN","LRHY0",29,0) S LRDEV=LRX(X) "RTN","LRHY0",30,0) ; "RTN","LRHY0",31,0) ; "RTN","LRHY0",32,0) ALT ; "RTN","LRHY0",33,0) W ?11,$P(^%ZIS(1,LRDEV,0),U) H 2 "RTN","LRHY0",34,0) K DIC "RTN","LRHY0",35,0) K LRHYCT2 "RTN","LRHY0",36,0) D USER^LRHYU "RTN","LRHY0",37,0) ; "RTN","LRHY0",38,0) ; "RTN","LRHY0",39,0) QUIT "RTN","LRHY0",40,0) ; "RTN","LRHY0",41,0) VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option. "RTN","LRHY0",42,0) D XTMP^LRHYU "RTN","LRHY0",43,0) N LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI "RTN","LRHY0",44,0) N LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND "RTN","LRHY0",45,0) N LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU "RTN","LRHY0",46,0) N LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN "RTN","LRHY0",47,0) N LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ "RTN","LRHY0",48,0) N LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT "RTN","LRHY0",49,0) N LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99 "RTN","LRHY0",50,0) N LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X "RTN","LRHY0",51,0) ; "RTN","LRHY0",52,0) VET1 ; Code below executes to handle Patient episode. "RTN","LRHY0",53,0) ; Then, Howdy waits here for next Patient "RTN","LRHY0",54,0) ; "RTN","LRHY0",55,0) K LRCCOMX,LRDUX,LREDT,LRDX,DIK "RTN","LRHY0",56,0) K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3 "RTN","LRHY0",57,0) K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT,LREXORD "RTN","LRHY0",58,0) K LRMERG,LRODRNUM,LRORDNUM,LRUNC,LRPARAM "RTN","LRHY0",59,0) K LRHYCT3,LRHYCTC,IOTLC,LRC,LRHYCT3,LRHYCTC,LRHYTOK,LRKIL,LRLABNOD "RTN","LRHY0",60,0) K LRLABSTP,LRLINE,LRLWC,LRN5,LRNONONO,LRNOT,LRNOTEST,LRNOUP,LRNT,LRNX0 "RTN","LRHY0",61,0) K LRODRUM,LRONE,LRORDSIZ,LRORDT,LRORDT1,LRM1,LRM2,LRM3,LRPHONE,LRORIEN "RTN","LRHY0",62,0) K LRS,LRSC0,LRSDT,LRSN1,LRSPIEN,LRSSN,LRSTAR,LRSTOP,LRSTUCK "RTN","LRHY0",63,0) K LRT0,LRTECH,LRTKX,LRTM7,LRTOTAL,LRTST,LRTUBE,LRTXT,LRUDT,LRUNK,LRURG7 "RTN","LRHY0",64,0) K LRURGA,LRURGNCY,LRURGT,LRURGZ19,LRX1,LRX2,LRX3,LRY1,LRYTAT,LR3,LR3MULT "RTN","LRHY0",65,0) K LR3NX0,LR3ODT,M9,V,LRHYORDZ "RTN","LRHY0",66,0) K LABCNT,LN,LR0NODE,LR68,LR6987,LR700,LR7LESS "RTN","LRHY0",67,0) K LR7MORE,LRAANAME,LRAAZ,LRAC1,LRACCER,LRACCTM,LRACCXX "RTN","LRHY0",68,0) K LRACNODE,LRACO,LRACTM,LRADD,LRBAR0,LRBAR1,LRBBRD "RTN","LRHY0",69,0) K LRBINGO,LRCEN,LRCNTX,LRCTYPE,LRD,LRDA,LRDRAW0 "RTN","LRHY0",70,0) K LRDRAW1,LRDRAW7,LRDT,LRDTX,LRDUP,LRDUX,LREDT,LRDX "RTN","LRHY0",71,0) K LRFINX "RTN","LRHY0",72,0) ; "RTN","LRHY0",73,0) I '$G(LRDEV) D PICK Q:LREND "RTN","LRHY0",74,0) ; "RTN","LRHY0",75,0) K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD "RTN","LRHY0",76,0) K ^TMP("LRHYDY",$J) "RTN","LRHY0",77,0) D ^LRPARAM ; Set Howdy up as Lab user "RTN","LRHY0",78,0) S LRHOWDY=1 "RTN","LRHY0",79,0) S LRHYCT=$G(LRHYCT,0) "RTN","LRHY0",80,0) I LRHYCT=2 W !,"Please ask the clerk for assistance." K LRHYCT QUIT "RTN","LRHY0",81,0) S LRODT=DT "RTN","LRHY0",82,0) W @IOF "RTN","LRHY0",83,0) K X "RTN","LRHY0",84,0) ; "RTN","LRHY0",85,0) W !!,"Please swipe your ID CARD or Type SSN: " "RTN","LRHY0",86,0) ; %ZOSF("EOFF") = U $I:NOECHO "RTN","LRHY0",87,0) ; %ZOSF("EON") = U $I:ECHO "RTN","LRHY0",88,0) X ^%ZOSF("EOFF") "RTN","LRHY0",89,0) R X:9999999 W ! "RTN","LRHY0",90,0) I X=U X ^%ZOSF("EON") D BAKUSER^LRHYU QUIT "RTN","LRHY0",91,0) X ^%ZOSF("EON") "RTN","LRHY0",92,0) ; Code is set to read all types of VIC card as of 9/05/2005 "RTN","LRHY0",93,0) ;I $E(X,1,9)["-" D "RTN","LRHY0",94,0) ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3) "RTN","LRHY0",95,0) ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10) "RTN","LRHY0",96,0) ;I $L(X)>10 S X=$E(X,2,10) "RTN","LRHY0",97,0) ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET "RTN","LRHY0",98,0) ; "RTN","LRHY0",99,0) K DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT "RTN","LRHY0",100,0) ; "RTN","LRHY0",101,0) ;S DFN=$O(^DPT("SSN",X,0)) "RTN","LRHY0",102,0) ; "RTN","LRHY0",103,0) ; NEW CODE FOR VIC 4.0 "RTN","LRHY0",104,0) D RPCVIC^DPTLK(.DFN,X) "RTN","LRHY0",105,0) ; "RTN","LRHY0",106,0) I DFN<1 W !,"No record for this person." R X:15 G VET1 "RTN","LRHY0",107,0) S LRDFN=$G(^DPT(DFN,"LR")) "RTN","LRHY0",108,0) ; "RTN","LRHY0",109,0) I LRDFN D PT^LRX "RTN","LRHY0",110,0) I 'LRDFN W !,"No Lab Data Available... Please check with clerk at the Desk." H 5 D LOG K X G VET1 "RTN","LRHY0",111,0) K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN) "RTN","LRHY0",112,0) ; "RTN","LRHY0",113,0) ; this call checks order against the 69.86 "RTN","LRHY0",114,0) D ORDCHK^LRHYB "RTN","LRHY0",115,0) ; "RTN","LRHY0",116,0) ; "RTN","LRHY0",117,0) ; "RTN","LRHY0",118,0) I $G(LRLOCS) W !!!,"Please check with clerk at the Desk" H 5 K X G QUITH "RTN","LRHY0",119,0) I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G QUITH "RTN","LRHY0",120,0) 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 "RTN","LRHY0",121,0) D NOW^%DTC "RTN","LRHY0",122,0) ; "RTN","LRHY0",123,0) ; "RTN","LRHY0",124,0) ; "RTN","LRHY0",125,0) PRT1 ; "RTN","LRHY0",126,0) ; "RTN","LRHY0",127,0) W @IOF "RTN","LRHY0",128,0) D SCRNON^LRHYUTL "RTN","LRHY0",129,0) S PNMALL="Howdy "_$P(PNM,",",2)_" "_$P(PNM,",") "RTN","LRHY0",130,0) W ! "RTN","LRHY0",131,0) W IODHLT," ",PNMALL "RTN","LRHY0",132,0) W ! "RTN","LRHY0",133,0) W IODHLB," ",PNMALL "RTN","LRHY0",134,0) W ! "RTN","LRHY0",135,0) W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,40)),IOM) "RTN","LRHY0",136,0) W !,$$CJ^XLFSTR("Your Host is: "_$G(^LRHY(69.86,LRHYSITE,42)),IOM) "RTN","LRHY0",137,0) W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,44)),IOM) "RTN","LRHY0",138,0) W ! "RTN","LRHY0",139,0) W IODHLT," Orders for date: "_$$Y2K^LRX(DT) "RTN","LRHY0",140,0) W ! "RTN","LRHY0",141,0) W IODHLB," Orders for date: "_$$Y2K^LRX(DT) "RTN","LRHY0",142,0) W ! "RTN","LRHY0",143,0) S LRXYZ=0 "RTN","LRHY0",144,0) F S LRXYZ=$O(^LRHY(69.86,LRHYSITE,32,LRXYZ)) Q:+LRXYZ'>0 D "RTN","LRHY0",145,0) . W ! "RTN","LRHY0",146,0) . W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM) "RTN","LRHY0",147,0) . W ! "RTN","LRHY0",148,0) W *7 H 1 W *7 H 1 W *7 "RTN","LRHY0",149,0) ; "RTN","LRHY0",150,0) I $D(^LRHY(69.86,7,54,"B")) D BINBRD^LRHYBC1 "RTN","LRHY0",151,0) H 5 "RTN","LRHY0",152,0) QUITH ; "RTN","LRHY0",153,0) D SCRNOFF^LRHYUTL ; Turn off screen variables "RTN","LRHY0",154,0) K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT "RTN","LRHY0",155,0) K LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI "RTN","LRHY0",156,0) K LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND "RTN","LRHY0",157,0) K LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU "RTN","LRHY0",158,0) K LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN,LREXORD "RTN","LRHY0",159,0) K LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ "RTN","LRHY0",160,0) K LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT "RTN","LRHY0",161,0) K LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99 "RTN","LRHY0",162,0) K LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X,LRLOCS "RTN","LRHY0",163,0) K VAIN "RTN","LRHY0",164,0) ; "RTN","LRHY0",165,0) ; "RTN","LRHY0",166,0) G VET1 "RTN","LRHY0",167,0) ; "RTN","LRHY0",168,0) ; "RTN","LRHY0",169,0) ; "RTN","LRHY0",170,0) ORDCHK ; This block to be used for future version "RTN","LRHY0",171,0) QUIT "RTN","LRHY0",172,0) LOG ; Howdy will default to the clerks judgement when multiple orders found. "RTN","LRHY0",173,0) I $G(LRMULT) QUIT "RTN","LRHY0",174,0) Q:$G(LRSKIPNO) "RTN","LRHY0",175,0) ; "RTN","LRHY0",176,0) W !,"NO ORDERS" "RTN","LRHY0",177,0) ; "RTN","LRHY0",178,0) K LRDPF,PNM "RTN","LRHY0",179,0) D PT^LRX "RTN","LRHY0",180,0) D NOW^%DTC "RTN","LRHY0",181,0) I '$G(LRDFN) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(DFN) QUIT "RTN","LRHY0",182,0) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN) "RTN","LRHY0",183,0) QUIT "RTN","LRHY0",184,0) ; "RTN","LRHY0",185,0) ; "RTN","LRHY0",186,0) LOG1 ; Howdy will default to the clerks judgement when multiple orders found. "RTN","LRHY0",187,0) K LRORD,LRDPT,PNM "RTN","LRHY0",188,0) W !,"MULTIPLE ORDERS" "RTN","LRHY0",189,0) K LRDPF,PNM "RTN","LRHY0",190,0) D PT^LRX "RTN","LRHY0",191,0) D NOW^%DTC "RTN","LRHY0",192,0) S ^TMP("LRHYDY",$J,"LR MULTIPLE ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN) "RTN","LRHY0",193,0) S LRSKIPNO=1 "RTN","LRHY0",194,0) QUIT "RTN","LRHY0",195,0) ORDERS ; "RTN","LRHY0",196,0) QUIT "RTN","LRHY01") 0^2^B42472273^B41628624 "RTN","LRHY01",1,0) LRHY01 ;DALOI/HOAK - HOWDY MAIN DRIVER ;10/15/10 11:02am "RTN","LRHY01",2,0) ;;5.2;LAB SERVICE;**405,435,446,457**;Sep 27, 1994;Build 6 "RTN","LRHY01",3,0) ; "RTN","LRHY01",4,0) PICK ; "RTN","LRHY01",5,0) ; pick the site from Howdy Site FILE 69.86 "RTN","LRHY01",6,0) S LREND=0 "RTN","LRHY01",7,0) S DIC(0)="AEMQZ" "RTN","LRHY01",8,0) S DIC=69.86 "RTN","LRHY01",9,0) D ^DIC "RTN","LRHY01",10,0) I Y=-1 S LREND=1 QUIT "RTN","LRHY01",11,0) S LRHYSITE=+Y "RTN","LRHY01",12,0) K DIC "RTN","LRHY01",13,0) ; "RTN","LRHY01",14,0) N LRHY S LRHY="NUL" S LRHY=$O(^%ZIS(1,"B",LRHY)) "RTN","LRHY01",15,0) S LRDEV=$O(^%ZIS(1,"B",LRHY,0)) "RTN","LRHY01",16,0) D BINGO "RTN","LRHY01",17,0) G ALT "RTN","LRHY01",18,0) ; "RTN","LRHY01",19,0) ; Pick a printer "RTN","LRHY01",20,0) S LRDEV=0 "RTN","LRHY01",21,0) K DIC "RTN","LRHY01",22,0) S DIC(0)="EMQZ" K Y S LRHYCT2=1 "RTN","LRHY01",23,0) F S LRDEV=$O(^LRHY(69.86,LRHYSITE,10,"B",LRDEV)) Q:+LRDEV'>0 D "RTN","LRHY01",24,0) . W !,LRHYCT2,". ",$P(^%ZIS(1,LRDEV,0),U) "RTN","LRHY01",25,0) . S LRX(LRHYCT2)=LRDEV S LRHYCT2=LRHYCT2+1 "RTN","LRHY01",26,0) CHOOO W !,"Choose a label printer: " R X:DTIME W ! "RTN","LRHY01",27,0) I X="" W !,"NOTHING SELECTED" S LREND=1 QUIT "RTN","LRHY01",28,0) I U[X S LREND=1 QUIT "RTN","LRHY01",29,0) I 'X I $G(X)'="" W !,"enter the number please" G CHOOO "RTN","LRHY01",30,0) S LRDEV=LRX(X) "RTN","LRHY01",31,0) ; "RTN","LRHY01",32,0) ALT ; "RTN","LRHY01",33,0) W ?11,$P(^%ZIS(1,LRDEV,0),U) H 2 "RTN","LRHY01",34,0) K DIC "RTN","LRHY01",35,0) K LRHYCT2 "RTN","LRHY01",36,0) ; "RTN","LRHY01",37,0) QUIT "RTN","LRHY01",38,0) ; "RTN","LRHY01",39,0) VET ; Primary API for Howdy! Called by [LRHY PATIENT CARD SCAN] option. "RTN","LRHY01",40,0) D XTMP^LRHYU "RTN","LRHY01",41,0) N LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD "RTN","LRHY01",42,0) N LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI "RTN","LRHY01",43,0) N LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND "RTN","LRHY01",44,0) N LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU "RTN","LRHY01",45,0) N LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN,LREXORD "RTN","LRHY01",46,0) N LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ "RTN","LRHY01",47,0) N LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT "RTN","LRHY01",48,0) N LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99 "RTN","LRHY01",49,0) N LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X "RTN","LRHY01",50,0) ; "RTN","LRHY01",51,0) VET1 ; Code below executes to handle Patient episode. "RTN","LRHY01",52,0) ; Then, Howdy waits here for next Patient "RTN","LRHY01",53,0) I '$G(LRDEV) D PICK Q:LREND "RTN","LRHY01",54,0) ; "RTN","LRHY01",55,0) K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD "RTN","LRHY01",56,0) K LR3D,LR33ORD,LR3T,LRANX6,LRCSQ,LRUP,LRHY3DT,LRHY3SN3 "RTN","LRHY01",57,0) K LRHYDJOB,LRHYSPC7,LRHYURG3,LRS3333,LRTAT "RTN","LRHY01",58,0) K LRHY3DT3,LRCCOMX,LRFIN "RTN","LRHY01",59,0) ; "RTN","LRHY01",60,0) K ^TMP("LRHYDY",$J) "RTN","LRHY01",61,0) D ^LRPARAM ; Set Howdy up as Lab user "RTN","LRHY01",62,0) S LRHOWDY=1 "RTN","LRHY01",63,0) S LRHYCT=$G(LRHYCT,0) "RTN","LRHY01",64,0) I LRHYCT=2 W !,"Please ask the clerk for assistance." K LRHYCT QUIT "RTN","LRHY01",65,0) S LRODT=DT "RTN","LRHY01",66,0) W @IOF "RTN","LRHY01",67,0) K X "RTN","LRHY01",68,0) ; "RTN","LRHY01",69,0) W !!,"Please swipe your ID CARD or Type SSN: " "RTN","LRHY01",70,0) ; %ZOSF("EOFF") = U $I:NOECHO "RTN","LRHY01",71,0) ; %ZOSF("EON") = U $I:ECHO "RTN","LRHY01",72,0) X ^%ZOSF("EOFF") "RTN","LRHY01",73,0) R X:9999999 W ! "RTN","LRHY01",74,0) I X=U X ^%ZOSF("EON") D BAKUSER^LRHYU QUIT "RTN","LRHY01",75,0) X ^%ZOSF("EON") "RTN","LRHY01",76,0) ; Code is set to read all types of VIC card as of 9/05/2005 "RTN","LRHY01",77,0) ;I $E(X,1,9)["-" D "RTN","LRHY01",78,0) ;. S X=$P(X,"-")_$P(X,"-",2)_$P(X,"-",3) "RTN","LRHY01",79,0) ;I $E(X,1,1)'=0 I '$E(X,1,1) S X=$E(X,2,10) "RTN","LRHY01",80,0) ;I $L(X)>10 S X=$E(X,2,10) "RTN","LRHY01",81,0) ;I $L(X)'=9 W !,"Didn't read that Partner. " W:LRHYCT'=2 "Try again." H 2 S LRHYCT=LRHYCT+1 G VET "RTN","LRHY01",82,0) K DFN,LRDFN,LRDPA,LRDPF,PNM,LRHYCT "RTN","LRHY01",83,0) ; "RTN","LRHY01",84,0) ;S DFN=$O(^DPT("SSN",X,0)) "RTN","LRHY01",85,0) ; "RTN","LRHY01",86,0) ; NEW CODE FOR VIC 4.0 "RTN","LRHY01",87,0) D RPCVIC^DPTLK(.DFN,X) "RTN","LRHY01",88,0) ; "RTN","LRHY01",89,0) I DFN<1 W !,"No record for this person." R X:15 G VET1 "RTN","LRHY01",90,0) S LRDFN=$G(^DPT(DFN,"LR")) "RTN","LRHY01",91,0) ; "RTN","LRHY01",92,0) I LRDFN D PT^LRX "RTN","LRHY01",93,0) I 'LRDFN W !,"No Lab Data Available... Please check with clerk at the Desk." H 5 D LOG K X G VET1 "RTN","LRHY01",94,0) K ^TMP("LRHYDY",$J,"LRHYDY",$J,LRDFN) "RTN","LRHY01",95,0) ; "RTN","LRHY01",96,0) ; this call checks order against the 69.86 "RTN","LRHY01",97,0) D ORDCHK^LRHYB "RTN","LRHY01",98,0) ; "RTN","LRHY01",99,0) ; "RTN","LRHY01",100,0) ; "RTN","LRHY01",101,0) I $G(LRLOCS) W !!!,"Please check with clerk at the Desk" H 5 K X G QUITH "RTN","LRHY01",102,0) I $G(LRMULT) W !!!,"Please check with clerk at the Desk" H 5 D LOG K X G QUITH "RTN","LRHY01",103,0) 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 "RTN","LRHY01",104,0) D NOW^%DTC "RTN","LRHY01",105,0) ; "RTN","LRHY01",106,0) ; "RTN","LRHY01",107,0) ; "RTN","LRHY01",108,0) PRT1 ; "RTN","LRHY01",109,0) ; "RTN","LRHY01",110,0) W @IOF "RTN","LRHY01",111,0) D SCRNON^LRHYUTL "RTN","LRHY01",112,0) S PNMALL="Howdy "_$P(PNM,",",2)_" "_$P(PNM,",") "RTN","LRHY01",113,0) W ! "RTN","LRHY01",114,0) W IODHLT," ",PNMALL "RTN","LRHY01",115,0) W ! "RTN","LRHY01",116,0) W IODHLB," ",PNMALL "RTN","LRHY01",117,0) W ! "RTN","LRHY01",118,0) W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,40)),IOM) "RTN","LRHY01",119,0) W !,$$CJ^XLFSTR("Your Host is: "_$G(^LRHY(69.86,LRHYSITE,42)),IOM) "RTN","LRHY01",120,0) W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,44)),IOM) "RTN","LRHY01",121,0) W ! "RTN","LRHY01",122,0) W IODHLT," Orders for date: "_$$Y2K^LRX(DT) "RTN","LRHY01",123,0) W ! "RTN","LRHY01",124,0) W IODHLB," Orders for date: "_$$Y2K^LRX(DT) "RTN","LRHY01",125,0) W ! "RTN","LRHY01",126,0) S LRXYZ=0 "RTN","LRHY01",127,0) F S LRXYZ=$O(^LRHY(69.86,LRHYSITE,32,LRXYZ)) Q:+LRXYZ'>0 D "RTN","LRHY01",128,0) . W ! "RTN","LRHY01",129,0) . W !,$$CJ^XLFSTR($G(^LRHY(69.86,LRHYSITE,32,LRXYZ,0)),IOM) "RTN","LRHY01",130,0) . W ! "RTN","LRHY01",131,0) W *7 H 1 W *7 H 1 W *7 "RTN","LRHY01",132,0) ; "RTN","LRHY01",133,0) I $D(^LRHY(69.86,LRHYSITE,54,"B")) D LRHYBING "RTN","LRHY01",134,0) H 5 "RTN","LRHY01",135,0) QUITH ; "RTN","LRHY01",136,0) D SCRNOFF^LRHYUTL ; Turn off screen variables "RTN","LRHY01",137,0) K LRDFN,PNM,LRSN,SSN,LRIDT,LRAA,LRAN,LRAD,LRHYCT "RTN","LRHY01",138,0) K LRNPZZX,LRNODUP,LRLLOC,LRTSTZ99,LRACC,LRCDT,LRDPF,LRI "RTN","LRHY01",139,0) K LRORD3,LRHYFIX,LRPLICK,LRPR,LRPRAC,LRQUIET,LRRB,LRSAMP,LRSND "RTN","LRHY01",140,0) K LRSS,LRST,LRSTATUS,LRSUB1,LRTIC,LRTIM,LRTN,LRTREA,LRTS,LRTSORU "RTN","LRHY01",141,0) K LRTST6,LRTT,LRUN,LRWLO,LRWLC,LRWRD,LRXYZ,LR3DTIME,LR3DTN "RTN","LRHY01",142,0) K LR3SN,LRDT0,LREAL,LRFUTURE,LRGOTIT,LRHOWDY,LRHYHOK,LRIENZZ,LREXORD "RTN","LRHY01",143,0) K LRNOTST,LRLBLBP,LRLLOC66,LRMAX2,LRNLT,LRNODUP,LRNONE,LRNPZZX,LRODT "RTN","LRHY01",144,0) K LRODT0,LRHYOK,LRORD24,LRORU3,LRPAST,LRPIX,LRAHEAD,LRCHK,LRHYCT,LRCOL99 "RTN","LRHY01",145,0) K LRDT0,LRDUPT,LRHT1,LRIX,LROLLOC,LRX,LR3X,LRLOCS "RTN","LRHY01",146,0) K VAIN "RTN","LRHY01",147,0) ; "RTN","LRHY01",148,0) ; "RTN","LRHY01",149,0) G VET1 "RTN","LRHY01",150,0) ; "RTN","LRHY01",151,0) ; "RTN","LRHY01",152,0) ; "RTN","LRHY01",153,0) ORDCHK ; This block to be used for future version "RTN","LRHY01",154,0) QUIT "RTN","LRHY01",155,0) LOG ; Howdy will default to the clerks judgement when multiple orders found. "RTN","LRHY01",156,0) Q:$G(LRSKIPNO) "RTN","LRHY01",157,0) ; "RTN","LRHY01",158,0) W !,"NO ORDERS" "RTN","LRHY01",159,0) ; "RTN","LRHY01",160,0) K LRDPF,PNM "RTN","LRHY01",161,0) D PT^LRX "RTN","LRHY01",162,0) D NOW^%DTC "RTN","LRHY01",163,0) I '$G(LRDFN) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(DFN) QUIT "RTN","LRHY01",164,0) S ^TMP("LRHYDY",$J,"LR NO ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN) "RTN","LRHY01",165,0) QUIT "RTN","LRHY01",166,0) ; "RTN","LRHY01",167,0) ; "RTN","LRHY01",168,0) LOG1 ; Howdy will default to the clerks judgement when multiple orders found. "RTN","LRHY01",169,0) K LRORD,LRDPT,PNM "RTN","LRHY01",170,0) W !,"MULTIPLE ORDERS" "RTN","LRHY01",171,0) K LRDPF,PNM "RTN","LRHY01",172,0) D PT^LRX "RTN","LRHY01",173,0) D NOW^%DTC "RTN","LRHY01",174,0) S ^TMP("LRHYDY",$J,"LR MULTIPLE ORDERS",%)=$G(PNM)_U_$G(^LR(LRDFN,.1))_U_$G(SSN) "RTN","LRHY01",175,0) S LRSKIPNO=1 "RTN","LRHY01",176,0) QUIT "RTN","LRHY01",177,0) ORDERS ; "RTN","LRHY01",178,0) QUIT "RTN","LRHY01",179,0) ; "RTN","LRHY01",180,0) BINGO ; "RTN","LRHY01",181,0) S LRBINGO=0 "RTN","LRHY01",182,0) K DIC S DIC(0)="EMQZ" K Y S LRHYCT3=1 "RTN","LRHY01",183,0) F S LRBINGO=$O(^LRHY(69.86,LRHYSITE,54,"B",LRBINGO)) Q:+LRBINGO'>0 D "RTN","LRHY01",184,0) . W !!,LRHYCT3,". ",$P(^%ZIS(1,LRBINGO,0),U) W ! "RTN","LRHY01",185,0) . S LRX(LRHYCT3)=LRBINGO S LRHYCT3=LRHYCT3+1 "RTN","LRHY01",186,0) N LRHYX W !,"Choose PPOC Bingo Board: " R LRHYX:DTIME W ! "RTN","LRHY01",187,0) I LRHYX[U W !,"NOTHING SELECTED " QUIT "RTN","LRHY01",188,0) I LRHYX="" W !,"NOTHING SELECTED " QUIT "RTN","LRHY01",189,0) I '+LRHYX W !,"CHOOSE A NUMBER " H 2 G BINGO "RTN","LRHY01",190,0) Q:LRHYX[U "RTN","LRHY01",191,0) I $G(LRHYX)["?" W !,"Choose NUMBER " H 2 G BINGO "RTN","LRHY01",192,0) I $D(LRX) S LRBINGO=LRX(LRHYX) "RTN","LRHY01",193,0) Q:$G(LRBINGO)="" "RTN","LRHY01",194,0) W !! "RTN","LRHY01",195,0) W $P(^%ZIS(1,LRBINGO,0),U) "RTN","LRHY01",196,0) W ! "RTN","LRHY01",197,0) S LRBINGO=$P(^%ZIS(1,LRBINGO,0),U) "RTN","LRHY01",198,0) QUIT "RTN","LRHY01",199,0) LRHYBING ; "RTN","LRHY01",200,0) ; Display Patient on Bingo board. "RTN","LRHY01",201,0) W !,"SENDING TO BINGO BOARD ",LRBINGO H 2 "RTN","LRHY01",202,0) S ZTSAVE("PNM")="" "RTN","LRHY01",203,0) S ZTRTN="PRIBB^LRHY01" "RTN","LRHY01",204,0) S ZTDTH=$H "RTN","LRHY01",205,0) S ZTDESC="PPOC BINGO PRINT" "RTN","LRHY01",206,0) S ZTIO=$G(LRBINGO) "RTN","LRHY01",207,0) S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD "RTN","LRHY01",208,0) ; "RTN","LRHY01",209,0) QUIT "RTN","LRHY01",210,0) PRIBB ; "RTN","LRHY01",211,0) W !,$G(PNM) "RTN","LRHY01",212,0) QUIT "RTN","LRHYA") 0^3^B39254631^B29657209 "RTN","LRHYA",1,0) LRHYA ;DALOI/HOAK - HOWDY UTILITY-A ;9/16/2000 "RTN","LRHYA",2,0) ;;5.2;LAB SERVICE;**405,446,457**;Sep 27, 1994;Build 6 "RTN","LRHYA",3,0) ; "RTN","LRHYA",4,0) ; "RTN","LRHYA",5,0) OLT ; This block looks in the Howdy site file for tests that will print "RTN","LRHYA",6,0) ; order labels WILL NOT accession the test. "RTN","LRHYA",7,0) ; order label tests "RTN","LRHYA",8,0) K LRNODONE "RTN","LRHYA",9,0) S LRHYHOK=0 "RTN","LRHYA",10,0) S LRTSTS=0 "RTN","LRHYA",11,0) S LRPLICK=1 "RTN","LRHYA",12,0) F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 D "RTN","LRHYA",13,0) . S ^TMP("LRHYDY",$J,LRDFN,LR3DTN,LRTSTS)="" "RTN","LRHYA",14,0) . K LRNPZZX "RTN","LRHYA",15,0) . S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0)) "RTN","LRHYA",16,0) . S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) "RTN","LRHYA",17,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 S LRNOTST(LRTSTS)="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" QUIT "RTN","LRHYA",18,0) . I $D(^LRHY(69.86,LRHYSITE,25,"B",LRTSTS)) S LRHYHOK=1 D "RTN","LRHYA",19,0) .. S LROLT1(LR3DTN,LR3SN)=LRTSTS "RTN","LRHYA",20,0) .. S LRNOTST(LRTSTS)="" "RTN","LRHYA",21,0) .. D ^LRHYBLD ;print order labels "RTN","LRHYA",22,0) D DONE "RTN","LRHYA",23,0) QUIT "RTN","LRHYA",24,0) ; "RTN","LRHYA",25,0) LTE ; This block looks in the Howdy site file for those test to exclude "RTN","LRHYA",26,0) ; from accessioning by Howdy "RTN","LRHYA",27,0) ; "RTN","LRHYA",28,0) Q:'$G(LRCOL99) "RTN","LRHYA",29,0) K LRNODONE "RTN","LRHYA",30,0) K LRCCOM "RTN","LRHYA",31,0) ; exclude lab test "RTN","LRHYA",32,0) ; "RTN","LRHYA",33,0) S LRIENZZ=0 "RTN","LRHYA",34,0) S LRHYHOK=0 "RTN","LRHYA",35,0) S LRTSTS=0 "RTN","LRHYA",36,0) ; "RTN","LRHYA",37,0) S LRHYTOK=0 "RTN","LRHYA",38,0) K LRNPZZX "RTN","LRHYA",39,0) K LRNODUP "RTN","LRHYA",40,0) F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 S LRHYHOK=0 D "RTN","LRHYA",41,0) . ; "RTN","LRHYA",42,0) . S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) "RTN","LRHYA",43,0) . I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 S LRHYT654=LRTSTS S LRNOTST(LRTSTS)="",LREXORD(LRORD)="" QUIT "RTN","LRHYA",44,0) . K LRNPZZX "RTN","LRHYA",45,0) . K LRCCOM "RTN","LRHYA",46,0) . S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3) "RTN","LRHYA",47,0) . ; "RTN","LRHYA",48,0) . K LRNODONE "RTN","LRHYA",49,0) . S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0)) "RTN","LRHYA",50,0) . I $P($G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0)),U,6)'="" QUIT "RTN","LRHYA",51,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" S LRNODONE=1,LRHYHOK=1 QUIT "RTN","LRHYA",52,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT "RTN","LRHYA",53,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))'["CA" S LRHYTOK=LRTSTS "RTN","LRHYA",54,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 QUIT "RTN","LRHYA",55,0) . I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT "RTN","LRHYA",56,0) . ; "RTN","LRHYA",57,0) . I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 QUIT "RTN","LRHYA",58,0) . I LR3DTN=DT I $D(^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)) D "RTN","LRHYA",59,0) .. ; duplicate auto np function "RTN","LRHYA",60,0) .. ; "RTN","LRHYA",61,0) .. Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) ;no excepted test "RTN","LRHYA",62,0) .. Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS)) ;no order label tests "RTN","LRHYA",63,0) .. Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99)) "RTN","LRHYA",64,0) .. ; "RTN","LRHYA",65,0) .. S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0)) "RTN","LRHYA",66,0) .. K ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN) "RTN","LRHYA",67,0) .. K LRNPZZX "RTN","LRHYA",68,0) .. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRHYHOK=1 QUIT "RTN","LRHYA",69,0) .. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT "RTN","LRHYA",70,0) .. ; a future enhancement may be used to cancel a test "RTN","LRHYA",71,0) .. S LRT(LRTSTS)=LR3SN_U_LRIENZZ_U_LRTSTS S LRJ=LRTSTS "RTN","LRHYA",72,0) .. ; "RTN","LRHYA",73,0) .. K LRCCOMX,LRCCOM0,LRCCOM1 "RTN","LRHYA",74,0) .. I $G(^LRHY(69.86,LRHYSITE,52))="" S LRNODUP=1 "RTN","LRHYA",75,0) .. I $G(^LRHY(69.86,LRHYSITE,52))="N" S LRNODUP=1 "RTN","LRHYA",76,0) .. Q:$G(LRNODUP) S LRHYHOK=1 K LRCCOM S ZTRTN="FX2^LRHYDEL",ZTSAVE("L*")="",ZTDTH=$H,ZTIO="NULL" S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD "RTN","LRHYA",77,0) .. H 5 "RTN","LRHYA",78,0) . E D "RTN","LRHYA",79,0) .. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0)) "RTN","LRHYA",80,0) .. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0)) "RTN","LRHYA",81,0) .. Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) ;no excepted test "RTN","LRHYA",82,0) .. Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS)) ;no order label tests "RTN","LRHYA",83,0) .. Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99)) "RTN","LRHYA",84,0) .. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0)) "RTN","LRHYA",85,0) .. K LRNPZZX "RTN","LRHYA",86,0) .. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT "RTN","LRHYA",87,0) .. ; "RTN","LRHYA",88,0) .. I LR3DTN=DT S ^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)="" "RTN","LRHYA",89,0) ; "RTN","LRHYA",90,0) D DONE "RTN","LRHYA",91,0) QUIT "RTN","LRHYA",92,0) ; "RTN","LRHYA",93,0) CSE ; This block checks for collection sample exclusion "RTN","LRHYA",94,0) S LRHYHOK=0 "RTN","LRHYA",95,0) S LRHYSPC7=$P($G(^LAB(62,LRCOL99,0)),U,2) "RTN","LRHYA",96,0) I $G(LRHYSPC7) I $D(^LRHY(69.86,LRHYSITE,6,"B",LRHYSPC7)) S LRHYHOK=1 "RTN","LRHYA",97,0) K LRNODONE "RTN","LRHYA",98,0) I $D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99)) S LRHYHOK=1 "RTN","LRHYA",99,0) I LRHYHOK=1 S LRHYCS33(LR3DTN,LR3SN)=LRCOL99 "RTN","LRHYA",100,0) QUIT "RTN","LRHYA",101,0) ; "RTN","LRHYA",102,0) CSTATUS ; This block checks for collection types to exclude "RTN","LRHYA",103,0) S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) "RTN","LRHYA",104,0) K LRNODONE "RTN","LRHYA",105,0) K LRWCZZZ "RTN","LRHYA",106,0) S LRHYHOK=0 "RTN","LRHYA",107,0) I $D(^LRHY(69.86,LRHYSITE,8,"B",LRCSTAT)) S LRHYHOK=1 S LRWCZZZ=1 "RTN","LRHYA",108,0) I LRHYHOK=1 S ^TMP("LRHYDY",$J,"STATUS",LRORD)="" "RTN","LRHYA",109,0) D DONE "RTN","LRHYA",110,0) QUIT "RTN","LRHYA",111,0) ; "RTN","LRHYA",112,0) EXLOC ; This block checks for Hospital locations to exclude "RTN","LRHYA",113,0) ; "RTN","LRHYA",114,0) I LR3DTN=DT Q "RTN","LRHYA",115,0) ; "RTN","LRHYA",116,0) ; This logic is to look for tests from an excluded location on the same specimen "RTN","LRHYA",117,0) ; number as tests from a non-excluded location because of orders being merged. "RTN","LRHYA",118,0) ; Variable LRLOCS will indicate this situation and will trigger a "check with clerk" "RTN","LRHYA",119,0) ; message. "RTN","LRHYA",120,0) ; "RTN","LRHYA",121,0) N LREX,LRNONEX,LRX,LRXX,LRMGINFO,LRMGDT,LRMGSN,LRXXLOC "RTN","LRHYA",122,0) I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LREX=1 "RTN","LRHYA",123,0) I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRNONEX=1 "RTN","LRHYA",124,0) ; "RTN","LRHYA",125,0) S LRTSTS=0 "RTN","LRHYA",126,0) F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 D Q:$G(LRLOCS) "RTN","LRHYA",127,0) . S LR3ZTST=0 "RTN","LRHYA",128,0) . S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0 "RTN","LRHYA",129,0) . ; "RTN","LRHYA",130,0) . S LRX=$G(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0)) "RTN","LRHYA",131,0) . S LRMGINFO=$P(LRX,U,14) "RTN","LRHYA",132,0) . Q:LRMGINFO="" "RTN","LRHYA",133,0) . S LRMGDT=$P(LRMGINFO,";",1),LRMGSN=$P(LRMGINFO,";",2) "RTN","LRHYA",134,0) . S LRXX=$G(^LRO(69,LRMGDT,1,LRMGSN,0)),LRXXLOC=$P(LRXX,U,7) "RTN","LRHYA",135,0) . Q:LRXXLOC="" "RTN","LRHYA",136,0) . ; "RTN","LRHYA",137,0) . I $D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LRNONEX)=1 S LRLOCS=1 Q "RTN","LRHYA",138,0) . I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LREX)=1 S LRLOCS=1 Q "RTN","LRHYA",139,0) ; "RTN","LRHYA",140,0) ; "RTN","LRHYA",141,0) I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRHYHOK=1 D DONE S ^TMP("LRHYDY",$J,"EXLOC",LRORD,LRLLOC66,LR3SN)="" "RTN","LRHYA",142,0) QUIT "RTN","LRHYA",143,0) DONE ; "RTN","LRHYA",144,0) Q:$D(LROLT1) "RTN","LRHYA",145,0) Q:$G(LRHYT654) "RTN","LRHYA",146,0) I $G(LRHYTOK) S LRHYHOK=0 "RTN","LRHYA",147,0) Q:$G(LRNODONE) "RTN","LRHYA",148,0) I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)="" "RTN","LRHYA",149,0) I LRHYHOK>1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,LRHYHOK)="" "RTN","LRHYA",150,0) QUIT "RTN","LRHYA",151,0) URG ; "RTN","LRHYA",152,0) S LRHYHOK=0 "RTN","LRHYA",153,0) S LRTSTS=0 "RTN","LRHYA",154,0) F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0!(LRHYHOK) D URGP "RTN","LRHYA",155,0) QUIT "RTN","LRHYA",156,0) D DONE "RTN","LRHYA",157,0) QUIT "RTN","LRHYA",158,0) URGP ; "RTN","LRHYA",159,0) S LR3ZTST=0 "RTN","LRHYA",160,0) S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0!(LRHYHOK) D URG1 Q:LRHYHOK "RTN","LRHYA",161,0) QUIT "RTN","LRHYA",162,0) URG1 ; "RTN","LRHYA",163,0) S LRURGZ19=$P(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0),U,2) "RTN","LRHYA",164,0) I $D(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19)) S LRHYHOK=1 S LRHYURG3(LR3DTN,LR3SN)=LR3ZTST "RTN","LRHYA",165,0) I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)="" "RTN","LRHYA",166,0) S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) "RTN","LRHYA",167,0) I LRHYHOK=1 S ^TMP("LRHYDY",$J,"URG",LRORD)="" "RTN","LRHYA",168,0) QUIT "RTN","LRHYB") 0^4^B43402214^B41402354 "RTN","LRHYB",1,0) LRHYB ;DALOI/HOAK - HOWDY B DRIVER ;9/16/2000 "RTN","LRHYB",2,0) ;;5.2;LAB SERVICE;**405,417,446,457**;Sep 27, 1994;Build 6 "RTN","LRHYB",3,0) ; "RTN","LRHYB",4,0) TEST ; "RTN","LRHYB",5,0) S DIC=2 S DIC(0)="AEMQZ" D ^DIC "RTN","LRHYB",6,0) Q:Y=-1 "RTN","LRHYB",7,0) S LRDFN=$G(^DPT(+Y,"LR")) "RTN","LRHYB",8,0) ; "RTN","LRHYB",9,0) ; "RTN","LRHYB",10,0) ; "RTN","LRHYB",11,0) ORDCHK ; Here is where the search for an order number starts "RTN","LRHYB",12,0) K LRHYT654 "RTN","LRHYB",13,0) ; The Howdy site file will help determine which orders the site "RTN","LRHYB",14,0) ; will accept. Once an order has been selected it is handed off "RTN","LRHYB",15,0) ; to LRORDST to start the accessioning process. "RTN","LRHYB",16,0) ; "RTN","LRHYB",17,0) K LRWCZZZ,LRDTF "RTN","LRHYB",18,0) K LRHYCS33 "RTN","LRHYB",19,0) K ^TMP("LRHYDY",$J,"KILL") "RTN","LRHYB",20,0) ; "RTN","LRHYB",21,0) ; "RTN","LRHYB",22,0) K ^TMP("LRHYDY",$J,"MULTD") "RTN","LRHYB",23,0) K ^TMP("LRHYDY",$J,"DUPTEST") "RTN","LRHYB",24,0) K LRHYCS "RTN","LRHYB",25,0) K ^TMP("LRHYDY",$J,"MT") "RTN","LRHYB",26,0) S LRHOWDY=1 "RTN","LRHYB",27,0) S LREND=0 "RTN","LRHYB",28,0) S LRORD="" "RTN","LRHYB",29,0) Q:'LRDFN "RTN","LRHYB",30,0) ; "RTN","LRHYB",31,0) K ^TMP("LRHYDY",$J,"LRSN"),LRNPZZX "RTN","LRHYB",32,0) S LRHYOK=0 "RTN","LRHYB",33,0) ; "RTN","LRHYB",34,0) ; 18 days ahead "RTN","LRHYB",35,0) ; 20 days back "RTN","LRHYB",36,0) ; "RTN","LRHYB",37,0) S X2=0 K LRNPZZX "RTN","LRHYB",38,0) S LRAHEAD=$G(^LRHY(69.86,LRHYSITE,18)) "RTN","LRHYB",39,0) S LRPAST=$G(^LRHY(69.86,LRHYSITE,20)) "RTN","LRHYB",40,0) K LRWCZZZ,LREXORD "RTN","LRHYB",41,0) S LRLOCS=0 ; flag for non-EXLOC and EXLOC on same specimen number "RTN","LRHYB",42,0) F LRI=-LRPAST:1:LRAHEAD D Q:$G(LRLOCS) ;Search window set by site file. "RTN","LRHYB",43,0) . S X1=DT S X2=LRI D C^%DTC S LR3DTN=X "RTN","LRHYB",44,0) . I $D(^LRO(69,LR3DTN,1,"AA",LRDFN)) S LRHYOK=1 D "RTN","LRHYB",45,0) .. S LR3SN=0 "RTN","LRHYB",46,0) .. F S LR3SN=$O(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN)) Q:+LR3SN'>0 D Q:$G(LRLOCS) "RTN","LRHYB",47,0) ... Q:$P($G(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C" ;collected "RTN","LRHYB",48,0) ... K LRWCZZZ "RTN","LRHYB",49,0) ... ; "RTN","LRHYB",50,0) ... K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3) "RTN","LRHYB",51,0) ... K LRCSTAT S LRCSTAT=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,4) "RTN","LRHYB",52,0) ... D CSTATUS^LRHYA Q:LRHYHOK ;Check collection status "RTN","LRHYB",53,0) ... ; "RTN","LRHYB",54,0) ... D OLT^LRHYA ;print order label tests "RTN","LRHYB",55,0) ... Q:LRHYHOK "RTN","LRHYB",56,0) ... ; "RTN","LRHYB",57,0) ... ; "RTN","LRHYB",58,0) ... K LRNOTST "RTN","LRHYB",59,0) ... S LRNODUP=0 D LTE^LRHYA Q:LRHYHOK ;check for excluded lab tests "RTN","LRHYB",60,0) ... ; "RTN","LRHYB",61,0) ... S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) "RTN","LRHYB",62,0) ... S LRLLOC66=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,9) "RTN","LRHYB",63,0) ... D EXLOC^LRHYA Q:LRHYHOK ;check for locations to exclude "RTN","LRHYB",64,0) ... ; "RTN","LRHYB",65,0) ... S LRLLOC=$G(LRLLOC66) "RTN","LRHYB",66,0) ... S LRORD24=0 "RTN","LRHYB",67,0) ... D OLT^LRHYA Q:LRHYHOK ;print order label tests "RTN","LRHYB",68,0) ... ; "RTN","LRHYB",69,0) ... D URG^LRHYA Q:LRHYHOK ;; CHECK URGENCY "RTN","LRHYB",70,0) ... K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3) "RTN","LRHYB",71,0) ... D CSE^LRHYA Q:LRHYHOK ;check for excluded collection samples "RTN","LRHYB",72,0) ... ; "RTN","LRHYB",73,0) ... I $O(^TMP("LRHYDY",$J,"EXLOC",LRORD,0))=$G(LRLLOC66) I $O(^LRO(69,"C",LRORD,0))'=DT QUIT "RTN","LRHYB",74,0) ... ; CHECK URGENCY "RTN","LRHYB",75,0) ... S LRTST6=0 ; micro test "RTN","LRHYB",76,0) ... F S LRTST6=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTST6)) Q:+LRTST6'>0 D "RTN","LRHYB",77,0) .... S LRTSTZ99(LRTST6)="" "RTN","LRHYB",78,0) .... I LRTST6 S LRSUB1=$P(^LAB(60,LRTST6,0),U,4) ; subscript "RTN","LRHYB",79,0) .... Q:$D(LRNPZZX(^LRO(69,LR3DTN,1,LR3SN,.1),LR3SN,LRTST6)) "RTN","LRHYB",80,0) .... S LRORD=$G(^LRO(69,LR3DTN,1,LR3SN,.1)) "RTN","LRHYB",81,0) .... I $G(LRORD) I $D(^TMP("LRHYDY",$J,"STATUS",LRORD)) QUIT "RTN","LRHYB",82,0) .... I $D(LRNOTST) I $D(LRNOTST(LRTST6)) K LRORD QUIT "RTN","LRHYB",83,0) .... S ^TMP("LRHYDY",$J,"LRSN",LR3DTN,^LRO(69,LR3DTN,1,LR3SN,.1))="" "RTN","LRHYB",84,0) .... S LRDTX="" "RTN","LRHYB",85,0) .... S LRDTX=$O(^LRO(69,"C",^LRO(69,LR3DTN,1,LR3SN,.1),0)) "RTN","LRHYB",86,0) .... I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)),LR3DTN=DT,$G(LRDTX) S ^TMP("LRHYDY",$J,"MT",LRDTX)="" "RTN","LRHYB",87,0) .... I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I $G(LRDTX) S ^TMP("LRHYDY",$J,"MT",LRDTX)="" "RTN","LRHYB",88,0) ; "RTN","LRHYB",89,0) ; "RTN","LRHYB",90,0) K LRMULT "RTN","LRHYB",91,0) I $G(LRWCMULT) W !!!!,"Multple Orders Present" S LRMULT=1 D LOG1^LRHY0 K LRWCMULT QUIT "RTN","LRHYB",92,0) ; per Libba 1/14/2002 "RTN","LRHYB",93,0) I $D(^TMP("LRHYDY",$J,"LRSN",DT)) S LR3DTN=DT ; I prefer today's orders but... "RTN","LRHYB",94,0) E S LR3DTN=$O(^TMP("LRHYDY",$J,"LRSN",0)) ; I'll take whatever ya got "RTN","LRHYB",95,0) I 'LR3DTN K LRORD QUIT "RTN","LRHYB",96,0) ; "RTN","LRHYB",97,0) I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I $O(^TMP("LRHYDY",$J,"LRSN",LR3DTN)) W !,"MULTIPLE DAYS WITH ORDERS" S LRMULT=1 D LOG1^LRHY0 QUIT "RTN","LRHYB",98,0) ; "RTN","LRHYB",99,0) S LRTIC=0 "RTN","LRHYB",100,0) S LRMULT=0 "RTN","LRHYB",101,0) ; "RTN","LRHYB",102,0) F S LRTIC=$O(^TMP("LRHYDY",$J,"LRSN",LRTIC)) Q:+LRTIC'>0 S LRMULT=LRMULT+1 "RTN","LRHYB",103,0) I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I LRMULT>1 W !,"MULTIPLE DAYS WITH ORDERS" S LRMULT=0 D LOG1^LRHY0 QUIT "RTN","LRHYB",104,0) ;MODIFIED BY HOAK to flag when wc and sp are on same visit "RTN","LRHYB",105,0) ; "RTN","LRHYB",106,0) ; "RTN","LRHYB",107,0) MOVE ; "RTN","LRHYB",108,0) I $D(LRNOTST) I $G(LRHYT654) I $D(LRNOTST(LRHYT654)) K LRORD QUIT "RTN","LRHYB",109,0) I $G(LRORD),$D(LREXORD(LRORD)) K LRORD QUIT "RTN","LRHYB",110,0) S LRHY3SN3=0 "RTN","LRHYB",111,0) S LRHY3DT3=0 "RTN","LRHYB",112,0) I $D(^TMP("LRHYDY",$J,"URG",LRORD)) K LRORD QUIT "RTN","LRHYB",113,0) I $D(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19)) K LRORD QUIT "RTN","LRHYB",114,0) S LRTIC=0 "RTN","LRHYB",115,0) S LRMULT=0 "RTN","LRHYB",116,0) F S LRTIC=$O(^TMP("LRHYDY",$J,"MT",LRTIC)) Q:+LRTIC'>0 S LRMULT=LRMULT+1 "RTN","LRHYB",117,0) S LR3MULT=LRMULT "RTN","LRHYB",118,0) I LRMULT>1 W !,"MULTIPLE DAYS WITH ORDERS" S LRORD=0 QUIT "RTN","LRHYB",119,0) E S LRMULT=0 "RTN","LRHYB",120,0) ; may be accessioned. "RTN","LRHYB",121,0) ; Setting up task to continue based on the specimen. "RTN","LRHYB",122,0) K LR3ZTST "RTN","LRHYB",123,0) MOVE1 ; "RTN","LRHYB",124,0) S LRORD=0 "RTN","LRHYB",125,0) F S LRORD=$O(^TMP("LRHYDY",$J,"LRSN",LR3DTN,LRORD)) Q:+LRORD'>0 D "RTN","LRHYB",126,0) . S:'$G(LR3ORD) LR3ORD=LRORD "RTN","LRHYB",127,0) . I $D(^TMP("LRHYDY",$J,"URG",LRORD)) QUIT "RTN","LRHYB",128,0) . S LRHYORDZ=LRORD "RTN","LRHYB",129,0) . ; "RTN","LRHYB",130,0) . S ZTSAVE("^TMP(""LRHYDY"",$J,")="" "RTN","LRHYB",131,0) . S ZTRTN="PAST^LRHYPH0",ZTSAVE("L*")="",ZTDTH=$H,ZTDESC="HOWDY" "RTN","LRHYB",132,0) . S ZTIO="NULL" "RTN","LRHYB",133,0) . S ZTSAVE("L*")="" "RTN","LRHYB",134,0) . S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD "RTN","LRHYB",135,0) . S LRGOTIT=1 "RTN","LRHYB",136,0) . S LRORD=LRHYORDZ "RTN","LRHYB",137,0) . K LRSTOPZ(LRORD) "RTN","LRHYB",138,0) K ^TMP("LRHYDY",$J,"MULTD") "RTN","LRHYB",139,0) S LRORD=$G(LR3ORD) K LR3ORD "RTN","LRHYB",140,0) K LRHOWDY,LR3SN24,LR3DTN24,LR3ZTST "RTN","LRHYB",141,0) ; Remove collection info on order label tests "RTN","LRHYB",142,0) S LR3DTN=0 "RTN","LRHYB",143,0) F S LR3DTN=$O(LROLT1(LR3DTN)) Q:+LR3DTN'>0 D "RTN","LRHYB",144,0) . S LR3SN=0 "RTN","LRHYB",145,0) . F S LR3SN=$O(LROLT1(LR3DTN,LR3SN)) Q:+LR3SN'>0 D "RTN","LRHYB",146,0) .. S ^LRO(69,LR3DTN,1,LR3SN,1)="" "RTN","LRHYB",147,0) K LROLT1 "RTN","LRHYB",148,0) I $G(LRORD) I $D(LRSTOPZ(LRORD)) K LRORD,LRSTOPZ QUIT "RTN","LRHYB",149,0) ; "RTN","LRHYB",150,0) QUIT "RTN","LRHYB",151,0) ; "RTN","LRHYB",152,0) MMM ; "RTN","LRHYB",153,0) N LRI S LRI=0 "RTN","LRHYB",154,0) N LR3DTN,LR3SN,LRIENZZ,LRTSTX "RTN","LRHYB",155,0) K LRHYMORD "RTN","LRHYB",156,0) K LRHYMULT "RTN","LRHYB",157,0) F LRI=-LRPAST:1:LRAHEAD D "RTN","LRHYB",158,0) . S X1=DT S X2=LRI D C^%DTC S LR3DTN=X "RTN","LRHYB",159,0) . ; "RTN","LRHYB",160,0) . I $D(^LRO(69,LR3DTN,1,"AA",LRDFN)) D "RTN","LRHYB",161,0) .. S LR3SN=0 "RTN","LRHYB",162,0) .. F S LR3SN=$O(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN)) Q:+LR3SN'>0 D "RTN","LRHYB",163,0) ... ; "RTN","LRHYB",164,0) ... Q:$P($G(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C" ;collected "RTN","LRHYB",165,0) ... S LRTSTX=0 "RTN","LRHYB",166,0) ... F S LRTSTX=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX)) Q:+LRTSTX'>0 D "RTN","LRHYB",167,0) .... S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX,0)) "RTN","LRHYB",168,0) .... ; "RTN","LRHYB",169,0) .... Q:$G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" "RTN","LRHYB",170,0) .... K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3) "RTN","LRHYB",171,0) .... S LRHYHOK=0 D CSE^LRHYA Q:LRHYHOK "RTN","LRHYB",172,0) .... S LRCSTAT=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,4) "RTN","LRHYB",173,0) .... S LRHYHOK=0 D CSTATUS^LRHYA Q:LRHYHOK "RTN","LRHYB",174,0) .... S LRLLOC66=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,9) "RTN","LRHYB",175,0) .... S LRHYHOK=0 D EXLOC^LRHYA Q:LRHYHOK "RTN","LRHYB",176,0) .... S LRHYMULT(LR3DTN,LR3SN,LRIENZZ)=LRTSTX "RTN","LRHYB",177,0) N CNT "RTN","LRHYB",178,0) S CNT=0 "RTN","LRHYB",179,0) S LR3DTN=0 "RTN","LRHYB",180,0) F S LR3DTN=$O(LRHYMULT(LR3DTN)) Q:+LR3DTN'>0 S CNT=CNT+1 "RTN","LRHYB",181,0) I CNT>1 S LRHYMORD=1 "RTN","LRHYPH0") 0^7^B40393749^B38997897 "RTN","LRHYPH0",1,0) LRHYPH0 ;DALOI/HOAK - HOWDY ORDER NUMBER SELECTOR PRIME ;8/28/2005 "RTN","LRHYPH0",2,0) ;;5.2;LAB SERVICE;**405,457**;Sep 27, 1994;Build 6 "RTN","LRHYPH0",3,0) ; "RTN","LRHYPH0",4,0) ; "RTN","LRHYPH0",5,0) K LRORIFN,LRNATURE,LREND,LRORDRR "RTN","LRHYPH0",6,0) S LRLWC="WC" "RTN","LRHYPH0",7,0) D ^LRPARAM "RTN","LRHYPH0",8,0) I $G(LREND) S LREND=0 Q "RTN","LRHYPH0",9,0) L5 ; "RTN","LRHYPH0",10,0) NEXT ; "RTN","LRHYPH0",11,0) K DIR "RTN","LRHYPH0",12,0) I $D(LROESTAT) D:$P(LRPARAM,U,14) ^LRCAPV I $G(LREND) K LRLONG,LRPANEL Q "RTN","LRHYPH0",13,0) S (LRODT,X,DT)=$$DT^XLFDT(),LRODT0=$$FMTE^XLFDT(DT,5) "RTN","LRHYPH0",14,0) I $D(^LAB(69.9,1,"RO")),+$H'=+$P(^("RO"),U) D "RTN","LRHYPH0",15,0) . W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),! "RTN","LRHYPH0",16,0) . S DIR("A")=" Are you sure you want to continue",DIR(0)="Y",DIR("B")="No" "RTN","LRHYPH0",17,0) I $T D ^DIR G END:$D(DIRUT) I Y'=1 W !,"OK, try later." Q "RTN","LRHYPH0",18,0) S X="T-7",%DT="" D ^%DT S LRTM7=+Y "RTN","LRHYPH0",19,0) K DIC,LRSND,LRSN "RTN","LRHYPH0",20,0) W !!,"Select Order number: " R LRORD:DTIME W ! Q:LRORD["^"!(LRORD[".")!($D(LRLONG)&(LRORD="")) "RTN","LRHYPH0",21,0) PAST ; HOWDY IN HERE "RTN","LRHYPH0",22,0) W @IOF S M9=0 G QUICK^LROE1:LRORD="" "RTN","LRHYPH0",23,0) S:LRORD?.N LRORD=+LRORD IF LRORD'?.N D QMSG QUIT "RTN","LRHYPH0",24,0) I '$D(^LRO(69,"C",LRORD)) W !!?10,"No order exist with that number ",$C(7),! QUIT "RTN","LRHYPH0",25,0) S (LRCHK,LRNONE)=1,(M9,LRODT)=0 "RTN","LRHYPH0",26,0) F S LRODT=+$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D "RTN","LRHYPH0",27,0) . S DA=0 F S DA=$O(^LRO(69,"C",LRORD,LRODT,DA)) Q:DA<1 S LRCHK=LRCHK-1 S:LRNONE'=2 LRNONE=0 D LROE2 "RTN","LRHYPH0",28,0) I LRNONE=2 W !,"The order has already been",$S(LRCHK<1:" partially",1:"")," accessioned." H 1 "RTN","LRHYPH0",29,0) I LRNONE=1 W !,"No order exists with that number." H 1 QUIT "RTN","LRHYPH0",30,0) I '$$GOT(LRORD,LRODT) QUIT "RTN","LRHYPH0",31,0) K DIR S DIR("A")="Is this the correct order",DIR(0)="Y" "RTN","LRHYPH0",32,0) S DIR("B")="Yes" "RTN","LRHYPH0",33,0) K DIR S Y=1 "RTN","LRHYPH0",34,0) I $D(DIRUT)!(Y'=1) K LRSN QUIT "RTN","LRHYPH0",35,0) L +^LRO(69,"C",LRORD):$G(DILOCKTM,3) "RTN","LRHYPH0",36,0) I '$T W !?5,"Someone else is editing this Order",!!,$C(7) QUIT "RTN","LRHYPH0",37,0) K %DT "RTN","LRHYPH0",38,0) S LRSTATUS="",%DT("B")="" "RTN","LRHYPH0",39,0) D TIME K %DT "RTN","LRHYPH0",40,0) D:$G(LRCDT)<1 UNL69 QUIT:LRCDT<1 "RTN","LRHYPH0",41,0) S LRTIM=+LRCDT "RTN","LRHYPH0",42,0) S LRUN=$P(LRCDT,U,2) K LRCDT,LRSN "RTN","LRHYPH0",43,0) MORE ; "RTN","LRHYPH0",44,0) S M9=0 "RTN","LRHYPH0",45,0) S (LRODT,LRSND)=0 "RTN","LRHYPH0",46,0) N LR69,LR69LOC "RTN","LRHYPH0",47,0) F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D "RTN","LRHYPH0",48,0) . S LRSND=0 "RTN","LRHYPH0",49,0) . F S LRSND=$O(^LRO(69,"C",LRORD,LRODT,LRSND)) Q:LRSND<1 D "RTN","LRHYPH0",50,0) . . S LR69=$G(^LRO(69,LRODT,1,LRSND,0)),LR69LOC=$P(LR69,"^",9) "RTN","LRHYPH0",51,0) . . I LRODT'=DT,LR69LOC'="",$D(^LRHY(69.86,LRHYSITE,16,"B",LR69LOC)) Q "RTN","LRHYPH0",52,0) . . S LRSN(LRSND)=LRSND,LRSN=LRSND "RTN","LRHYPH0",53,0) . . K LRAA D Q15^LRHYPH2 K LRSN "RTN","LRHYPH0",54,0) D TASK,UNL69 "RTN","LRHYPH0",55,0) QUIT "RTN","LRHYPH0",56,0) ; "RTN","LRHYPH0",57,0) ; "RTN","LRHYPH0",58,0) LROE2 ; "RTN","LRHYPH0",59,0) I $D(^LRO(69,LRODT,1,DA,1)),$P(^(1),U,4)="" S LRNONE=2,LRCHK=LRCHK+1 "RTN","LRHYPH0",60,0) K LRSN "RTN","LRHYPH0",61,0) S (LRSN,LRSN(DA))=+DA "RTN","LRHYPH0",62,0) I '$D(^LRO(69,LRODT,1,LRSN,0)) Q "RTN","LRHYPH0",63,0) S M9=$G(M9)+1,LR3X=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LR3X,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX "RTN","LRHYPH0",64,0) Q "RTN","LRHYPH0",65,0) ; "RTN","LRHYPH0",66,0) ; "RTN","LRHYPH0",67,0) QMSG W !,"Enter the order entry number assigned when the test was ordered." "RTN","LRHYPH0",68,0) W:'$D(LRLONG) !,"If the test has not been ordered, type the RETURN key to order the test." "RTN","LRHYPH0",69,0) W !,"To exit, type the ""^"" key and RETURN key." "RTN","LRHYPH0",70,0) Q "RTN","LRHYPH0",71,0) ; "RTN","LRHYPH0",72,0) ; "RTN","LRHYPH0",73,0) YN R X:DTIME W ! S:'$T DTOUT=1 Q:X=""!(X["N")!(X["Y") "RTN","LRHYPH0",74,0) W !,"Answer 'Y' or 'N': " G YN "RTN","LRHYPH0",75,0) ; "RTN","LRHYPH0",76,0) ; "RTN","LRHYPH0",77,0) EN ; "RTN","LRHYPH0",78,0) LROEN S LRNCWL=1 "RTN","LRHYPH0",79,0) D LROE,END K LRNCWL "RTN","LRHYPH0",80,0) Q "RTN","LRHYPH0",81,0) ; "RTN","LRHYPH0",82,0) LROE ; "RTN","LRHYPH0",83,0) QUIT "RTN","LRHYPH0",84,0) ; "RTN","LRHYPH0",85,0) EN01 ; ENTER ORDER # THEN ENTER DATA "RTN","LRHYPH0",86,0) STAT ; "RTN","LRHYPH0",87,0) D ^LRPARAM "RTN","LRHYPH0",88,0) I '$D(LRLABKY) W !!?10,"You do not have the proper security Keys",! Q "RTN","LRHYPH0",89,0) ; "RTN","LRHYPH0",90,0) ; Select peforming laboratory "RTN","LRHYPH0",91,0) S X=$$SELPL^LRVERA(DUZ(2)) "RTN","LRHYPH0",92,0) I X<1 D END Q "RTN","LRHYPH0",93,0) I X'=DUZ(2) N LRPL S LRPL=X "RTN","LRHYPH0",94,0) ; "RTN","LRHYPH0",95,0) S LRLONG="",LRPANEL=0,LROESTAT="" "RTN","LRHYPH0",96,0) S %H=$H-60 D YMD^LRX S LRTM60=9999999-X "RTN","LRHYPH0",97,0) D LROE K LRTM60,LRLONG,LREND,LROESTAT "RTN","LRHYPH0",98,0) D END "RTN","LRHYPH0",99,0) Q "RTN","LRHYPH0",100,0) ; "RTN","LRHYPH0",101,0) ; "RTN","LRHYPH0",102,0) TIME ;from LROE1, LRORD1 "RTN","LRHYPH0",103,0) D NOW^%DTC S LRCDT=% QUIT ;STUFFED FOR HOWDY "RTN","LRHYPH0",104,0) S %DT="SET" W !,"Collection Date@Time: ",$S($D(%DT("B")):%DT("B"),1:"NOW"),"//" R X:DTIME W ! I '$T!(X="^") S LRCDT=-1 Q "RTN","LRHYPH0",105,0) S:X="" X=$S($D(%DT("B")):%DT("B"),1:"N") "RTN","LRHYPH0",106,0) W:X["?" !!,"You may enter ""T@U"" or just ""U"", for Today at Unknown time",!! "RTN","LRHYPH0",107,0) I X["@U",$P(X,"@U",2)="" S X=$P(X,"@U",1) D ^%DT G TIME:Y<1 S LRCDT=+Y_"^1" Q "RTN","LRHYPH0",108,0) S:X="U" LRCDT=DT_"^1" "RTN","LRHYPH0",109,0) I X'="U" D ^%DT D:X'["?" TIME1 G TIME:X["?" S LRCDT=+Y_"^" G TIME:Y'["." "RTN","LRHYPH0",110,0) Q "RTN","LRHYPH0",111,0) ; "RTN","LRHYPH0",112,0) TIME1 S X1=X,Y1=Y D TIME2 S X=X1,Y=Y1 K X1,Y1 "RTN","LRHYPH0",113,0) Q "RTN","LRHYPH0",114,0) ; "RTN","LRHYPH0",115,0) TIME2 S X="N",%DT="ST" D ^%DT Q:Y1'>Y F W !,"You have specified a collection time in the future. Are you sure" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o." "RTN","LRHYPH0",116,0) S:%'=1 X="?" S X1=X "RTN","LRHYPH0",117,0) Q "RTN","LRHYPH0",118,0) ; "RTN","LRHYPH0",119,0) ; "RTN","LRHYPH0",120,0) TASK ; "RTN","LRHYPH0",121,0) ; If traditional Howdy is used this is where labels print-control passes to GT549 "RTN","LRHYPH0",122,0) ; If alternative Howdy is used label printing is delayed. "RTN","LRHYPH0",123,0) I $G(^%ZIS(1,LRDEV,0))'["NUL" G T549 "RTN","LRHYPH0",124,0) N LRAD S LRAD=0 "RTN","LRHYPH0",125,0) N LRX,LRY "RTN","LRHYPH0",126,0) D NOW^%DTC "RTN","LRHYPH0",127,0) S LR3T=% "RTN","LRHYPH0",128,0) S LRX=0 "RTN","LRHYPH0",129,0) F S LRX=$O(LRLBL(LRX)) Q:+LRX'>0 D "RTN","LRHYPH0",130,0) . S LRY=0 "RTN","LRHYPH0",131,0) . F S LRY=$O(LRLBL(LRX,LRY)) Q:+LRY'>0 D "RTN","LRHYPH0",132,0) .. I $P(^LRO(68,LRX,0),U,3)="M" S LRAD=$E(DT,1,5)_"00" "RTN","LRHYPH0",133,0) .. I $P(^LRO(68,LRX,0),U,3)="Y" S LRAD=$E(DT,1,3)_"0000" "RTN","LRHYPH0",134,0) .. I '$G(LRAD) S LRAD=DT "RTN","LRHYPH0",135,0) .. S LRUID=$P($G(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U) I $L(LRUID)<10 D "RTN","LRHYPH0",136,0) ... S $P(LRLBL(LRX,LRY),U,7)=LRORD "RTN","LRHYPH0",137,0) ... S LRUID=$P($G(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U) "RTN","LRHYPH0",138,0) .. S ^XTMP("LRHY LABELS",LRDFN,LR3T,LRUID)=LRLBL(LRX,LRY) "RTN","LRHYPH0",139,0) .. K LRAD "RTN","LRHYPH0",140,0) I $G(^%ZIS(1,LRDEV,0))["NUL" QUIT "RTN","LRHYPH0",141,0) ; "RTN","LRHYPH0",142,0) T549 ; ADDED FOR PPOC APPROACH "RTN","LRHYPH0",143,0) S LRCE=LRORD "RTN","LRHYPH0",144,0) S LRX=0 "RTN","LRHYPH0",145,0) F S LRX=$O(LRLBL(LRX)) Q:+LRX'>0 D "RTN","LRHYPH0",146,0) . S LRY=0 "RTN","LRHYPH0",147,0) . F S LRY=$O(LRLBL(LRX,LRY)) Q:+LRY'>0 D "RTN","LRHYPH0",148,0) .. S $P(LRLBL(LRX,LRY),U,7)=LRCE "RTN","LRHYPH0",149,0) S ZTSAVE("L*")="" "RTN","LRHYPH0",150,0) I $D(LRLABLIO) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS",ZTIO=LRLABLIO,ZTSAVE("LRLBL(")="" S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD "RTN","LRHYPH0",151,0) K LRLBL "RTN","LRHYPH0",152,0) I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV "RTN","LRHYPH0",153,0) D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM "RTN","LRHYPH0",154,0) Q "RTN","LRHYPH0",155,0) ; "RTN","LRHYPH0",156,0) ; "RTN","LRHYPH0",157,0) END K DIR,DIRUT,LRHYGOT "RTN","LRHYPH0",158,0) D ^LRORDK,LROEND^LRORDK,STOP^LRCAPV "RTN","LRHYPH0",159,0) Q "RTN","LRHYPH0",160,0) ; "RTN","LRHYPH0",161,0) ; "RTN","LRHYPH0",162,0) GOT(ORD,ODT) ;See if all tests have been canceled "RTN","LRHYPH0",163,0) N LRHYI,SN,ODT "RTN","LRHYPH0",164,0) S (LRHYGOT,ODT,SN)=0 "RTN","LRHYPH0",165,0) F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 D "RTN","LRHYPH0",166,0) . S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1!(LRHYGOT) D "RTN","LRHYPH0",167,0) . . Q:'$D(^LRO(69,ODT,1,SN,0)) "RTN","LRHYPH0",168,0) . . S LRHYI=0 F S LRHYI=$O(^LRO(69,ODT,1,SN,2,LRHYI)) Q:LRHYI<1 I $D(^(LRHYI,0)),'$P(^(0),"^",11) S LRHYGOT=1 Q "RTN","LRHYPH0",169,0) Q LRHYGOT "RTN","LRHYPH0",170,0) ; "RTN","LRHYPH0",171,0) ; "RTN","LRHYPH0",172,0) UNL69 ; "RTN","LRHYPH0",173,0) L -^LRO(69,"C",+$G(LRORD)) "RTN","LRHYPH0",174,0) Q "RTN","LRHYPH0",175,0) BCE ; "RTN","LRHYPH0",176,0) S LRCE=$G(LRORD) "RTN","LRHYPH0",177,0) Q:'$D(LRLABLIO) "RTN","LRHYPH0",178,0) S ZTSAVE("L*")="" "RTN","LRHYPH0",179,0) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS" "RTN","LRHYPH0",180,0) S ZTIO=LRLABLIO "RTN","LRHYPH0",181,0) S LRDEV=LRLABLIO "RTN","LRHYPH0",182,0) S IO=LRDEV S ZTSAVE("IO*")="" "RTN","LRHYPH0",183,0) S ZTIO=$P(^%ZIS(1,+LRDEV,0),U) "RTN","LRHYPH0",184,0) D ^%ZTLOAD "RTN","LRHYPH0",185,0) K LRLBL "RTN","LRHYPH0",186,0) I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV "RTN","LRHYPH0",187,0) D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM "VER") 8.0^22.0 "BLD",9942,6) ^367 **END** **END**