Released LR*5.2*499 SEQ #411 Extracted from mail message **KIDS**:LR*5.2*499^ **INSTALL NAME** LR*5.2*499 "BLD",10761,0) LR*5.2*499^LAB SERVICE^0^3171220^y "BLD",10761,1,0) ^^4^4^3171115^ "BLD",10761,1,1,0) This patch addresses two (2) VistA Laboratory issues related to accession "BLD",10761,1,2,0) labels being skipped or the printing process generating duplicate labels "BLD",10761,1,3,0) endlessly as well as results being verified when the user has no initials "BLD",10761,1,4,0) on file in the New Person (#200) file. "BLD",10761,4,0) ^9.64PA^^ "BLD",10761,6.3) 2 "BLD",10761,"KRN",0) ^9.67PA^779.2^20 "BLD",10761,"KRN",.4,0) .4 "BLD",10761,"KRN",.401,0) .401 "BLD",10761,"KRN",.402,0) .402 "BLD",10761,"KRN",.403,0) .403 "BLD",10761,"KRN",.5,0) .5 "BLD",10761,"KRN",.84,0) .84 "BLD",10761,"KRN",3.6,0) 3.6 "BLD",10761,"KRN",3.8,0) 3.8 "BLD",10761,"KRN",9.2,0) 9.2 "BLD",10761,"KRN",9.8,0) 9.8 "BLD",10761,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",10761,"KRN",9.8,"NM",1,0) LRLABXOL^^0^B5325882 "BLD",10761,"KRN",9.8,"NM",2,0) LRVER3^^0^B75975061 "BLD",10761,"KRN",9.8,"NM",3,0) LRVR3^^0^B108508518 "BLD",10761,"KRN",9.8,"NM","B","LRLABXOL",1) "BLD",10761,"KRN",9.8,"NM","B","LRVER3",2) "BLD",10761,"KRN",9.8,"NM","B","LRVR3",3) "BLD",10761,"KRN",19,0) 19 "BLD",10761,"KRN",19.1,0) 19.1 "BLD",10761,"KRN",101,0) 101 "BLD",10761,"KRN",409.61,0) 409.61 "BLD",10761,"KRN",771,0) 771 "BLD",10761,"KRN",779.2,0) 779.2 "BLD",10761,"KRN",870,0) 870 "BLD",10761,"KRN",8989.51,0) 8989.51 "BLD",10761,"KRN",8989.52,0) 8989.52 "BLD",10761,"KRN",8994,0) 8994 "BLD",10761,"KRN","B",.4,.4) "BLD",10761,"KRN","B",.401,.401) "BLD",10761,"KRN","B",.402,.402) "BLD",10761,"KRN","B",.403,.403) "BLD",10761,"KRN","B",.5,.5) "BLD",10761,"KRN","B",.84,.84) "BLD",10761,"KRN","B",3.6,3.6) "BLD",10761,"KRN","B",3.8,3.8) "BLD",10761,"KRN","B",9.2,9.2) "BLD",10761,"KRN","B",9.8,9.8) "BLD",10761,"KRN","B",19,19) "BLD",10761,"KRN","B",19.1,19.1) "BLD",10761,"KRN","B",101,101) "BLD",10761,"KRN","B",409.61,409.61) "BLD",10761,"KRN","B",771,771) "BLD",10761,"KRN","B",779.2,779.2) "BLD",10761,"KRN","B",870,870) "BLD",10761,"KRN","B",8989.51,8989.51) "BLD",10761,"KRN","B",8989.52,8989.52) "BLD",10761,"KRN","B",8994,8994) "BLD",10761,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10761,"QUES",0) ^9.62^^ "BLD",10761,"REQB",0) ^9.611^3^3 "BLD",10761,"REQB",1,0) LR*5.2*458^2 "BLD",10761,"REQB",2,0) LR*5.2*461^2 "BLD",10761,"REQB",3,0) LR*5.2*161^2 "BLD",10761,"REQB","B","LR*5.2*161",3) "BLD",10761,"REQB","B","LR*5.2*458",1) "BLD",10761,"REQB","B","LR*5.2*461",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^^ "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) 499^3171220 "PKG",26,22,1,"PAH",1,1,0) ^^4^4^3171220 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses two (2) VistA Laboratory issues related to accession "PKG",26,22,1,"PAH",1,1,2,0) labels being skipped or the printing process generating duplicate labels "PKG",26,22,1,"PAH",1,1,3,0) endlessly as well as results being verified when the user has no initials "PKG",26,22,1,"PAH",1,1,4,0) on file in the New Person (#200) file. "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") 3 "RTN","LRLABXOL") 0^1^B5325882^B5111104 "RTN","LRLABXOL",1,0) LRLABXOL ;RVAMC/PLS/DALISC/FHS - REPRINT ACCESSION LABELS FOR ENTIRE ORDER ; 5/19/93 07:40 "RTN","LRLABXOL",2,0) ;;5.2;LAB SERVICE;**11,121,161,499**;Sep 27, 1994;Build 2 "RTN","LRLABXOL",3,0) ; Will print all the required labels for a entire order. "RTN","LRLABXOL",4,0) EN K ZTSK "RTN","LRLABXOL",5,0) D IOCHK^LRLABXT G END:'$D(LRLABLIO) "RTN","LRLABXOL",6,0) D PSET^LRLABLD "RTN","LRLABXOL",7,0) S LRHDR="Select Order Number: " "RTN","LRLABXOL",8,0) 1 U IO(0) "RTN","LRLABXOL",9,0) W !!,LRHDR R LRORD:DTIME G:'$T END G:(LRORD="")!(LRORD="^") END I LRORD?.AP!(LRORD<1) W !,"Enter a whole number for the order number." G 1 "RTN","LRLABXOL",10,0) S LRORD=+LRORD "RTN","LRLABXOL",11,0) S LRODT=$O(^LRO(69,"C",LRORD,0)) "RTN","LRLABXOL",12,0) I +LRODT<1 W " ORDER NUMBER NOT FOUND" G 1 "RTN","LRLABXOL",13,0) I '$$GOT^LROE(LRORD,LRODT) W !!,"All tests for this order have been canceled." H 1 G 1 "RTN","LRLABXOL",14,0) I $D(LRLABLIO("Q")) D G END "RTN","LRLABXOL",15,0) . S ZTIO=LRLABLIO,ZTRTN="QUE^LRLABXOL",ZTDESC="LAB ORDER LABELS",ZTSAVE("LR*")="" "RTN","LRLABXOL",16,0) . D ^%ZTLOAD "RTN","LRLABXOL",17,0) . W !,"Labels have been tasked to print ",! "RTN","LRLABXOL",18,0) D QUE "RTN","LRLABXOL",19,0) K LRORD "RTN","LRLABXOL",20,0) U IO(0) W !?10,"Label(s) Printed",! S LRHDR="Another Order Number: " "RTN","LRLABXOL",21,0) G 1 "RTN","LRLABXOL",22,0) ; "RTN","LRLABXOL",23,0) QUE ; "RTN","LRLABXOL",24,0) S LRODT=0 "RTN","LRLABXOL",25,0) F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D 2,PRINT "RTN","LRLABXOL",26,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","LRLABXOL",27,0) Q "RTN","LRLABXOL",28,0) ; "RTN","LRLABXOL",29,0) 2 ; "RTN","LRLABXOL",30,0) S LRSN=0 "RTN","LRLABXOL",31,0) F S LRSN=+$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 D SQ "RTN","LRLABXOL",32,0) Q "RTN","LRLABXOL",33,0) ; "RTN","LRLABXOL",34,0) SQ ; Search for accession numbers and build LRORD array 'ORD #(SEQ #,ACC AREA,ACC DATE, ACC #)=""' "RTN","LRLABXOL",35,0) Q:'$D(^LRO(69,LRODT,1,LRSN,2,0)) "RTN","LRLABXOL",36,0) S SEQ=0 "RTN","LRLABXOL",37,0) F S SEQ=+$O(^LRO(69,LRODT,1,LRSN,2,SEQ)) Q:SEQ<1 D "RTN","LRLABXOL",38,0) . S X=$G(^LRO(69,LRODT,1,LRSN,2,SEQ,0)),LRAD=$P(X,U,3),LRAA=$P(X,U,4),LRAN=$P(X,U,5) "RTN","LRLABXOL",39,0) . I LRAA,LRAD,LRAN S LRORD(LRSN,LRAA,LRAD,LRAN)="" "RTN","LRLABXOL",40,0) Q "RTN","LRLABXOL",41,0) ; "RTN","LRLABXOL",42,0) PRINT ; Loop thru array and print labels. "RTN","LRLABXOL",43,0) U IO N LRSODT "RTN","LRLABXOL",44,0) S LRAA="" "RTN","LRLABXOL",45,0) F S LRX=$Q(LRORD) Q:LRX="" Q:$QS(LRX,0)'="LRORD" D "RTN","LRLABXOL",46,0) . S LRSN=$QS(LRX,1) "RTN","LRLABXOL",47,0) . I LRAA'=$QS(LRX,2) S LRAA=$QS(LRX,2) D LBLTYP^LRLABLD "RTN","LRLABXOL",48,0) . S LRAD=$QS(LRX,3),LRAN=$QS(LRX,4) "RTN","LRLABXOL",49,0) . K LRORD(LRSN,LRAA,LRAD,LRAN) "RTN","LRLABXOL",50,0) . N LRORD,LRX "RTN","LRLABXOL",51,0) . S LRSODT=LRODT D PRINT^LRLABXT S LRODT=LRSODT "RTN","LRLABXOL",52,0) Q "RTN","LRLABXOL",53,0) ; "RTN","LRLABXOL",54,0) END ; "RTN","LRLABXOL",55,0) K LRHDR,LRORD,SEQ,ZTSK "RTN","LRLABXOL",56,0) D K^LRLABXT "RTN","LRLABXOL",57,0) Q "RTN","LRVER3") 0^2^B75975061^B75852172 "RTN","LRVER3",1,0) LRVER3 ;DALOI/STAFF - DATA VERIFICATION ;05/10/11 13:50 "RTN","LRVER3",2,0) ;;5.2;LAB SERVICE;**42,100,121,140,171,153,221,286,291,406,350,461,499**;Sep 27, 1994;Build 2 "RTN","LRVER3",3,0) ; "RTN","LRVER3",4,0) D V1 "RTN","LRVER3",5,0) I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER "RTN","LRVER3",6,0) Q "RTN","LRVER3",7,0) ; "RTN","LRVER3",8,0) ; "RTN","LRVER3",9,0) V1 ; "RTN","LRVER3",10,0) ; "RTN","LRVER3",11,0) I $D(LRLOCKER)#2 L -@(LRLOCKER) "RTN","LRVER3",12,0) S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")" "RTN","LRVER3",13,0) D LOCK^DILF(LRLOCKER) ; L +@(LRLOCKER):DILOCKTM "RTN","LRVER3",14,0) I '$T W !," This entry is being edited by someone else." Q "RTN","LRVER3",15,0) ; "RTN","LRVER3",16,0) I $D(LRGVP) S X="1-"_LRNTN D RANGE^LRWU2 G L10 "RTN","LRVER3",17,0) S LRALL="",LRALERT=LROUTINE,LRLCT=6 "RTN","LRVER3",18,0) ; "RTN","LRVER3",19,0) ; List any not performed or merged tests. "RTN","LRVER3",20,0) S I=0 "RTN","LRVER3",21,0) F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 D "RTN","LRVER3",22,0) . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)) "RTN","LRVER3",23,0) . I $P(LRX,"^",6)'="*Not Performed",$P(LRX,"^",6)'="*Merged" Q "RTN","LRVER3",24,0) . W !,?3,$P(^LAB(60,I,0),"^"),?25," ",$P(LRX,"^",6) "RTN","LRVER3",25,0) . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4 "RTN","LRVER3",26,0) ; "RTN","LRVER3",27,0) ; No tests to edit "RTN","LRVER3",28,0) I LRNTN=0 D COM^LRVR4 G EXIT "RTN","LRVER3",29,0) ; "RTN","LRVER3",30,0) F I=1:1:LRNTN I $D(LRNAME(I)) D "RTN","LRVER3",31,0) . S LRALL=LRALL_","_I W !,I," ",LRNAME(I) "RTN","LRVER3",32,0) . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0))#2 D "RTN","LRVER3",33,0) . . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0) "RTN","LRVER3",34,0) . . S LRAL=$P(LRX,U,2)#50 "RTN","LRVER3",35,0) . . I $P(LRX,U,5) W ?25,$S($P(LRX,U,6)'="":$P(LRX,U,6),1:" verified") "RTN","LRVER3",36,0) . . I LRAL S LRALERT=$S(LRAL22 WT^LRVER4 "RTN","LRVER3",38,0) ; "RTN","LRVER3",39,0) I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D "RTN","LRVER3",40,0) . W !?15 W:IOST["C-" @LRVIDO "RTN","LRVER3",41,0) . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U) "RTN","LRVER3",42,0) . W:IOST["C-" @LRVIDOF W !,$C(7) "RTN","LRVER3",43,0) ; "RTN","LRVER3",44,0) S X9="" I LRNTN=1 S T1=1 G L10 "RTN","LRVER3",45,0) V9 S LRALL=$P(LRALL,",",2,99) "RTN","LRVER3",46,0) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X["A" X=LRALL "RTN","LRVER3",47,0) I X["?" W !,"Enter for example 1,2,5-9." G V9 "RTN","LRVER3",48,0) Q:X[U!(X="") D RANGE^LRWU2 G EXIT:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") G EXIT:X=0 "RTN","LRVER3",49,0) ; "RTN","LRVER3",50,0) L10 ; "RTN","LRVER3",51,0) N LRCORECT S LRCORECT=0 "RTN","LRVER3",52,0) S LRNX=0 X (X9_"D EX1^LRVER1") "RTN","LRVER3",53,0) ; "RTN","LRVER3",54,0) ; Calculate days back for delta check based on specimen collection date/time. "RTN","LRVER3",55,0) S LRTM60=$$LRTM60^LRVR(LRCDT) "RTN","LRVER3",56,0) D V7^LRVER2 "RTN","LRVER3",57,0) ; "RTN","LRVER3",58,0) S LRCMTDSP=$$CHKCDSP^LRVERA "RTN","LRVER3",59,0) K LRSA,LRSB,LRORU3 "RTN","LRVER3",60,0) F LRSB=1:0 S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:LRSB<1 D "RTN","LRVER3",61,0) . S LRSB(LRSB)=^(LRSB),LRSB(LRSB,"P")=$P(LRSB(LRSB),U,3) "RTN","LRVER3",62,0) . I $D(LRNOVER) S LRNOVER(LRSB)="" "RTN","LRVER3",63,0) S LREDIT=1 "RTN","LRVER3",64,0) D ^LRVER4 "RTN","LRVER3",65,0) ; "RTN","LRVER3",66,0) ; If group data review then quit before updating results "RTN","LRVER3",67,0) I $D(LRGVP) G EXIT "RTN","LRVER3",68,0) ; "RTN","LRVER3",69,0) I '$O(LRORD(0)) G EXIT "RTN","LRVER3",70,0) ; "RTN","LRVER3",71,0) ; Set reporting site in file #63. "RTN","LRVER3",72,0) D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2)) "RTN","LRVER3",73,0) ; "RTN","LRVER3",74,0) I '$G(LRCHG),'LRVF D "RTN","LRVER3",75,0) . N LRNOW S LRNOW=$$NOW^XLFDT "RTN","LRVER3",76,0) . F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 I $P(LRSB(LRSB),"^")'="" D "RTN","LRVER3",77,0) . . S $P(LRSB(LRSB),U,6)=LRNOW "RTN","LRVER3",78,0) . . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB) "RTN","LRVER3",79,0) ; "RTN","LRVER3",80,0) I $G(LRCHG) D CHG K LRCHG,LRUP I $G(LREND) S LREND=0 D ASKXQA,EXIT Q "RTN","LRVER3",81,0) ; "RTN","LRVER3",82,0) I $D(LRSA),$D(LRF) D Q "RTN","LRVER3",83,0) . K LRF "RTN","LRVER3",84,0) . S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,9) "RTN","LRVER3",85,0) . S:$L(X)&($E(X)'["-") $P(^(0),U,9)="-"_X "RTN","LRVER3",86,0) . D V11,ASKXQA "RTN","LRVER3",87,0) ; "RTN","LRVER3",88,0) ;G EXIT:$D(LRGVP),V11:LRVF&$D(LRSA),V1:LRVF&(LRNTN>1),EXIT:LRVF "RTN","LRVER3",89,0) I $D(LRGVP) D EXIT Q "RTN","LRVER3",90,0) I LRVF,$D(LRSA) D V11,ASKXQA Q "RTN","LRVER3",91,0) I LRVF,LRNTN>1 D V1 Q "RTN","LRVER3",92,0) I LRVF D ASKXQA,EXIT Q "RTN","LRVER3",93,0) ; "RTN","LRVER3",94,0) NOVER ; "RTN","LRVER3",95,0) I $O(LRNOVER(0)) D G EXIT "RTN","LRVER3",96,0) . N LRI,LRX "RTN","LRVER3",97,0) . S LRI=1 "RTN","LRVER3",98,0) . F S LRI=+$O(LRNOVER(LRI)) Q:LRI<2 D "RTN","LRVER3",99,0) . . N LRX,LRERR "RTN","LRVER3",100,0) . . S LRX="Test Not Reviewed: "_$$GET1^DID(63.04,LRI,"","LABEL","","LRERR") "RTN","LRVER3",101,0) . . I $G(LRERR("DIERR",1)) W !,"For DATANAME "_LRI_" - "_LRERR("DIERR",1,"TEXT",1) Q "RTN","LRVER3",102,0) . . W !,LRX "RTN","LRVER3",103,0) . . I $D(LRSB(LRI))#2 W " = "_$P(LRSB(LRI),U)_" "_$P(LRSB(LRI),U,2) "RTN","LRVER3",104,0) . W !,$$CJ^XLFSTR("The above test(s) have results already entered,",IOM) "RTN","LRVER3",105,0) . W !,$$CJ^XLFSTR("but you did not select them for review.",IOM) "RTN","LRVER3",106,0) . W !,$$CJ^XLFSTR(" Accession NOT approved. ",IOM),$C(7) "RTN","LRVER3",107,0) . W !,$$CJ^XLFSTR("You must review all results before ANY can be released.",IOM),!! "RTN","LRVER3",108,0) . W:$E(IOST,1,2)="C-" @LRVIDO "RTN","LRVER3",109,0) . W $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",IOM) "RTN","LRVER3",110,0) . W:$E(IOST,1,2)="C-" @LRVIDOF W !,$C(7) "RTN","LRVER3",111,0) I $O(LRNOVER(0)) W !,"Has not been reviewed and have data. Not approved.",! G EXIT "RTN","LRVER3",112,0) I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED",! G EXIT "RTN","LRVER3",113,0) I '$O(LRSB(0)) W !?5,"Nothing verified ",$C(7),! G EXIT "RTN","LRVER3",114,0) N CNT S CNT=1 "RTN","LRVER3",115,0) ; "RTN","LRVER3",116,0) AGAIN ; "RTN","LRVER3",117,0) R !,"Approve for release by entering your initials: ",LRINI:DTIME "RTN","LRVER3",118,0) I $E(LRINI)="^"!(LRINI="") W !!?5,$C(7),"Nothing verified!" D READ G EXIT "RTN","LRVER3",119,0) I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI "RTN","LRVER3",120,0) I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) W !,$C(7),"Please enter your correct initials" S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN "RTN","LRVER3",121,0) I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ G EXIT "RTN","LRVER3",122,0) D V11 "RTN","LRVER3",123,0) D ASKXQA "RTN","LRVER3",124,0) Q "RTN","LRVER3",125,0) ; "RTN","LRVER3",126,0) ; "RTN","LRVER3",127,0) V11 ; "RTN","LRVER3",128,0) I $D(XRTL) D T0^%ZOSV ; START RESPONSE TIME LOGGING "RTN","LRVER3",129,0) I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D "RTN","LRVER3",130,0) .D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRTEST) "RTN","LRVER3",131,0) D VER^LRVER3A "RTN","LRVER3",132,0) I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1 "RTN","LRVER3",133,0) N LRX "RTN","LRVER3",134,0) S LRX=0 "RTN","LRVER3",135,0) F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)="" "RTN","LRVER3",136,0) I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3 "RTN","LRVER3",137,0) I $D(XRT0) S XRTN="V11^LRVER3" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING "RTN","LRVER3",138,0) S LRVF=1 "RTN","LRVER3",139,0) Q "RTN","LRVER3",140,0) ; "RTN","LRVER3",141,0) ; "RTN","LRVER3",142,0) EXIT Q "RTN","LRVER3",143,0) ; "RTN","LRVER3",144,0) ; "RTN","LRVER3",145,0) READ ; "RTN","LRVER3",146,0) N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME "RTN","LRVER3",147,0) Q "RTN","LRVER3",148,0) ; "RTN","LRVER3",149,0) ; "RTN","LRVER3",150,0) CHG ; Check for changes, save results and create audit trail "RTN","LRVER3",151,0) N LRNOW "RTN","LRVER3",152,0) S LRUP="",LRNOW=$$NOW^XLFDT "RTN","LRVER3",153,0) F S LRCHG=$O(LRSB(LRCHG)) Q:LRCHG<1 D "RTN","LRVER3",154,0) . I '$D(LRSA(LRCHG)) S LRUP=1 Q "RTN","LRVER3",155,0) . I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") D Q ; Update user/release time/performing lab if results entered. "RTN","LRVER3",156,0) . . S LRSA(LRCHG,3)=1 "RTN","LRVER3",157,0) . . S LRUP=1 "RTN","LRVER3",158,0) . . S $P(LRSB(LRCHG),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER3",159,0) . . S $P(LRSB(LRCHG),U,6)=LRNOW "RTN","LRVER3",160,0) . . S $P(LRSB(LRCHG),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") "RTN","LRVER3",161,0) . I $P(LRSA(LRCHG),"^")'=$P(LRSB(LRCHG),"^") S LRUP=1,$P(LRSA(LRCHG,2),"^")=1 ; results changed "RTN","LRVER3",162,0) . I $P(LRSA(LRCHG),"^",2)'=$P(LRSB(LRCHG),"^",2) S LRUP=1,$P(LRSA(LRCHG,2),"^",2)=1 ; normalcy flag changed "RTN","LRVER3",163,0) . I $P(LRSA(LRCHG),"^",5)'=$P(LRSB(LRCHG),"^",5) D ; units/normals changed "RTN","LRVER3",164,0) . . N LRX,LRY "RTN","LRVER3",165,0) . . S LRX=$$UP^XLFSTR($P(LRSA(LRCHG),"^",5)),LRX=$TR(LRX,"""") "RTN","LRVER3",166,0) . . S LRY=$$UP^XLFSTR($P(LRSB(LRCHG),"^",5)),LRY=$TR(LRY,"""") "RTN","LRVER3",167,0) . . I LRX'=LRY S LRUP=1,$P(LRSA(LRCHG,2),"^",5)=1 "RTN","LRVER3",168,0) . I $D(LRSA(LRCHG,2)) D ; Update user/release time/performing lab if results changed. "RTN","LRVER3",169,0) . . S $P(LRSB(LRCHG),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER3",170,0) . . S $P(LRSB(LRCHG),U,6)=LRNOW "RTN","LRVER3",171,0) . . S $P(LRSB(LRCHG),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") "RTN","LRVER3",172,0) I 'LRUP S LREND=1 Q "RTN","LRVER3",173,0) S LREND=0 "RTN","LRVER3",174,0) W !! W:IOST["C-" @LRVIDO W "Approve update of data by entering your initials: " W:IOST["C-" @LRVIDOF "RTN","LRVER3",175,0) R LRINI:DTIME "RTN","LRVER3",176,0) I '$T S LREND=1 "RTN","LRVER3",177,0) I 'LREND,LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI "RTN","LRVER3",178,0) I LRINI'=LRUSI S LREND=1 "RTN","LRVER3",179,0) I LREND W !,$C(7),"No updating occurred ",! Q "RTN","LRVER3",180,0) ; "RTN","LRVER3",181,0) F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 D "RTN","LRVER3",182,0) . K:'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) LRSA(LRSB) "RTN","LRVER3",183,0) . I $P(LRSB(LRSB),"^")'="" S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB) "RTN","LRVER3",184,0) . I $D(LRSA(LRSB,1)),$D(LRSA(LRSB,2)) D DIDLE "RTN","LRVER3",185,0) ; "RTN","LRVER3",186,0) W !! "RTN","LRVER3",187,0) Q "RTN","LRVER3",188,0) ; "RTN","LRVER3",189,0) ; "RTN","LRVER3",190,0) DIDLE ; "RTN","LRVER3",191,0) ; Check if no previous result or pending result - no audit trail needed "RTN","LRVER3",192,0) I $P(LRSA(LRSB),"^")=""!($P(LRSA(LRSB),"^")="pending") Q "RTN","LRVER3",193,0) ; "RTN","LRVER3",194,0) S LRF=1 "RTN","LRVER3",195,0) L +^LR(LRDFN,LRSS,LRIDT):DILOCKTM+999 "RTN","LRVER3",196,0) NOW ; "RTN","LRVER3",197,0) N LRNOW7 "RTN","LRVER3",198,0) S LRNOW7=$S($G(LRNOW):LRNOW,1:$$NOW^XLFDT) "RTN","LRVER3",199,0) W ! "RTN","LRVER3",200,0) D ^LRDIDLE0 "RTN","LRVER3",201,0) I 'LROK K LRSA "RTN","LRVER3",202,0) L -^LR(LRDFN,LRSS,LRIDT) "RTN","LRVER3",203,0) S LRCORECT=1 "RTN","LRVER3",204,0) Q "RTN","LRVER3",205,0) ; "RTN","LRVER3",206,0) ; "RTN","LRVER3",207,0) RONLT ; (R)esolve (O)rder NLT code from file #68 original ordered test or "RTN","LRVER3",208,0) ; use default when not specified for file #60 test. "RTN","LRVER3",209,0) ; "RTN","LRVER3",210,0) N LR60,LRX,LRY,X "RTN","LRVER3",211,0) S LR60=+LRTS,LRY=$P(LRSB(LRSB),U,3) "RTN","LRVER3",212,0) ; "RTN","LRVER3",213,0) ; Try to determine order NLT from original ordered test "RTN","LRVER3",214,0) F Q:'LR60 D "RTN","LRVER3",215,0) . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0)),LR60=+$P(LRX,"^",9) "RTN","LRVER3",216,0) . I LR60,LR60'=$P(LRX,"^") D "RTN","LRVER3",217,0) . . S X=$$NLT^LRVER1(LR60) "RTN","LRVER3",218,0) . . I X'="" S $P(LRY,"!")=X "RTN","LRVER3",219,0) . I LR60=$P(LRX,"^") S LR60=0 "RTN","LRVER3",220,0) ; "RTN","LRVER3",221,0) ; Otherwise use default for lab package "RTN","LRVER3",222,0) I $P(LRY,"!")="" S $P(LRY,"!")=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!") "RTN","LRVER3",223,0) ; "RTN","LRVER3",224,0) S $P(LRSB(LRSB),U,3)=LRY "RTN","LRVER3",225,0) ; "RTN","LRVER3",226,0) Q "RTN","LRVER3",227,0) ; "RTN","LRVER3",228,0) ; "RTN","LRVER3",229,0) LRORU3 ; "RTN","LRVER3",230,0) SET ; "RTN","LRVER3",231,0) N LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X "RTN","LRVER3",232,0) ; "RTN","LRVER3",233,0) ; Go through LRSB array and sort results by order NLT code "RTN","LRVER3",234,0) ; and put into ordered test array (LROTA). "RTN","LRVER3",235,0) S LRDN=0 "RTN","LRVER3",236,0) F S LRDN=$O(LRSB(LRDN)) Q:'LRDN D "RTN","LRVER3",237,0) . I $P(LRSB(LRDN),"^")="" Q "RTN","LRVER3",238,0) . S LRTPNN=$P($P(LRSB(LRDN),U,3),"!"),LRT=+$G(^TMP("LR",$J,"TMP",LRDN)) "RTN","LRVER3",239,0) . I LRTPNN="" Q "RTN","LRVER3",240,0) . S LRTYPE=$P($G(^LAB(60,LRT,0)),U,3) "RTN","LRVER3",241,0) . I LRTYPE=""!("OB"'[LRTYPE) Q "RTN","LRVER3",242,0) . S LROTA(LRTPNN,LRDN)=LRT "RTN","LRVER3",243,0) . I $D(LRSA(LRDN,2)) S LROTA(LRTPNN,LRDN,1)="C" "RTN","LRVER3",244,0) ; "RTN","LRVER3",245,0) ; For each order NLT code setup call to put results into #62.49 queue "RTN","LRVER3",246,0) S LRTPNN="" "RTN","LRVER3",247,0) F S LRTPNN=$O(LROTA(LRTPNN)) Q:LRTPNN="" D "RTN","LRVER3",248,0) . S LR64=+$O(^LAM("C",LRTPNN_" ",0)),LRTPN=$$GET1^DIQ(64,LR64_",",.01) "RTN","LRVER3",249,0) . K LR7V "RTN","LRVER3",250,0) . M LR7V=LROTA(LRTPNN) "RTN","LRVER3",251,0) . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V,"ORU") "RTN","LRVER3",252,0) Q "RTN","LRVER3",253,0) ; "RTN","LRVER3",254,0) ; "RTN","LRVER3",255,0) ASKXQA ; Determine if user should be asked to send CPRS Alert "RTN","LRVER3",256,0) ; "RTN","LRVER3",257,0) N LRDEFAULT "RTN","LRVER3",258,0) ; "RTN","LRVER3",259,0) ; No CPRS alert for non-PATIENT file (#2) patients "RTN","LRVER3",260,0) I +LRDPF'=2 Q "RTN","LRVER3",261,0) ; "RTN","LRVER3",262,0) S LRDEFAULT=$$GET^XPAR("USR^DIV^PKG","LR CH VERIFY CPRS ALERT",1,"Q") "RTN","LRVER3",263,0) I LRDEFAULT>0 D ASKXQA^LR7ORB3(LRDFN,"CH",LRIDT,LRUID,LRDEFAULT) "RTN","LRVER3",264,0) ; "RTN","LRVER3",265,0) Q "RTN","LRVR3") 0^3^B108508518^B108418700 "RTN","LRVR3",1,0) LRVR3 ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION ;04/05/16 12:22 "RTN","LRVR3",2,0) ;;5.2;LAB SERVICE;**42,121,153,286,291,350,458,499**;Sep 27, 1994;Build 2 "RTN","LRVR3",3,0) ; "RTN","LRVR3",4,0) D V1 "RTN","LRVR3",5,0) I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER "RTN","LRVR3",6,0) K LRSA,LRSB,LRNOVER,LRSBCOM,LRLKOK "RTN","LRVR3",7,0) ; Leave LRVR3, back to LRVR2 "RTN","LRVR3",8,0) Q "RTN","LRVR3",9,0) ; "RTN","LRVR3",10,0) ; "RTN","LRVR3",11,0) V1 ; "RTN","LRVR3",12,0) ; "RTN","LRVR3",13,0) ; Warn and prompt if it appears user is entering reference lab result and message came from auto instrument (UI type=1) "RTN","LRVR3",14,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),$P($G(^LAH(LRLL,1,LRSQ,0)),"^",12)=1,'$$UICHK Q "RTN","LRVR3",15,0) ; "RTN","LRVR3",16,0) ; "RTN","LRVR3",17,0) S LRTN=1 "RTN","LRVR3",18,0) I $D(LRLOCKER)#2 L -@(LRLOCKER) "RTN","LRVR3",19,0) S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")" "RTN","LRVR3",20,0) L +@(LRLOCKER):DILOCKTM "RTN","LRVR3",21,0) I '$T W !," This entry is being edited by someone else." Q "RTN","LRVR3",22,0) ; LRNOVER set in LRVR2 "RTN","LRVR3",23,0) K LRLKOK D LINK Q:'$D(LRLKOK) K LRLKOK D LKCHK Q:'$D(LRLKOK) "RTN","LRVR3",24,0) K LRSA,LRSB,LRSBCOM,LRSBEPR "RTN","LRVR3",25,0) ; "RTN","LRVR3",26,0) ; Calculate days back for delta check based on specimen collection date/time. "RTN","LRVR3",27,0) S LRTM60=$$LRTM60^LRVR(LRCDT) "RTN","LRVR3",28,0) ; "RTN","LRVR3",29,0) S LRCMTDSP=$$CHKCDSP^LRVERA "RTN","LRVR3",30,0) N LRX "RTN","LRVR3",31,0) S LRX=1 "RTN","LRVR3",32,0) F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX<1 D "RTN","LRVR3",33,0) . S LRSB(LRX)=^LAH(LRLL,1,LRSQ,LRX) "RTN","LRVR3",34,0) . I $D(LRNOVER),$D(LRVTS(LRX)),$D(^TMP("LR",$J,"TMP",LRX)) S LRNOVER(LRX)="" "RTN","LRVR3",35,0) ; Copy comments from LAH "RTN","LRVR3",36,0) S LRX=0 "RTN","LRVR3",37,0) F S LRX=$O(^LAH(LRLL,1,LRSQ,1,LRX)) Q:LRX="" S LRSBCOM(LRX)=^(LRX) "RTN","LRVR3",38,0) ; "RTN","LRVR3",39,0) ; Copy filler id associated with each dataname from LAH. "RTN","LRVR3",40,0) M LRSBEPR=^LAH(LRLL,1,LRSQ,.1,"OBR","FID") "RTN","LRVR3",41,0) ; "RTN","LRVR3",42,0) ; "RTN","LRVR3",43,0) EDIT ; "RTN","LRVR3",44,0) I $D(^LAH(LRLL,1,LRSQ,0)) D "RTN","LRVR3",45,0) . N X "RTN","LRVR3",46,0) . S LREDIT=1 "RTN","LRVR3",47,0) . F LRX=0,.1,.3 M X(LRX)=^LAH(LRLL,1,LRSQ,LRX) "RTN","LRVR3",48,0) . K ^LAH(LRLL,1,LRSQ),LRNUF "RTN","LRVR3",49,0) . F LRX=0,.1,.3 M ^LAH(LRLL,1,LRSQ,LRX)=X(LRX) K X(LRX) "RTN","LRVR3",50,0) . D ^LRVR4 "RTN","LRVR3",51,0) . F LRX=1:0 S LRX=$O(LRSB(LRX)) Q:LRX<1 S ^LAH(LRLL,1,LRSQ,LRX)=LRSB(LRX) "RTN","LRVR3",52,0) I $O(^LAH(LRLL,1,LRSQ,1))<1 W !,"NO DATA TO APPROVE" Q "RTN","LRVR3",53,0) Q:$D(LRGVP) "RTN","LRVR3",54,0) ; "RTN","LRVR3",55,0) N LRI "RTN","LRVR3",56,0) S LRI=1 "RTN","LRVR3",57,0) F S LRI=$O(LRNOVER(LRI)) Q:LRI="" D "RTN","LRVR3",58,0) . N LRX,LRERR "RTN","LRVR3",59,0) . S LRX="Test Not Reviewed: "_$$GET1^DID(63.04,LRI,"","LABEL","","LRERR") "RTN","LRVR3",60,0) . I $G(LRERR("DIERR",1)) W !,"For DATANAME "_LRI_" - "_LRERR("DIERR",1,"TEXT",1) Q "RTN","LRVR3",61,0) . W !,LRX "RTN","LRVR3",62,0) . I $D(LRSB(LRI))#2 W " = "_$P(LRSB(LRI),U)_" "_$P(LRSB(LRI),U,2) "RTN","LRVR3",63,0) I $O(LRNOVER(0)) W !,"Have not been reviewed and have data. Not approved." QUIT "RTN","LRVR3",64,0) ; "RTN","LRVR3",65,0) I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED" QUIT "RTN","LRVR3",66,0) ; "RTN","LRVR3",67,0) N CNT S CNT=1 "RTN","LRVR3",68,0) ; "RTN","LRVR3",69,0) AGAIN ; "RTN","LRVR3",70,0) R !,"Approve for release by entering your initials: ",LRINI:DTIME "RTN","LRVR3",71,0) I $E(LRINI)="^"!(LRINI="") W !!?5,$C(7),"Nothing verified!" D READ Q "RTN","LRVR3",72,0) I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI "RTN","LRVR3",73,0) I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) W !,$C(7),"Please enter your correct initials" S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN "RTN","LRVR3",74,0) I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ Q "RTN","LRVR3",75,0) ; "RTN","LRVR3",76,0) D V11 "RTN","LRVR3",77,0) D ASKXQA^LRVER3 "RTN","LRVR3",78,0) Q "RTN","LRVR3",79,0) ; "RTN","LRVR3",80,0) ; "RTN","LRVR3",81,0) V11 ; Still locked from V1 L ^LR(LRDFN,LRSS,LRIDT) "RTN","LRVR3",82,0) ; Set filler id as external package reference for each data name "RTN","LRVR3",83,0) N LRCORECT,LRNOW,LRX "RTN","LRVR3",84,0) S (LRCORECT,LRX)=0,LRNOW=$$NOW^XLFDT "RTN","LRVR3",85,0) F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 I $D(LRVTS(LRX)),$D(LRSB(LRX)),$D(^(LRX)) D "RTN","LRVR3",86,0) . K ^LAH(LRLL,1,LRSQ,LRX) "RTN","LRVR3",87,0) . I $P(LRSB(LRX),"^")="" Q "RTN","LRVR3",88,0) . S $P(LRSB(LRX),U,6)=LRNOW "RTN","LRVR3",89,0) . S ^LR(LRDFN,LRSS,LRIDT,LRX)=LRSB(LRX) "RTN","LRVR3",90,0) . S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)="" "RTN","LRVR3",91,0) . I $G(LRSBEPR(LRX))="" Q "RTN","LRVR3",92,0) . N LRDATA,LRSITE "RTN","LRVR3",93,0) . S LRSITE=$G(LRDUZ(2)) "RTN","LRVR3",94,0) . I LRSITE="" S LRSITE=$P(LRSB(LRX),"^",9) "RTN","LRVR3",95,0) . S LRDATA(.01)=LRDFN_","_LRSS_","_LRIDT_","_LRX,LRDATA(.02)=4,LRDATA(1)=LRSBEPR(LRX) "RTN","LRVR3",96,0) . I LRSITE'="" S LRDATA(.03)=LRSITE_";DIC(4," "RTN","LRVR3",97,0) . D SETREF^LRUEPR(LRDFN,LRDATA(.01),.LRDATA,1) "RTN","LRVR3",98,0) ; "RTN","LRVR3",99,0) A3 ; Called from LRVRPOC, LRVRAR "RTN","LRVR3",100,0) ; "RTN","LRVR3",101,0) ; Set reporting site in file #63. "RTN","LRVR3",102,0) D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2)) "RTN","LRVR3",103,0) ; "RTN","LRVR3",104,0) I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D "RTN","LRVR3",105,0) . D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRBETST) "RTN","LRVR3",106,0) ; "RTN","LRVR3",107,0) D VER^LRVER3A ;unlocked in LRVER "RTN","LRVR3",108,0) ; "RTN","LRVR3",109,0) ; Check for LEDI and return results "RTN","LRVR3",110,0) I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3^LRVER3 "RTN","LRVR3",111,0) ; "RTN","LRVR3",112,0) K LRSBCOM "RTN","LRVR3",113,0) D:$P(LRPARAM,U,14)&($P($G(^LRO(68,LRAA,0)),U,16)) LOOK^LRCAPV1 "RTN","LRVR3",114,0) ; "RTN","LRVR3",115,0) ; Check for LEDI tests not reviewed "RTN","LRVR3",116,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),LRSS="CH",'$D(ZTQUEUED) D TNR "RTN","LRVR3",117,0) ; "RTN","LRVR3",118,0) I +$O(^LAH(LRLL,1,LRSQ,1))<1 D ZAPALL(LRLL,LRSQ) "RTN","LRVR3",119,0) I $D(LRPRGSQ),'$D(ZTQUEUED) D "RTN","LRVR3",120,0) . W !,"Purge data from sequence number(s): " "RTN","LRVR3",121,0) . F I=0:0 S I=$O(LRPRGSQ(I)) Q:I<1 W " ",I "RTN","LRVR3",122,0) . S %=2 D YN^DICN Q:%'=1 "RTN","LRVR3",123,0) . N LAIEN "RTN","LRVR3",124,0) . S LAIEN=0 "RTN","LRVR3",125,0) . F S LAIEN=$O(LRPRGSQ(LAIEN)) Q:LAIEN<1 D ZAPALL(LRLL,LAIEN) "RTN","LRVR3",126,0) Q "RTN","LRVR3",127,0) ; "RTN","LRVR3",128,0) ; "RTN","LRVR3",129,0) ZAP ; from LRLLS3 "RTN","LRVR3",130,0) D ZAPALL(LRLL,I) "RTN","LRVR3",131,0) Q "RTN","LRVR3",132,0) ; "RTN","LRVR3",133,0) ; "RTN","LRVR3",134,0) LINK ; Check and save link "RTN","LRVR3",135,0) D LKCHK Q:$D(LRLKOK) "RTN","LRVR3",136,0) S X=$S($D(^LRO(68,+$P(LRLK,U,3),1,+$P(LRLK,U,4),1,+$P(LRLK,U,5),0)):+^(0),1:"") G LINKOK:+X=LRDFN "RTN","LRVR3",137,0) S S1=PNM,S2=SSN,S3=LRDPF "RTN","LRVR3",138,0) ; "RTN","LRVR3",139,0) W !,$C(7),"WARNING - NO MATCHING ACCESSION WAS FOUND." "RTN","LRVR3",140,0) W !,"You may need to Clear instrument/worklist data," "RTN","LRVR3",141,0) W !,"or correctly identify the sample to the system." "RTN","LRVR3",142,0) ; "RTN","LRVR3",143,0) I X S LRDPF=$P(^LR(X,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM,?30,SSN,!,$C(7) S PNM=S1,SSN=S2,LRDPF=S3 "RTN","LRVR3",144,0) K S1,S2,S3 "RTN","LRVR3",145,0) Q:$D(LRGVP) "RTN","LRVR3",146,0) W !,"ARE YOU SURE THIS IS THE CORRECT DATA" S %=2 D YN^DICN Q:%'=1 "RTN","LRVR3",147,0) ; "RTN","LRVR3",148,0) LINKOK ; "RTN","LRVR3",149,0) K:$P(LRLK,U,5) ^LAH(LRLL,1,"C",+$P(LRLK,U,5),LRSQ) "RTN","LRVR3",150,0) S ^LAH(LRLL,1,"C",LRAN,LRSQ)="",$P(^LAH(LRLL,1,LRSQ,0),U,3,5)=LRAA_U_LRAD_U_LRAN,LRLKOK=1 "RTN","LRVR3",151,0) Q "RTN","LRVR3",152,0) ; "RTN","LRVR3",153,0) LKCHK S LRLK=$S($D(^LAH(LRLL,1,LRSQ,0)):^(0),1:"") I $P(LRLK,U,3)=LRAA&($P(LRLK,U,4)=LRAD)&($P(LRLK,U,5)=LRAN) S LRLKOK=1 "RTN","LRVR3",154,0) Q "RTN","LRVR3",155,0) ; "RTN","LRVR3",156,0) ; "RTN","LRVR3",157,0) ZAP2 ;Clear ^LAH( "RTN","LRVR3",158,0) D ZAPALL(LRLL,I) "RTN","LRVR3",159,0) Q "RTN","LRVR3",160,0) ; "RTN","LRVR3",161,0) ; "RTN","LRVR3",162,0) ZAPALL(LRLL,LAIEN) ;Clean up "RTN","LRVR3",163,0) N I,NODE,SEG,SEGID,SUB "RTN","LRVR3",164,0) Q:'$G(LRLL)!('$G(LAIEN)) "RTN","LRVR3",165,0) ; "RTN","LRVR3",166,0) S NODE=$G(^LAH(LRLL,1,LAIEN,0)) "RTN","LRVR3",167,0) K ^LAH(LRLL,1,"AUTOREL",LAIEN) "RTN","LRVR3",168,0) K ^LAH(LRLL,1,"B",+$P(NODE,U)_";"_+$P(NODE,U,2),LAIEN) "RTN","LRVR3",169,0) K ^LAH(LRLL,1,"C",+$P(NODE,U,5),LAIEN) "RTN","LRVR3",170,0) K ^LAH(LRLL,1,"D",+$P(NODE,U,6),LAIEN) "RTN","LRVR3",171,0) K ^LAH(LRLL,1,"E",+$P(NODE,U,8),LAIEN) "RTN","LRVR3",172,0) ; "RTN","LRVR3",173,0) S NODE("U")=$P($G(^LAH(LRLL,1,LAIEN,.3)),U) "RTN","LRVR3",174,0) I NODE("U")'="" D "RTN","LRVR3",175,0) . K ^LAH(LRLL,1,"AUTOREL-UID",NODE("U"),LAIEN) "RTN","LRVR3",176,0) . K ^LAH(LRLL,1,"U",NODE("U"),LAIEN) "RTN","LRVR3",177,0) . S I=0 "RTN","LRVR3",178,0) . F S I=$O(^LAH("LA7 AMENDED RESULTS",NODE("U"),I)) Q:'I D "RTN","LRVR3",179,0) . . K ^LAH("LA7 AMENDED RESULTS",NODE("U"),I,LRLL,LAIEN) "RTN","LRVR3",180,0) ; "RTN","LRVR3",181,0) S SEG="" "RTN","LRVR3",182,0) F S SEG=$O(^LAH(LRLL,1,LAIEN,.1,SEG)) Q:SEG="" D "RTN","LRVR3",183,0) . S SEGID="" "RTN","LRVR3",184,0) . F S SEGID=$O(^LAH(LRLL,1,LAIEN,.1,SEG,SEGID)) Q:SEGID="" D "RTN","LRVR3",185,0) . . S SUB=$P($G(^LAH(LRLL,1,LAIEN,.1,SEG,SEGID)),U) "RTN","LRVR3",186,0) . . I SUB'="" K ^LAH(LRLL,1,"A"_SEGID,SUB,LAIEN) "RTN","LRVR3",187,0) ; "RTN","LRVR3",188,0) K ^LAH(LRLL,1,LAIEN) "RTN","LRVR3",189,0) ; "RTN","LRVR3",190,0) ; Reset counter if loadlist is clear. "RTN","LRVR3",191,0) I '$O(^LAH(LRLL,1,0)) D "RTN","LRVR3",192,0) . L +^LAH(LRLL):DILOCKTM Q:'$T "RTN","LRVR3",193,0) . S ^LAH(LRLL)=0 "RTN","LRVR3",194,0) . L -^LAH(LRLL) "RTN","LRVR3",195,0) ; "RTN","LRVR3",196,0) Q "RTN","LRVR3",197,0) ; "RTN","LRVR3",198,0) ; "RTN","LRVR3",199,0) TNR ; List tests not reviewed and ask if user wants to delete. "RTN","LRVR3",200,0) ; "RTN","LRVR3",201,0) N DIR,DIROUT,DIRUT,DUOUT,LR60,I,X,Y "RTN","LRVR3",202,0) ; "RTN","LRVR3",203,0) ; Check if these results have already been verified "RTN","LRVR3",204,0) S I=1 "RTN","LRVR3",205,0) F S I=$O(^LAH(LRLL,1,LRSQ,I)) Q:'I D "RTN","LRVR3",206,0) . S X=^LAH(LRLL,1,LRSQ,I) "RTN","LRVR3",207,0) . I $P(X,"^")=$P($G(^LR(LRDFN,LRSS,LRIDT,I)),"^") K ^LAH(LRLL,1,LRSQ,I) "RTN","LRVR3",208,0) ; "RTN","LRVR3",209,0) ; Quit if no unreviewed results "RTN","LRVR3",210,0) I +$O(^LAH(LRLL,1,LRSQ,1))'>1 Q "RTN","LRVR3",211,0) ; "RTN","LRVR3",212,0) W !,"Test(s) Not Reviewed:",! "RTN","LRVR3",213,0) S I=1 "RTN","LRVR3",214,0) F S I=$O(^LAH(LRLL,1,LRSQ,I)) Q:'I D "RTN","LRVR3",215,0) . S X=^LAH(LRLL,1,LRSQ,I) "RTN","LRVR3",216,0) . S LR60=+$O(^LAB(60,"C","CH;"_I_";1",0)) "RTN","LRVR3",217,0) . I LR60 W $$GET1^DIQ(60,LR60_",",.01) "RTN","LRVR3",218,0) . E W $$GET1^DID(63.04,I,"","LABEL") "RTN","LRVR3",219,0) . W " = "_$P(X,"^")_" "_$P(X,"^",2)_" "_$P($P(X,"^",5),"!",7),! "RTN","LRVR3",220,0) ; "RTN","LRVR3",221,0) S DIR(0)="Y",DIR("A")="Purge these test results",DIR("B")="NO" "RTN","LRVR3",222,0) S DIR("?",1)="Answer 'NO' if you want to keep these results for later verification." "RTN","LRVR3",223,0) S DIR("?",2)="You may need to add these tests to the loadlist profile you are using" "RTN","LRVR3",224,0) S DIR("?")="and/or add these tests to the accession you are verifying." "RTN","LRVR3",225,0) D ^DIR Q:$D(DIRUT) "RTN","LRVR3",226,0) ; "RTN","LRVR3",227,0) I Y=1 D ZAPALL(LRLL,LRSQ) "RTN","LRVR3",228,0) Q "RTN","LRVR3",229,0) ; "RTN","LRVR3",230,0) ; "RTN","LRVR3",231,0) READ ; "RTN","LRVR3",232,0) N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME "RTN","LRVR3",233,0) Q "RTN","LRVR3",234,0) ; "RTN","LRVR3",235,0) ; "RTN","LRVR3",236,0) UICHK() ; Confirm that user wants to process UI type results as reference lab results. "RTN","LRVR3",237,0) ; "RTN","LRVR3",238,0) N DIR,DIRUT,DTOUT,DUOUT,LROK,X,Y "RTN","LRVR3",239,0) ; "RTN","LRVR3",240,0) S LROK=0 "RTN","LRVR3",241,0) S DIR(0)="YO",DIR("B")="NO" "RTN","LRVR3",242,0) S DIR("A",1)="These results were received via an automated instrument interface and you've" "RTN","LRVR3",243,0) S DIR("A",2)="indicated you're processing reference lab results. If you continue processing" "RTN","LRVR3",244,0) S DIR("A",3)="then only units and reference ranges received from the instrument will be" "RTN","LRVR3",245,0) S DIR("A",4)="stored. This could result in the report lacking units, reference ranges," "RTN","LRVR3",246,0) S DIR("A",5)="abnormality flags and designating an incorrect performing lab." "RTN","LRVR3",247,0) S DIR("A",6)=" " "RTN","LRVR3",248,0) S DIR("A",7)="Contact your local LIM or Lab ADPAC with any questions." "RTN","LRVR3",249,0) S DIR("A",8)=" " "RTN","LRVR3",250,0) S DIR("A")="Sure you want to continue" "RTN","LRVR3",251,0) D ^DIR "RTN","LRVR3",252,0) I Y=1 S LROK=1 "RTN","LRVR3",253,0) ; "RTN","LRVR3",254,0) Q LROK "RTN","LRVR3",255,0) ; "RTN","LRVR3",256,0) ; "RTN","LRVR3",257,0) LRNIGHT ; Entry point from LRNIGHT to clean up LAH global for selected entries. "RTN","LRVR3",258,0) ; "RTN","LRVR3",259,0) ;ZEXCEPT: ZTQUEUED,ZTREQ,ZTSTOP "RTN","LRVR3",260,0) ; "RTN","LRVR3",261,0) N I,LRCNT,LRCUTOFFDT,LRDAYSKEEP,LRERROR,LRI,LRINST,LRISQN,LRLIST,LRLL,LRROOT,X "RTN","LRVR3",262,0) S DT=$$DT^XLFDT "RTN","LRVR3",263,0) ; "RTN","LRVR3",264,0) ; If rollover has not completed then requeue task 5 minutes in future. "RTN","LRVR3",265,0) I +$G(^LAB(69.9,1,"RO"))'=(+$H) D Q "RTN","LRVR3",266,0) . I $D(ZTQUEUED) S ZTREQ=$$HADD^XLFDT($H,0,0,5,0) Q "RTN","LRVR3",267,0) . W !!,"Lab Rollover has not completed as of "_$$HTE^XLFDT($H,"1M")_" ... Aborting." "RTN","LRVR3",268,0) ; "RTN","LRVR3",269,0) D GETLST^XPAR(.LRLIST,"PKG","LR WORKLIST DATA CLEANUP",,.LRERROR) "RTN","LRVR3",270,0) I '$D(LRLIST) Q "RTN","LRVR3",271,0) ; "RTN","LRVR3",272,0) S LRI=0 "RTN","LRVR3",273,0) F S LRI=$O(LRLIST(LRI)) Q:'LRI D Q:$G(ZTSTOP) "RTN","LRVR3",274,0) . S LRLL=$P(LRLIST(LRI),U),LRDAYSKEEP=$P(LRLIST(LRI),U,2),LRCUTOFFDT=DT "RTN","LRVR3",275,0) . I LRDAYSKEEP>0 S LRCUTOFFDT=$$FMADD^XLFDT(DT,-LRDAYSKEEP) "RTN","LRVR3",276,0) . I '$D(^LAH(LRLL)) Q "RTN","LRVR3",277,0) . I $$S^%ZTLOAD("Processing LRLL: "_LRLL) S ZTSTOP=1 Q "RTN","LRVR3",278,0) . L +^LAH(LRLL):DILOCKTM+60 Q:'$T "RTN","LRVR3",279,0) . S (LRCNT,LRISQN)=0 "RTN","LRVR3",280,0) . F S LRISQN=$O(^LAH(LRLL,1,LRISQN)) Q:'LRISQN D Q:$G(ZTSTOP) "RTN","LRVR3",281,0) . . S LRCNT=LRCNT+1 "RTN","LRVR3",282,0) . . I '(LRCNT#100) I $$S^%ZTLOAD("Processing LRLL: "_LRLL_" LRISQN: "_LRISQN) S ZTSTOP=1 Q "RTN","LRVR3",283,0) . . I '$P($G(^LAH(LRLL,1,LRISQN,0)),"^",11) D UPDT^LAGEN(LRLL,LRISQN) Q ; No date, put current d/t, skip "RTN","LRVR3",284,0) . . I $P($G(^LAH(LRLL,1,LRISQN,0)),"^",11)'