Released LR*5.2*498 SEQ #413 Extracted from mail message **KIDS**:LR*5.2*498^ **INSTALL NAME** LR*5.2*498 "BLD",10746,0) LR*5.2*498^LAB SERVICE^0^3180830^y "BLD",10746,1,0) ^^4^4^3171219^^ "BLD",10746,1,1,0) This patch addresses the following one (1) VistA Laboratory issue: When a "BLD",10746,1,2,0) LEDI Host facility adds a new lab test to an accessioned order shipped "BLD",10746,1,3,0) from a Collection facility the UID is improperly assigned with the "BLD",10746,1,4,0) ordering site's UID instead of the host site's UID. "BLD",10746,4,0) ^9.64PA^^ "BLD",10746,6.3) 7 "BLD",10746,"ABPKG") n "BLD",10746,"KRN",0) ^9.67PA^779.2^20 "BLD",10746,"KRN",.4,0) .4 "BLD",10746,"KRN",.401,0) .401 "BLD",10746,"KRN",.402,0) .402 "BLD",10746,"KRN",.403,0) .403 "BLD",10746,"KRN",.5,0) .5 "BLD",10746,"KRN",.84,0) .84 "BLD",10746,"KRN",3.6,0) 3.6 "BLD",10746,"KRN",3.8,0) 3.8 "BLD",10746,"KRN",9.2,0) 9.2 "BLD",10746,"KRN",9.8,0) 9.8 "BLD",10746,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",10746,"KRN",9.8,"NM",1,0) LRCE^^0^B78811816 "BLD",10746,"KRN",9.8,"NM","B","LRCE",1) "BLD",10746,"KRN",19,0) 19 "BLD",10746,"KRN",19.1,0) 19.1 "BLD",10746,"KRN",101,0) 101 "BLD",10746,"KRN",409.61,0) 409.61 "BLD",10746,"KRN",771,0) 771 "BLD",10746,"KRN",779.2,0) 779.2 "BLD",10746,"KRN",870,0) 870 "BLD",10746,"KRN",8989.51,0) 8989.51 "BLD",10746,"KRN",8989.52,0) 8989.52 "BLD",10746,"KRN",8994,0) 8994 "BLD",10746,"KRN","B",.4,.4) "BLD",10746,"KRN","B",.401,.401) "BLD",10746,"KRN","B",.402,.402) "BLD",10746,"KRN","B",.403,.403) "BLD",10746,"KRN","B",.5,.5) "BLD",10746,"KRN","B",.84,.84) "BLD",10746,"KRN","B",3.6,3.6) "BLD",10746,"KRN","B",3.8,3.8) "BLD",10746,"KRN","B",9.2,9.2) "BLD",10746,"KRN","B",9.8,9.8) "BLD",10746,"KRN","B",19,19) "BLD",10746,"KRN","B",19.1,19.1) "BLD",10746,"KRN","B",101,101) "BLD",10746,"KRN","B",409.61,409.61) "BLD",10746,"KRN","B",771,771) "BLD",10746,"KRN","B",779.2,779.2) "BLD",10746,"KRN","B",870,870) "BLD",10746,"KRN","B",8989.51,8989.51) "BLD",10746,"KRN","B",8989.52,8989.52) "BLD",10746,"KRN","B",8994,8994) "BLD",10746,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10746,"QUES",0) ^9.62^^ "BLD",10746,"REQB",0) ^9.611^1^1 "BLD",10746,"REQB",1,0) LR*5.2*486^1 "BLD",10746,"REQB","B","LR*5.2*486",1) "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^2981028^66481 "PKG",26,22,1,"PAH",1,0) 498^3180830 "PKG",26,22,1,"PAH",1,1,0) ^^4^4^3180830 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses the following one (1) VistA Laboratory issue: When a "PKG",26,22,1,"PAH",1,1,2,0) LEDI Host facility adds a new lab test to an accessioned order shipped "PKG",26,22,1,"PAH",1,1,3,0) from a Collection facility the UID is improperly assigned with the "PKG",26,22,1,"PAH",1,1,4,0) ordering site's UID instead of the host site's UID. "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") 1 "RTN","LRCE") 0^1^B78811816^B75653138 "RTN","LRCE",1,0) LRCE ;DALOI/JMC - LOOK-UP ON CENTRAL ENTRY # ; 12/20/17 8:51am "RTN","LRCE",2,0) ;;5.2;LAB SERVICE;**28,76,103,121,153,210,202,263,350,416,486,498**;Sep 27, 1994;Build 7 "RTN","LRCE",3,0) ; "RTN","LRCE",4,0) EN ; "RTN","LRCE",5,0) N CAN,ORD "RTN","LRCE",6,0) S (LRSTOP,LRFLAG1,LRFLG,LRSN1,LRNOP)=0 "RTN","LRCE",7,0) K DIRUT,SSN,LRORD "RTN","LRCE",8,0) W !! "RTN","LRCE",9,0) S DIR("A")="Order Number or UID: ",DIR(0)="FOA" "RTN","LRCE",10,0) S DIR("?",1)="Enter a whole number for the order number, enter the universal identifier" "RTN","LRCE",11,0) S DIR("?",2)="(UID), or press Return to find the order number by Patient.",DIR("?")="Enter '^' to Exit." "RTN","LRCE",12,0) D ^DIR "RTN","LRCE",13,0) I $G(SSN)&(Y="") G END "RTN","LRCE",14,0) I Y="" D ^LROS G:'$G(SSN) END G EN "RTN","LRCE",15,0) NEXT I $D(DIRUT) G END "RTN","LRCE",16,0) D UNIV "RTN","LRCE",17,0) S LRORD=+Y "RTN","LRCE",18,0) I LRORD?.AP!(LRORD<1) D G EN "RTN","LRCE",19,0) . W !,"Enter a whole number for the order number." "RTN","LRCE",20,0) S LRORD=+LRORD "RTN","LRCE",21,0) K DIR,X,Y,DIRUT "RTN","LRCE",22,0) IF $O(^LRO(69,"C",LRORD,0))<1 W " NUMBER NOT FOUND" G LRCE "RTN","LRCE",23,0) I $D(LRADDTST),$$CAN(LRORD) D G EN "RTN","LRCE",24,0) . W !!,?5,"This order has been canceled." "RTN","LRCE",25,0) . W !,?5,"Tests WILL NOT be added. A new order must be placed." "RTN","LRCE",26,0) DIS ; "RTN","LRCE",27,0) W @IOF "RTN","LRCE",28,0) I $D(LRADDTST) D "RTN","LRCE",29,0) . W !!?15,"LISTING OF DATES " "RTN","LRCE",30,0) . S (CNT,LRODT)=0 "RTN","LRCE",31,0) . F A=0:0 S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT="" D "RTN","LRCE",32,0) .. D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",33,0) .. S CNT=CNT+1 "RTN","LRCE",34,0) .. W !?5,CNT,?10,$$FMTE^XLFDT(LRODT,"5FM") "RTN","LRCE",35,0) Q:$G(LRSTOP) K CNT,A "RTN","LRCE",36,0) S LRODT=0 "RTN","LRCE",37,0) F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1!($G(LRSTOP)) D I $D(LRADDTST),+LRADDTST Q "RTN","LRCE",38,0) . D LR2 "RTN","LRCE",39,0) I $D(LRADDTST) G LRCE:LRADDTST="" G END "RTN","LRCE",40,0) I '$D(LRADDTST) G EN "RTN","LRCE",41,0) Q "RTN","LRCE",42,0) ; "RTN","LRCE",43,0) CAN(ORD) ;See if all tests have been canceled "RTN","LRCE",44,0) N I,SN,ODT,LRSTR "RTN","LRCE",45,0) S (CAN,ODT,SN)=1 "RTN","LRCE",46,0) F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 D "RTN","LRCE",47,0) . S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1!('CAN) D "RTN","LRCE",48,0) . . Q:'$D(^LRO(69,ODT,1,SN,0)) "RTN","LRCE",49,0) . . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,I)) Q:I<1 Q:'CAN D "RTN","LRCE",50,0) . . . S LRSTR=$G(^LRO(69,ODT,1,SN,2,I,0)) Q:LRSTR="" "RTN","LRCE",51,0) . . . ;check for "canceled by" and "canceled" status "RTN","LRCE",52,0) . . . I '$P(LRSTR,"^",11),$P(LRSTR,U,9)'="CA" S CAN=0 "RTN","LRCE",53,0) Q CAN "RTN","LRCE",54,0) ; "RTN","LRCE",55,0) ADDTST ; "RTN","LRCE",56,0) N LRADDTST "RTN","LRCE",57,0) S LRADDTST="" D EN "RTN","LRCE",58,0) S LRRSTAT=160 "RTN","LRCE",59,0) I LRADDTST D ^LRORD "RTN","LRCE",60,0) D END,ADDEND "RTN","LRCE",61,0) Q "RTN","LRCE",62,0) ; "RTN","LRCE",63,0) ; "RTN","LRCE",64,0) ADDEND ; "RTN","LRCE",65,0) K LRCLCTR,LRCLST,LRDFN,LRDPF,LRDRWTM,LRFLAG1,LRFLG "RTN","LRCE",66,0) K LRLLOC,LRLOC,LRODT,LROLLOC,LRORDRR,LRPRAC,LRRB "RTN","LRCE",67,0) K LRRSITE,LRSD,LRDN,LRSTOP,LRTREA,LRSN,LRTSN,LRTSP,PNM,SSN,DOB,SEX "RTN","LRCE",68,0) K TYPE,LRRSTAT,LRNOP,LRSN1 "RTN","LRCE",69,0) K X,Y,I "RTN","LRCE",70,0) Q "RTN","LRCE",71,0) ; "RTN","LRCE",72,0) ; "RTN","LRCE",73,0) LR2 ; "RTN","LRCE",74,0) Q:$G(LRSTOP) "RTN","LRCE",75,0) D CHKPAGE "RTN","LRCE",76,0) Q:$G(LRSTOP) "RTN","LRCE",77,0) S LRSN=0 "RTN","LRCE",78,0) F S LRSN=+$O(^LRO(69,"C",+$G(LRORD),+$G(LRODT),LRSN)) Q:LRSN<1!($G(LRSTOP)) D PT I $D(LRADDTST),+LRADDTST Q "RTN","LRCE",79,0) Q "RTN","LRCE",80,0) ; "RTN","LRCE",81,0) ; "RTN","LRCE",82,0) UNIV ; see if entry is UID "RTN","LRCE",83,0) N LRAA,LRAD,LRAN I $D(^LRO(68,"C",X)) S LRAA=$O(^LRO(68,"C",X,0)) I LRAA S LRAD=$O(^LRO(68,"C",X,LRAA,0)) I LRAD S LRAN=$O(^LRO(68,"C",X,LRAA,LRAD,0)) I LRAN S Y=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^") "RTN","LRCE",84,0) Q "RTN","LRCE",85,0) ; "RTN","LRCE",86,0) ; "RTN","LRCE",87,0) CHKPAGE ; "RTN","LRCE",88,0) Q:$G(LRSTOP) "RTN","LRCE",89,0) Q:$Y<(IOSL-2) "RTN","LRCE",90,0) K DIR "RTN","LRCE",91,0) S DIR(0)="E" "RTN","LRCE",92,0) D ^DIR "RTN","LRCE",93,0) I $D(DUOUT)!($D(DIRUT)) S LRSTOP=1 Q "RTN","LRCE",94,0) W @IOF "RTN","LRCE",95,0) W ! "RTN","LRCE",96,0) Q "RTN","LRCE",97,0) ; "RTN","LRCE",98,0) ; "RTN","LRCE",99,0) PT ; "RTN","LRCE",100,0) D CHKPAGE "RTN","LRCE",101,0) Q:$G(LRSTOP)!($G(LRFLG)) "RTN","LRCE",102,0) S LROR=$S($D(^LRO(69,LRODT,1,LRSN,0)):^(0),1:-1) "RTN","LRCE",103,0) S LRDFN=+LROR "RTN","LRCE",104,0) I LRDFN<1 W " NO PATIENT" Q "RTN","LRCE",105,0) S LRWHOE=+$P(LROR,U,2) "RTN","LRCE",106,0) S LRWHOE=$S($D(^VA(200,LRWHOE,0)):$P(^(0),U),1:"") "RTN","LRCE",107,0) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) "RTN","LRCE",108,0) D PT^LRX "RTN","LRCE",109,0) H 1 "RTN","LRCE",110,0) HEAD ; "RTN","LRCE",111,0) D CHKPAGE "RTN","LRCE",112,0) Q:$G(LRSTOP) "RTN","LRCE",113,0) W !!,"ORDER #: ",LRORD,?20,"PAT: ",PNM," SSN: ",SSN,! "RTN","LRCE",114,0) D CHKPAGE "RTN","LRCE",115,0) Q:$G(LRSTOP) "RTN","LRCE",116,0) D LRGLIN^LRX "RTN","LRCE",117,0) W ! "RTN","LRCE",118,0) S LRCTYP=$P(LROR,U,4) "RTN","LRCE",119,0) I (LRWHOE'="")!(LRCTYP'="") D "RTN","LRCE",120,0) . I LRWHOE'="" W "WHO ENTERED: ",$E(LRWHOE,1,25) K LRWHOE "RTN","LRCE",121,0) . W:LRCTYP'="" ?40,"TYPE OF COLLECTION: ",LRCTYP "RTN","LRCE",122,0) I $D(^LRO(69,LRODT,1,LRSN,1)) D "RTN","LRCE",123,0) . S LRCLCTR=$P(^LRO(69,LRODT,1,LRSN,1),U,3),LRCLST=$P(^(1),U,4) "RTN","LRCE",124,0) . S:LRCLCTR'="" LRCLCTR=$P($G(^VA(200,+LRCLCTR,0)),U) "RTN","LRCE",125,0) . W ! D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",126,0) . W:LRCLCTR'="" " COLLECTOR : ",$E(LRCLCTR,1,25) "RTN","LRCE",127,0) . W:LRCLST'="" ?40,"COLLECTION STATUS: ",LRCLST "RTN","LRCE",128,0) Q:$G(LRSTOP) "RTN","LRCE",129,0) ; "RTN","LRCE",130,0) S LRDRWTM=$S($D(^LRO(69,LRODT,1,LRSN,1)):+^(1),1:"") "RTN","LRCE",131,0) S:LRDRWTM LRDRWTM=$$FMTE^XLFDT(LRDRWTM,"ZM") "RTN","LRCE",132,0) S LRLOC=+$P(LROR,U,9),LRLOC=$P($G(^SC(LRLOC,0)),U) "RTN","LRCE",133,0) I (LRDRWTM'="")!(LRLOC'="") D "RTN","LRCE",134,0) . W ! D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",135,0) . W:LRDRWTM'="" " DRAW TIME: ",LRDRWTM "RTN","LRCE",136,0) . I LRDRWTM="",$P(LROR,"^",8) W "TO BE DRAWN: ",$$FMTE^XLFDT($P(LROR,U,8),"ZM") "RTN","LRCE",137,0) . W:LRLOC'="" ?40,"ORDERING LOCATION: ",$E(LRLOC,1,20) "RTN","LRCE",138,0) Q:$G(LRSTOP) "RTN","LRCE",139,0) ; "RTN","LRCE",140,0) W ! D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",141,0) I $G(^LRO(69,LRODT,1,LRSN,3)) W " LAB ARRIVAL: ",$$FMTE^XLFDT(+$G(^(3)),"ZM") "RTN","LRCE",142,0) I LRDPF=2 W:LRWRD'="" ?40,"WARD: ",LRWRD "RTN","LRCE",143,0) W:$P(LROR,U,3) !," SPECIMEN: " D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",144,0) W:$P(LROR,U,3) $S($D(^LAB(62,$P(LROR,U,3),0)):$P(^(0),U),1:"??") "RTN","LRCE",145,0) S L=+$P(^LRO(69,LRODT,1,LRSN,0),U,6) I L D "RTN","LRCE",146,0) . S LRMD=$S($D(^VA(200,L,0)):$P(^(0),U),1:L) "RTN","LRCE",147,0) . W ?40,"PROVIDER: ",$E(LRMD,1,30) "RTN","LRCE",148,0) W:$G(^LRO(69,LRODT,1,LRSN,"PCE")) !,?5,"Visit Number(s): ",$G(^("PCE")) "RTN","LRCE",149,0) ; "RTN","LRCE",150,0) S I=0 "RTN","LRCE",151,0) TST D CHKPAGE "RTN","LRCE",152,0) Q:$G(LRSTOP) "RTN","LRCE",153,0) F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 D "RTN","LRCE",154,0) . D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",155,0) . S LRNOPMSG=0 "RTN","LRCE",156,0) . D TEST D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",157,0) D CHKPAGE "RTN","LRCE",158,0) Q:$G(LRSTOP) "RTN","LRCE",159,0) I $D(^LRO(69,LRODT,1,LRSN,1)),$L($P(^(1),U,6)) D "RTN","LRCE",160,0) . W !,"COMMENT: ",$P(^LRO(69,LRODT,1,LRSN,1),U,6) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",161,0) S I=0 "RTN","LRCE",162,0) F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !,?3,^(I,0) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",163,0) Q:$G(LRSTOP) "RTN","LRCE",164,0) NXT S X=$P($G(^LRO(69,LRODT,1,LRSN,1)),U,4) "RTN","LRCE",165,0) I X="C"!($G(LRNOPMSG)) W !,"Order has already been accessioned." "RTN","LRCE",166,0) I LRNOP,'$D(LRLABKY) D Q "RTN","LRCE",167,0) . I $G(LRNOPMSG) W !,"Tests have been accessioned, call the lab to add tests to the same order." "RTN","LRCE",168,0) I '$D(LRADDTST) Q "RTN","LRCE",169,0) I X="M" W !?5,"This Order was Merged " Q "RTN","LRCE",170,0) I '$G(LRRSTAT) S LRRSTAT=160 "RTN","LRCE",171,0) SEL W !,"Is this the one" "RTN","LRCE",172,0) S %=1,LRNOP=0 K LRORDRR,LRRSITE,LRSD,LRTSP "RTN","LRCE",173,0) D YN^DICN "RTN","LRCE",174,0) I %'=1 S (LRFLG1,LRNOP)=0 Q "RTN","LRCE",175,0) S LRADDTST=$S(%=1:LRORD,1:"") "RTN","LRCE",176,0) Q:$G(LRSTOP)!('$G(LRADDTST)) "RTN","LRCE",177,0) I %=1 D "RTN","LRCE",178,0) . N X,X0,I,DIC,DA "RTN","LRCE",179,0) . S X0=^LRO(69,LRODT,1,LRSN,0),LRLWC=$P(X0,"^",4) "RTN","LRCE",180,0) . S LRFLG=1 "RTN","LRCE",181,0) . S LRPRAC=$P(X0,"^",6),LRLLOC=$P(X0,"^",7),LROLLOC=$P(X0,U,9) "RTN","LRCE",182,0) . Q:LRLWC'="R" S LRRSITE("SDT")=$P(X0,U,5) "RTN","LRCE",183,0) . S DIC("A")="*Select Original Ordered Test " "RTN","LRCE",184,0) . S DA=LRSN,DA(1)=LRODT,DIC("S")="I $G(^(.3))" "RTN","LRCE",185,0) . S DIC="^LRO(69,"_LRODT_",1,"_LRSN_",2,",DIC(0)="AQEZNM" "RTN","LRCE",186,0) . D ^DIC I Y<1 S LRADDTST="" Q "RTN","LRCE",187,0) . S LRTSP=$P(Y,U,2),X=$G(^LRO(69,LRODT,1,LRSN,2,+Y,.3)) "RTN","LRCE",188,0) . Q:'$P(X,U,2) S (LRSD("RPSITE"),LRRSITE("RSITE"))=$P(X,U,2)_U_$P(^LRO(69,LRODT,1,LRSN,0),U,7) "RTN","LRCE",189,0) . S LRRSITE("RPSITE")=$P(X,U,3) "RTN","LRCE",190,0) . S LRSD("RUID")=$P(X,U,5) "RTN","LRCE",191,0) . ;LRRSITE("IDTYPE") needs to be set so that "RTN","LRCE",192,0) . ;all UID fields are set correctly in file 69 "RTN","LRCE",193,0) . ;see SET3^LRX (line below added in LR*5.2*498) "RTN","LRCE",194,0) . S LRRSITE("IDTYPE")=1 "RTN","LRCE",195,0) . S LRORDRR="R" "RTN","LRCE",196,0) Q "RTN","LRCE",197,0) ; "RTN","LRCE",198,0) ; "RTN","LRCE",199,0) LUPT ; "RTN","LRCE",200,0) K DFN,DIC S DIC(0)="EMQ" "RTN","LRCE",201,0) D ^LRDPA "RTN","LRCE",202,0) Q:DFN<1!$D(DUOUT) "RTN","LRCE",203,0) ; "RTN","LRCE",204,0) LU1 ; "RTN","LRCE",205,0) W !,"Order date to start from: T//" R X:DTIME "RTN","LRCE",206,0) I '$T!(X["^") QUIT "RTN","LRCE",207,0) S %DT="E",X=$S(X="":"T",1:X) "RTN","LRCE",208,0) D ^%DT "RTN","LRCE",209,0) G:Y<1 LU1 S Y=Y-1 "RTN","LRCE",210,0) S LRODT=Y F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT<1 D FSN "RTN","LRCE",211,0) Q "RTN","LRCE",212,0) ; "RTN","LRCE",213,0) ; "RTN","LRCE",214,0) FSN ; "RTN","LRCE",215,0) S LRSN=0 "RTN","LRCE",216,0) F S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D "RTN","LRCE",217,0) . Q:'$D(^LRO(69,LRODT,1,LRSN,.1)) S LRORD=+^(.1) D PT "RTN","LRCE",218,0) Q "RTN","LRCE",219,0) ; "RTN","LRCE",220,0) ; "RTN","LRCE",221,0) TEST ; "RTN","LRCE",222,0) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",223,0) S X=^LRO(69,LRODT,1,LRSN,2,I,0) S:$P(^(0),U,3) (LRNOP,LRNOPMSG)=1 "RTN","LRCE",224,0) W !," TEST: ",$S($D(^LAB(60,+X,0)):$P(^(0),"^"),1:"UNKNOWN"),?28," " "RTN","LRCE",225,0) S LRURG=+$P(X,U,2) "RTN","LRCE",226,0) W $E($S($D(^LAB(62.05,LRURG,0)):$P(^(0),U),1:"ROUTINE"),1,15) "RTN","LRCE",227,0) W ?38," ",$S($D(^LRO(68,+$P(X,"^",4),0)):$P(^(0),"^"),1:""),?50," ",$P(X,"^",5),?55 "RTN","LRCE",228,0) ; "RTN","LRCE",229,0) D REF "RTN","LRCE",230,0) I $P(X,"^",11) D "RTN","LRCE",231,0) . W !?3,"Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^") S I(2)=0 "RTN","LRCE",232,0) . F S I(2)=$O(^LRO(69,LRODT,1,LRSN,2,I,1.1,I(2))) Q:I(2)<1 I $D(^(I(2),0)) W !?5,^(0) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",233,0) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",234,0) ; "RTN","LRCE",235,0) S I(2)=0 "RTN","LRCE",236,0) F S I(2)=$O(^LRO(69,LRODT,1,LRSN,2,I,1,I(2))) Q:I(2)<1 I $D(^(I(2),0)) W !?5,^(0) D CHKPAGE Q:$G(LRSTOP) "RTN","LRCE",237,0) Q "RTN","LRCE",238,0) ; "RTN","LRCE",239,0) ; "RTN","LRCE",240,0) REF ; If referred test, display status and manifest "RTN","LRCE",241,0) N LREVNT,LRSCFG,LRUID "RTN","LRCE",242,0) ; "RTN","LRCE",243,0) S LRUID=$P($G(^LRO(69,LRODT,1,LRSN,2,I,.3)),"^") "RTN","LRCE",244,0) I LRUID="" Q "RTN","LRCE",245,0) ; "RTN","LRCE",246,0) W " <"_LRUID_">" "RTN","LRCE",247,0) ; "RTN","LRCE",248,0) S LREVNT=$$STATUS^LREVENT(LRUID,+X,""),LRSCFG="" "RTN","LRCE",249,0) I LREVNT="" Q "RTN","LRCE",250,0) I $P(LREVNT,"^",3)'="" D "RTN","LRCE",251,0) . N LR628 "RTN","LRCE",252,0) . S LR628=$O(^LAHM(62.8,"B",$P(LREVNT,"^",3),0)) "RTN","LRCE",253,0) . S LRSCFG=$P($G(^LAHM(62.8,LR628,0)),"^",2) "RTN","LRCE",254,0) . I LRSCFG S LRSCFG(0)=$P($G(^LAHM(62.9,LRSCFG,0),"Unknown/deleted"),"^") "RTN","LRCE",255,0) W !,?4,"REFERRAL STATUS: "_$P(LREVNT,"^")_" ("_$P(LREVNT,"^",2)_")" "RTN","LRCE",256,0) W !,?4,"SHIPPING MANIFEST: "_$P(LREVNT,"^",3) "RTN","LRCE",257,0) I LRSCFG W " using shipping config "_LRSCFG(0) "RTN","LRCE",258,0) ; "RTN","LRCE",259,0) Q "RTN","LRCE",260,0) ; "RTN","LRCE",261,0) ; "RTN","LRCE",262,0) END ; "RTN","LRCE",263,0) K %,%DT,A,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,I,II,K,L,LRARIV,LRCLCTR,LRCLST "RTN","LRCE",264,0) K LRCTYP,LRDRWTM,LRFLAG1,LRFLG,LRLOC,LRMD,LRODT,LROR,LRORD "RTN","LRCE",265,0) K LRPRAC,LRSN,LRSN1,LRSTOP,LRURG,LRW,LRWHOE,LRWRD,VA("BID"),VA("PID") "RTN","LRCE",266,0) K VAIN,VADM,VAERR,X,X1,X2,Y,Z "RTN","LRCE",267,0) Q:$G(LR2ORD) "RTN","LRCE",268,0) K LRNOP,LRNOPMSG "RTN","LRCE",269,0) Q "VER") 8.0^22.2 "BLD",10746,6) ^413 **END** **END**