Released LR*5.2*488 SEQ #391 Extracted from mail message **KIDS**:LR*5.2*488^ **INSTALL NAME** LR*5.2*488 "BLD",10555,0) LR*5.2*488^LAB SERVICE^0^3170518^y "BLD",10555,1,0) ^^5^5^3170515^ "BLD",10555,1,1,0) This patch addresses two (2) VistA Laboratory issues related to override "BLD",10555,1,2,0) reference ranges: "BLD",10555,1,3,0) "BLD",10555,1,4,0) 1. Override Reference Ranges Not Displaying on Reports "BLD",10555,1,5,0) 2. Option LRENTER Prompt Answer of "YES" Treated as "NO" "BLD",10555,4,0) ^9.64PA^^ "BLD",10555,6.3) 1 "BLD",10555,"ABPKG") n "BLD",10555,"KRN",0) ^9.67PA^779.2^20 "BLD",10555,"KRN",.4,0) .4 "BLD",10555,"KRN",.401,0) .401 "BLD",10555,"KRN",.402,0) .402 "BLD",10555,"KRN",.403,0) .403 "BLD",10555,"KRN",.5,0) .5 "BLD",10555,"KRN",.84,0) .84 "BLD",10555,"KRN",3.6,0) 3.6 "BLD",10555,"KRN",3.8,0) 3.8 "BLD",10555,"KRN",9.2,0) 9.2 "BLD",10555,"KRN",9.8,0) 9.8 "BLD",10555,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",10555,"KRN",9.8,"NM",1,0) LRVER4^^0^B82522419 "BLD",10555,"KRN",9.8,"NM",2,0) LRVER5^^0^B149265866 "BLD",10555,"KRN",9.8,"NM","B","LRVER4",1) "BLD",10555,"KRN",9.8,"NM","B","LRVER5",2) "BLD",10555,"KRN",19,0) 19 "BLD",10555,"KRN",19.1,0) 19.1 "BLD",10555,"KRN",101,0) 101 "BLD",10555,"KRN",409.61,0) 409.61 "BLD",10555,"KRN",771,0) 771 "BLD",10555,"KRN",779.2,0) 779.2 "BLD",10555,"KRN",870,0) 870 "BLD",10555,"KRN",8989.51,0) 8989.51 "BLD",10555,"KRN",8989.52,0) 8989.52 "BLD",10555,"KRN",8994,0) 8994 "BLD",10555,"KRN","B",.4,.4) "BLD",10555,"KRN","B",.401,.401) "BLD",10555,"KRN","B",.402,.402) "BLD",10555,"KRN","B",.403,.403) "BLD",10555,"KRN","B",.5,.5) "BLD",10555,"KRN","B",.84,.84) "BLD",10555,"KRN","B",3.6,3.6) "BLD",10555,"KRN","B",3.8,3.8) "BLD",10555,"KRN","B",9.2,9.2) "BLD",10555,"KRN","B",9.8,9.8) "BLD",10555,"KRN","B",19,19) "BLD",10555,"KRN","B",19.1,19.1) "BLD",10555,"KRN","B",101,101) "BLD",10555,"KRN","B",409.61,409.61) "BLD",10555,"KRN","B",771,771) "BLD",10555,"KRN","B",779.2,779.2) "BLD",10555,"KRN","B",870,870) "BLD",10555,"KRN","B",8989.51,8989.51) "BLD",10555,"KRN","B",8989.52,8989.52) "BLD",10555,"KRN","B",8994,8994) "BLD",10555,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10555,"QUES",0) ^9.62^^ "BLD",10555,"REQB",0) ^9.611^2^2 "BLD",10555,"REQB",1,0) LR*5.2*437^1 "BLD",10555,"REQB",2,0) LR*5.2*458^1 "BLD",10555,"REQB","B","LR*5.2*437",1) "BLD",10555,"REQB","B","LR*5.2*458",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^2981028^66481 "PKG",26,22,1,"PAH",1,0) 488^3170518 "PKG",26,22,1,"PAH",1,1,0) ^^5^5^3170518 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses two (2) VistA Laboratory issues related to override "PKG",26,22,1,"PAH",1,1,2,0) reference ranges: "PKG",26,22,1,"PAH",1,1,3,0) "PKG",26,22,1,"PAH",1,1,4,0) 1. Override Reference Ranges Not Displaying on Reports "PKG",26,22,1,"PAH",1,1,5,0) 2. Option LRENTER Prompt Answer of "YES" Treated as "NO" "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") 2 "RTN","LRVER4") 0^1^B82522419^B82283549 "RTN","LRVER4",1,0) LRVER4 ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION ;07/06/10 14:08 "RTN","LRVER4",2,0) ;;5.2;LAB SERVICE;**14,42,112,121,140,171,153,188,279,283,286,350,437,488**;Sep 27, 1994;Build 1 "RTN","LRVER4",3,0) ; "RTN","LRVER4",4,0) N LRAMEND,LRRFLAG "RTN","LRVER4",5,0) ; "RTN","LRVER4",6,0) LOOP ; "RTN","LRVER4",7,0) S LRLCT=0 "RTN","LRVER4",8,0) I '$D(LRGVP) D "RTN","LRVER4",9,0) . S:$D(LRWRDS) LRWRD=LRWRDS "RTN","LRVER4",10,0) . W !!,PNM," SSN: ",SSN," " S LRLCT=LRLCT+1 "RTN","LRVER4",11,0) . I LRDPF=2 W " LOC: ",$S(LRWRD'="":LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??")) "RTN","LRVER4",12,0) ; "RTN","LRVER4",13,0) W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U) "RTN","LRVER4",14,0) W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX) "RTN","LRVER4",15,0) W ?48," Age: ",$$CALCAGE^LRRPU(DOB,LRCDT)," as of ",$$FMTE^XLFDT(LRCDT,"1D") "RTN","LRVER4",16,0) S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8) "RTN","LRVER4",17,0) I LRPRAC>0,LRPRAC=+LRPRAC D GETS^DIQ(200,LRPRAC_",",".01;.132;.137;.138","E","LRPRAC(LRPRAC)","LRERR") "RTN","LRVER4",18,0) W !,"Provider: " "RTN","LRVER4",19,0) S LRLCT=LRLCT+2 "RTN","LRVER4",20,0) I LRPRAC'="",'$D(LRPRAC(LRPRAC,200)) W LRPRAC "RTN","LRVER4",21,0) I LRPRAC,$D(LRPRAC(LRPRAC,200)) D "RTN","LRVER4",22,0) . W LRPRAC(LRPRAC,200,LRPRAC_",",.01,"E"),?40," Voice pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.137,"E") "RTN","LRVER4",23,0) . W !," Phone: ",LRPRAC(LRPRAC,200,LRPRAC_",",.132,"E"),?38," Digital pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.138,"E") "RTN","LRVER4",24,0) . S LRLCT=LRLCT+1 "RTN","LRVER4",25,0) ; "RTN","LRVER4",26,0) N PRAC,PR "RTN","LRVER4",27,0) D PRAC^LR7OMERG(LRAA,LRAD,LRAN,.PRAC) "RTN","LRVER4",28,0) I $O(PRAC(0)) D "RTN","LRVER4",29,0) . S PR=0 "RTN","LRVER4",30,0) . F S PR=$O(PRAC(PR)) Q:PR<1 I $D(^VA(200,PR,0)) W !?14,$P(^(0),"^") S LRLCT=LRLCT+1 "RTN","LRVER4",31,0) W ! S LRLCT=LRLCT+1 "RTN","LRVER4",32,0) S LRNX=0,LRVRM=2,T="" "RTN","LRVER4",33,0) I $P(^LR(LRDFN,LRSS,LRIDT,0),U,7)'="" D "RTN","LRVER4",34,0) . W !,"VOLUME: ",$P(^(0),U,7) "RTN","LRVER4",35,0) . S LRLCT=LRLCT+1 "RTN","LRVER4",36,0) S LRACC=$P(Z1,U,6) "RTN","LRVER4",37,0) W !,"ACCESSION:",?30,$P(Z2,U,6),?44," ",LRACC_" ["_LRUID,"]" "RTN","LRVER4",38,0) W !,?30,LRDAT(2) W ?44," ",LRDAT "RTN","LRVER4",39,0) S LRLCT=LRLCT+2 "RTN","LRVER4",40,0) I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D "RTN","LRVER4",41,0) . W !?15 W:$E(IOST,1,2)="C-" @LRVIDO "RTN","LRVER4",42,0) . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U) "RTN","LRVER4",43,0) . W:$E(IOST,1,2)="C-" @LRVIDOF,$C(7) "RTN","LRVER4",44,0) . S LRLCT=LRLCT+1 "RTN","LRVER4",45,0) ; "RTN","LRVER4",46,0) I '$O(LRORD(0)) W !!?7,$C(7),"This is not a verifiable test/accession ",! Q "RTN","LRVER4",47,0) V I $D(LRGVP) D V20 Q "RTN","LRVER4",48,0) G EDIT:($O(^LR(LRDFN,LRSS,LRIDT,1))=""!('LRVF&$D(LRPER)))&'$D(LRNUF) "RTN","LRVER4",49,0) K LRNUF "RTN","LRVER4",50,0) D V20,ND G V37:LRVF&'$D(X)#2,EDIT:LREDIT "RTN","LRVER4",51,0) S LRTEC=$S($D(^LRO(68,LRAA,1,LRAD,2)):$P(^(2),U),1:$S($D(LRUSI):LRUSI,1:"")),LREDIT=0 "RTN","LRVER4",52,0) V36 ; "RTN","LRVER4",53,0) Q:$D(LRGVP) "RTN","LRVER4",54,0) K DIR "RTN","LRVER4",55,0) S DIR(0)="SAO^E:Edit;C:Comments;W:Workload" "RTN","LRVER4",56,0) S DIR("A")="SELECT ('E' to Edit, 'C' for Comments, 'W' Workload): " "RTN","LRVER4",57,0) D ^DIR "RTN","LRVER4",58,0) I $D(DIRUT) S X="^" G V37 "RTN","LRVER4",59,0) S X=Y "RTN","LRVER4",60,0) S:$E(X)="E" LREDIT=1,X="" "RTN","LRVER4",61,0) K LRNC "RTN","LRVER4",62,0) I $E(X)="C" S LRNC=1 D COM K LRNC G V36 "RTN","LRVER4",63,0) I $E(X)="W" D G LOOP "RTN","LRVER4",64,0) . I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D STD^LRCAPV,EN^LRCAPV S LREND=0 Q "RTN","LRVER4",65,0) . W !?10," Workload is not activated." "RTN","LRVER4",66,0) S X=$S(X="@":"",X="":LRTEC,1:X),LRTEC=X "RTN","LRVER4",67,0) S:'$D(^LRO(68,LRAA,1,LRAD,2)) ^(2)="" S ^(2)=X_U_$P(^(2),U,2,99) "RTN","LRVER4",68,0) G EDIT:LREDIT "RTN","LRVER4",69,0) V37 Q ;LEAVE LRVER4, BACK TO LRVER3 "RTN","LRVER4",70,0) ; "RTN","LRVER4",71,0) ; "RTN","LRVER4",72,0) V20 ; "RTN","LRVER4",73,0) I $G(LRCHG) D V21,LRCFL,DCOM^LRVERA Q "RTN","LRVER4",74,0) S LRNX=$O(LRORD(LRNX)) G V35:LRNX<1 D SUBS "RTN","LRVER4",75,0) G:'$G(LRTS) V20 "RTN","LRVER4",76,0) I '$D(LRSB(LRSB)),'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) G V20 "RTN","LRVER4",77,0) D V25^LRVER5 "RTN","LRVER4",78,0) ; "RTN","LRVER4",79,0) D:$D(LRGVP) PG Q:$D(LRGVP)&($D(DTOUT)!$D(DUOUT)) "RTN","LRVER4",80,0) ; "RTN","LRVER4",81,0) W !,$P(^LAB(60,+LRTS,0),U) "RTN","LRVER4",82,0) S X1="" "RTN","LRVER4",83,0) I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D "RTN","LRVER4",84,0) . S X1=$P(^(LRSB),U),X=X1 "RTN","LRVER4",85,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","LRVER4",86,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1) "RTN","LRVER4",87,0) . . I X="" S X=X1 "RTN","LRVER4",88,0) . W:X'="" ?30,@LRFP "RTN","LRVER4",89,0) S (X,LRFLG)="" "RTN","LRVER4",90,0) I $D(LRSB(LRSB)) D "RTN","LRVER4",91,0) . N LRX "RTN","LRVER4",92,0) . K LRNOVER(LRSB) "RTN","LRVER4",93,0) . S (LRDL,LRX,X)=$P(LRSB(LRSB),U) "RTN","LRVER4",94,0) . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2) "RTN","LRVER4",95,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","LRVER4",96,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX) "RTN","LRVER4",97,0) . . I X="" S X=LRX "RTN","LRVER4",98,0) . W ?44," ",@LRFP," ",LRFLG,?56," ",$P($P(LRSB(LRSB),U,5),"!",7) ;$P(LRNG,U,7) "RTN","LRVER4",99,0) . S X=LRX "RTN","LRVER4",100,0) . I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","LRVER4",101,0) . S Y=0 "RTN","LRVER4",102,0) . I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA K LRQ "RTN","LRVER4",103,0) . W " " "RTN","LRVER4",104,0) . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4 "RTN","LRVER4",105,0) ; "RTN","LRVER4",106,0) S:$P(X,U)="" $P(LRSB(LRSB),U)="" "RTN","LRVER4",107,0) I $P(X,U)'="" D "RTN","LRVER4",108,0) . N I,LRX,LRY "RTN","LRVER4",109,0) . S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG "RTN","LRVER4",110,0) . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3) "RTN","LRVER4",111,0) . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I) "RTN","LRVER4",112,0) . S $P(LRSB(LRSB),U,3)=LRY "RTN","LRVER4",113,0) . I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3 "RTN","LRVER4",114,0) . D "RTN","LRVER4",115,0) . . I $P(LRSB(LRSB),U,4)!($P(LRSB(LRSB),U)="pending") Q "RTN","LRVER4",116,0) . . I '$D(LRSA(LRSB))#2 S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") Q "RTN","LRVER4",117,0) . . I $P(LRSB(LRSB),U)=$P(LRSA(LRSB),U) S:$P(LRSA(LRSB),U,4) $P(LRSB(LRSB),U,4)=$P(LRSA(LRSB),U,4) S $P(LRSA(LRSB),U,3)=$P(LRSB(LRSB),U,3) Q "RTN","LRVER4",118,0) . . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") "RTN","LRVER4",119,0) . I $P(LRSB(LRSB),U,5)="" S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!") "RTN","LRVER4",120,0) I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>22 WT G:$G(Y)'="^" V20 "RTN","LRVER4",121,0) ; "RTN","LRVER4",122,0) V35 ; "RTN","LRVER4",123,0) D LRCFL:LRCFL]"" "RTN","LRVER4",124,0) D DCOM^LRVERA K LRNUF "RTN","LRVER4",125,0) Q "RTN","LRVER4",126,0) ; "RTN","LRVER4",127,0) ; "RTN","LRVER4",128,0) LRCFL ; "RTN","LRVER4",129,0) S LREXEC=LRCFL D ^LREXEC:LRCFL["" "RTN","LRVER4",130,0) D:LRLCT>22 WT "RTN","LRVER4",131,0) Q "RTN","LRVER4",132,0) ; "RTN","LRVER4",133,0) ; "RTN","LRVER4",134,0) EDIT ; "RTN","LRVER4",135,0) K LROUT "RTN","LRVER4",136,0) D ^LRVER5 S LRVRM=2 G:$G(LRCHG) LOOP G LRCFL:$D(LROUT)!$D(LRPER) "RTN","LRVER4",137,0) G LOOP "RTN","LRVER4",138,0) ; "RTN","LRVER4",139,0) ; "RTN","LRVER4",140,0) RANGE ; "RTN","LRVER4",141,0) N LRI,LRFIND "RTN","LRVER4",142,0) S Y=X "RTN","LRVER4",143,0) I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","LRVER4",144,0) W " " "RTN","LRVER4",145,0) F LRI=1:1:$L(X) S LRFIND=$E(X,LRI) Q:LRFIND?1(1N,1A,1".",1"-",1"<",1">") "RTN","LRVER4",146,0) S X=$E(X,LRI,999) "RTN","LRVER4",147,0) ; "RTN","LRVER4",148,0) ; User has indicated specific normality to set - used when entering "RTN","LRVER4",149,0) ; reference lab results and all the info to calculate is not available. "RTN","LRVER4",150,0) I $G(LRRFLAG(LRSB)) S LRFLG=$P("L^L*^H^H*","^",LRRFLAG(LRSB)) "RTN","LRVER4",151,0) ; "RTN","LRVER4",152,0) E D RANGECHK "RTN","LRVER4",153,0) I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4 "RTN","LRVER4",154,0) RQ S X=Y "RTN","LRVER4",155,0) Q "RTN","LRVER4",156,0) ; "RTN","LRVER4",157,0) ; "RTN","LRVER4",158,0) RANGECHK ; Check result against reference ranges and set flag "RTN","LRVER4",159,0) ; "RTN","LRVER4",160,0) ; "RTN","LRVER4",161,0) ; Check for numeric abnormal results "RTN","LRVER4",162,0) I X?.1"-".N.1".".N D Q "RTN","LRVER4",163,0) . I LRNG4'="",LRNG4?.1"-".N.1".".N,XLRNG5 S LRFLG="H*" Q "RTN","LRVER4",165,0) . I LRNG2'="",LRNG2?.1"-".N.1".".N,XLRNG3 S LRFLG="H" Q "RTN","LRVER4",167,0) ; "RTN","LRVER4",168,0) ; Check for <> abnormal results "RTN","LRVER4",169,0) ; "<" results checked against low values "RTN","LRVER4",170,0) ; ">" results checked against high values "RTN","LRVER4",171,0) I X?1(1"<",1">").N.1".".N D Q "RTN","LRVER4",172,0) . N LRX "RTN","LRVER4",173,0) . S LRX=$E(X,2,$L(X)) "RTN","LRVER4",174,0) . I $E(X)="<" D Q "RTN","LRVER4",175,0) . . I LRNG4'="",LRNG4?.N.1".".N,LRXLRNG5 S LRFLG="H*" Q "RTN","LRVER4",181,0) . . I LRNG5'="",LRNG5?.N.1".".N,LRX=LRNG5 S LRFLG="H*" Q "RTN","LRVER4",182,0) . . I LRNG3'="",LRNG3?.N.1".".N,LRX>LRNG3 S LRFLG="H" Q "RTN","LRVER4",183,0) . . I LRNG3'="",LRNG3?.N.1".".N,LRX=LRNG3 S LRFLG="H" Q "RTN","LRVER4",184,0) ; "RTN","LRVER4",185,0) ; Check for ranges, i.e. 0-5, 6-10. "RTN","LRVER4",186,0) ; Compare first value to abnormal value "RTN","LRVER4",187,0) I X?1.N1"-"1.N D Q "RTN","LRVER4",188,0) . I LRNG4'="",LRNG4?.N.1".".N,+XLRNG5 S LRFLG="H*" Q "RTN","LRVER4",190,0) . I LRNG2'="",LRNG2?.N.1".".N,+XLRNG3 S LRFLG="H" Q "RTN","LRVER4",192,0) ; "RTN","LRVER4",193,0) Q "RTN","LRVER4",194,0) ; "RTN","LRVER4",195,0) ; "RTN","LRVER4",196,0) DISPFLG ; Display critical flags "RTN","LRVER4",197,0) ; "RTN","LRVER4",198,0) I $E(IOST,1,2)="C-" W $C(7),@LRVIDO "RTN","LRVER4",199,0) W "CRITICAL ",$S($E(LRFLG,1)="L":"LOW",$E(LRFLG,1)="H":"HIGH",1:""),"!!" "RTN","LRVER4",200,0) I $E(IOST,1,2)="C-" W @LRVIDOF,$C(7),$C(7) "RTN","LRVER4",201,0) Q "RTN","LRVER4",202,0) ; "RTN","LRVER4",203,0) ; "RTN","LRVER4",204,0) SUBS ; "RTN","LRVER4",205,0) S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0) "RTN","LRVER4",206,0) Q "RTN","LRVER4",207,0) ; "RTN","LRVER4",208,0) ; "RTN","LRVER4",209,0) ND ; "RTN","LRVER4",210,0) K X,DIR "RTN","LRVER4",211,0) Q:'LRVF "RTN","LRVER4",212,0) I '$P($G(LRLABKY),U) D Q "RTN","LRVER4",213,0) . W !,"You're not authorized to edit verified data." "RTN","LRVER4",214,0) . S LREDIT=0 "RTN","LRVER4",215,0) S DIR(0)="FO" "RTN","LRVER4",216,0) S DIR("A")="If you need to change something, enter your initials" "RTN","LRVER4",217,0) S DIR("?")="To change verified results, enter your initials." "RTN","LRVER4",218,0) D ^DIR "RTN","LRVER4",219,0) S X=Y K DIR "RTN","LRVER4",220,0) I $$UP^XLFSTR(X)'=$$UP^XLFSTR(LRUSI) S LREDIT=0 K X QUIT "RTN","LRVER4",221,0) I $D(X)#2,'$G(LRCHG) W ! D S LRCHG=1 "RTN","LRVER4",222,0) . K LRSA S LRSA=1 "RTN","LRVER4",223,0) . F S LRSA=$O(^LR(LRDFN,"CH",LRIDT,LRSA)) Q:'LRSA S LRSA(LRSA)=^(LRSA) "RTN","LRVER4",224,0) Q "RTN","LRVER4",225,0) ; "RTN","LRVER4",226,0) ; "RTN","LRVER4",227,0) WT S LRLCT=0 Q:$D(LRGVP) "RTN","LRVER4",228,0) W !,"PRESS ANY KEY TO CONTINUE, '^' TO STOP " R Y:DTIME S:'$T Y="^" "RTN","LRVER4",229,0) Q "RTN","LRVER4",230,0) ; "RTN","LRVER4",231,0) ; "RTN","LRVER4",232,0) COM ;from LRVER5 "RTN","LRVER4",233,0) Q:$D(LRGVP) "RTN","LRVER4",234,0) K DR "RTN","LRVER4",235,0) S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT,DA(1)=LRDFN,DR=.99 "RTN","LRVER4",236,0) D ^DIE,COM1:$D(LRNC) "RTN","LRVER4",237,0) L +^LR(LRDFN,LRSS,LRIDT):5 "RTN","LRVER4",238,0) I $O(^LR(LRDFN,"CH",LRIDT,1,0))="" K ^LR(LRDFN,"CH",LRIDT,1) "RTN","LRVER4",239,0) L -^LR(LRDFN,LRSS,LRIDT) "RTN","LRVER4",240,0) Q "RTN","LRVER4",241,0) ; "RTN","LRVER4",242,0) ; "RTN","LRVER4",243,0) VOL ; "RTN","LRVER4",244,0) W !,"VOLUME: ",$P(^LR(LRDFN,LRSS,LRIDT,0),U,7),"//" R X:DTIME "RTN","LRVER4",245,0) G VOL:X["?" S:X'=""&(X'[U) ^(0)=$P(^(0),U,1,6)_U_X_U_$P(^(0),U,8,10) "RTN","LRVER4",246,0) G COM "RTN","LRVER4",247,0) ; "RTN","LRVER4",248,0) ; "RTN","LRVER4",249,0) COM1 ; "RTN","LRVER4",250,0) N LRX Q:'$P(^LR(LRDFN,LRSS,LRIDT,0),U,3) "RTN","LRVER4",251,0) D XREF^LRVER3A "RTN","LRVER4",252,0) S LRX=0 F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S ^LRO(68,"AC",LRDFN,LRIDT,LRX)="" "RTN","LRVER4",253,0) I $L($P(^LR(LRDFN,LRSS,LRIDT,0),U,9)),$E($P(^(0),U,9))'="-" S $P(^(0),U,9)="-"_$P(^(0),U,9) "RTN","LRVER4",254,0) Q "RTN","LRVER4",255,0) ; "RTN","LRVER4",256,0) ; "RTN","LRVER4",257,0) PG Q:$Y<(IOSL+5) "RTN","LRVER4",258,0) I $E(IOST,1,2)'="C-" W @IOF Q "RTN","LRVER4",259,0) D PG^LRGVP "RTN","LRVER4",260,0) Q "RTN","LRVER4",261,0) ; "RTN","LRVER4",262,0) V21 ; "RTN","LRVER4",263,0) N Y,LREND "RTN","LRVER4",264,0) S LRSB=1,LRLCT=1 "RTN","LRVER4",265,0) F S LRSB=+$O(LRSB(LRSB)) Q:'LRSB!($G(LREND)) D "RTN","LRVER4",266,0) . N LRX "RTN","LRVER4",267,0) . S LRTS=$O(^LAB(60,"C","CH;"_LRSB_";1",0)) Q:'LRTS "RTN","LRVER4",268,0) . D V25^LRVER5 "RTN","LRVER4",269,0) . W !,$P(^LAB(60,LRTS,0),U) S X1="" "RTN","LRVER4",270,0) . I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D "RTN","LRVER4",271,0) . . S X1=$P(^(LRSB),U),(LRDL,X)=X1 "RTN","LRVER4",272,0) . . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","LRVER4",273,0) . . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1) "RTN","LRVER4",274,0) . . . I X="" S X=X1 "RTN","LRVER4",275,0) . . W:X'="" ?30,@LRFP "RTN","LRVER4",276,0) . S (LRDL,LRX,X)=$P(LRSB(LRSB),U) "RTN","LRVER4",277,0) . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2) "RTN","LRVER4",278,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","LRVER4",279,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX) "RTN","LRVER4",280,0) . . I X="" S X=LRX "RTN","LRVER4",281,0) . W ?44," ",@LRFP," ",LRFLG,?56," ",$P(LRNG,U,7) "RTN","LRVER4",282,0) . S X=LRX "RTN","LRVER4",283,0) . I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","LRVER4",284,0) . S Y=0 "RTN","LRVER4",285,0) . I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA K LRQ "RTN","LRVER4",286,0) . W " " "RTN","LRVER4",287,0) . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4 "RTN","LRVER4",288,0) . I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>15 WT S:$E($G(Y))="^" LREND=1 "RTN","LRVER4",289,0) Q "RTN","LRVER5") 0^2^B149265866^B148324560 "RTN","LRVER5",1,0) LRVER5 ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION ;05/12/16 09:47 "RTN","LRVER5",2,0) ;;5.2;LAB SERVICE;**42,153,283,286,350,458,488**;Sep 27, 1994;Build 1 "RTN","LRVER5",3,0) ; "RTN","LRVER5",4,0) ; ZEXCEPT is used to identify variables which are external to a specific TAG "RTN","LRVER5",5,0) ; used in conjunction with Eclipse M-editor. "RTN","LRVER5",6,0) ; "RTN","LRVER5",7,0) ; "RTN","LRVER5",8,0) ;ZEXCEPT: LRD,LRDL,LRDUZ,LRDV,LRDVF,LREDIT,LRFP,LRNDISP,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LRNGS,LRNOVER,LRNX,LRORD,LRSA,LRSB,LRSPEC,LRTEST,LRTS,LRUID,LRVRM,SX,X "RTN","LRVER5",9,0) ; "RTN","LRVER5",10,0) I $G(LRNDISP) D "RTN","LRVER5",11,0) . S LRNX=0 "RTN","LRVER5",12,0) . N LRX F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 S LRX(LRORD(LRNX))="" "RTN","LRVER5",13,0) . S LRX=0 F S LRX=$O(LRSB(LRX)) Q:LRX<1 K:'$D(LRX(LRX)) LRSB(LRX),LRSA(LRX) "RTN","LRVER5",14,0) ; "RTN","LRVER5",15,0) ; Check for amended results that have arrived via an HL7 interface. "RTN","LRVER5",16,0) ; Only allow amended results to be verified during this session. "RTN","LRVER5",17,0) I $D(^LAH("LA7 AMENDED RESULTS",LRUID)) D "RTN","LRVER5",18,0) . S LRNX=0 "RTN","LRVER5",19,0) . F S LRNX=$O(LRORD(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRORD(LRNX))) K LRORD(LRNX) "RTN","LRVER5",20,0) . S LRNX=0 "RTN","LRVER5",21,0) . F S LRNX=$O(LRSB(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRNX)) K LRSB(LRNX),LRSA(LRNX) "RTN","LRVER5",22,0) ; "RTN","LRVER5",23,0) S LRNX=0,LRVRM=12 "RTN","LRVER5",24,0) ; "RTN","LRVER5",25,0) V40 S LRNX=$O(LRORD(LRNX)) G V44:LRNX<1 D LRSUBS "RTN","LRVER5",26,0) ; "RTN","LRVER5",27,0) ; Check if changing performing lab "RTN","LRVER5",28,0) ; and if not then restore LRSB(LRSB) from LRSA if previous verified to avoid triggering change prompt. "RTN","LRVER5",29,0) ;I $P($G(LRSB(LRSB)),"^",9),'$$PLOK^LRVERA($P(LRSB(LRSB),"^",9),$G(LRDUZ(2)),DUZ(2),LRTS) G V40 "RTN","LRVER5",30,0) I $P($G(LRSB(LRSB)),"^",9),'$$PLOK^LRVERA($P(LRSB(LRSB),"^",9),$G(LRDUZ(2)),DUZ(2),LRTS) D Q "RTN","LRVER5",31,0) . I $D(LRSA(LRSB)) S LRSB(LRSB)=LRSA(LRSB) "RTN","LRVER5",32,0) ; "RTN","LRVER5",33,0) D V25 "RTN","LRVER5",34,0) ; "RTN","LRVER5",35,0) V42 ; "RTN","LRVER5",36,0) ; "RTN","LRVER5",37,0) S (LRDL,SX,X)=$P($G(LRSB(LRSB)),U),LRDVF=0,LREDIT=0 "RTN","LRVER5",38,0) S:X=""&(LRDV'="") X=LRDV,LRDVF=1 ; default value "RTN","LRVER5",39,0) S LRTEST=$P(^LAB(60,LRTS,0),U) "RTN","LRVER5",40,0) K LRNOVER(LRSB) "RTN","LRVER5",41,0) ; "RTN","LRVER5",42,0) Q42 ; "RTN","LRVER5",43,0) ; "RTN","LRVER5",44,0) ; Check for amended results that have arrived via an HL7 interface. "RTN","LRVER5",45,0) I $D(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB)) D G:SX'=X!($G(LRAMEND(LRSB))) V45 "RTN","LRVER5",46,0) . W !,LRTEST," " W:X'="" @LRFP "RTN","LRVER5",47,0) . D AMEND Q:$G(LRAMEND(LRSB)) "RTN","LRVER5",48,0) . I SX=X W !,LRTEST," " W:X'="" @LRFP "RTN","LRVER5",49,0) ; "RTN","LRVER5",50,0) ; If entering results from a reference lab and not using normal/units "RTN","LRVER5",51,0) ; from file #60 then ask user for these values otherwise display "RTN","LRVER5",52,0) ; current file #60 values. "RTN","LRVER5",53,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2) D "RTN","LRVER5",54,0) . I $G(^LAB(60,+LRTS,1,+$G(LRSPEC),.1)) D Q "RTN","LRVER5",55,0) . . D V25 "RTN","LRVER5",56,0) . . W !!,"Current Ref Range: ",LRNG2,"-",LRNG3," Units: ",$P(LRNG,"^",7) "RTN","LRVER5",57,0) . . I LRNG4="",LRNG5="" Q "RTN","LRVER5",58,0) . . W !," Critical Low: ",LRNG4," Critical High: ",LRNG5 "RTN","LRVER5",59,0) . N LRX,LRY "RTN","LRVER5",60,0) . D ASKPLNR,NORM2 "RTN","LRVER5",61,0) . S LRX=$P(LRNGS,"^",2,5),LRX=$TR(LRX,"^","!") "RTN","LRVER5",62,0) . S LRY=$P($G(LRSB(LRSB)),"^",5),$P(LRY,"!",2,5)=LRX "RTN","LRVER5",63,0) . S $P(LRSB(LRSB),"^",5)=LRY "RTN","LRVER5",64,0) ; "RTN","LRVER5",65,0) Q42A ; "RTN","LRVER5",66,0) W !,LRTEST," " W:X'="" @LRFP "RTN","LRVER5",67,0) R "//",X:DTIME "RTN","LRVER5",68,0) I X'?.ANP W $C(7)," No Control Characters allowed." S X=SX G Q42A "RTN","LRVER5",69,0) S:$L($G(SX))&(X="") X=SX,LRDVF=1 "RTN","LRVER5",70,0) S LRDL=X I X=""&LRDVF S (LRD,X)=LRDV G V45 "RTN","LRVER5",71,0) Q43 G V40:X="",V45:X'["^",V44:X="^",LROUT:X="^^" "RTN","LRVER5",72,0) ; "RTN","LRVER5",73,0) V43 ; "RTN","LRVER5",74,0) ;ZEXCEPT: DIC,LRNUF,LRNX,LRORD,LRPLOC,LRSA,LRSB,LRSS,LRSSQ,LRTS,SX,X,Y "RTN","LRVER5",75,0) ; "RTN","LRVER5",76,0) S X=$P(X,U,2),DIC="^LAB(60,",DIC(0)="EOQZ" D ^DIC G:Y<1 Q42 "RTN","LRVER5",77,0) S LRPLOC=$P(Y(0),U,5),LRSSQ=$P(LRPLOC,";",1),LRSB=$P(LRPLOC,";",2),LRTS=+Y "RTN","LRVER5",78,0) I LRSSQ="" W !,"Not in this group" G LROUT "RTN","LRVER5",79,0) I LRSS'=LRSSQ!'$D(^TMP("LR",$J,"TMP",LRSB)) W !,"Not in this group" G LROUT "RTN","LRVER5",80,0) S LRNX=0 "RTN","LRVER5",81,0) F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 Q:LRSB=LRORD(LRNX) "RTN","LRVER5",82,0) I LRNX,LRSB=LRORD(LRNX) D LRSUBS,V25 G V42 "RTN","LRVER5",83,0) ; "RTN","LRVER5",84,0) V44 K SX "RTN","LRVER5",85,0) D COM^LRVER4 "RTN","LRVER5",86,0) S LRNUF=1 S:LRVF LRSA=1 "RTN","LRVER5",87,0) Q "RTN","LRVER5",88,0) ; "RTN","LRVER5",89,0) V45 ; "RTN","LRVER5",90,0) ; "RTN","LRVER5",91,0) ;ZEXCEPT: LRDFN,LRIDT,LRM,LRSA,LRSB,LRSKIP,LRSS,LRTS,LRVF,LRXD,LRXDP,SX,X "RTN","LRVER5",92,0) ; "RTN","LRVER5",93,0) K LRSKIP "RTN","LRVER5",94,0) I X="@" D G V46 "RTN","LRVER5",95,0) . K:'$G(LRVF) ^LR(LRDFN,LRSS,LRIDT,LRSB) "RTN","LRVER5",96,0) . S X=$S($G(LRVF)&($D(LRSB(LRSB)))&('$D(LRM(LRSB))):"comment",$D(LRM(LRSB)):"pending",$D(LRSA(LRSB)):"canc",1:"") "RTN","LRVER5",97,0) . S $P(LRSB(LRSB),"^")=X,$P(LRSB(LRSB),"^",2)="" "RTN","LRVER5",98,0) ; "RTN","LRVER5",99,0) ; If user has LRDATA security and wants to edit units and reference ranges. "RTN","LRVER5",100,0) I X="~" D G Q42A "RTN","LRVER5",101,0) . N LRKEY "RTN","LRVER5",102,0) . D OWNSKEY^XUSRB(.LRKEY,"LRDATA") "RTN","LRVER5",103,0) . I LRKEY(0)=1 D EDITUNR "RTN","LRVER5",104,0) . S X=SX "RTN","LRVER5",105,0) ; "RTN","LRVER5",106,0) S LRXD=U_$P(^LAB(60,LRTS,0),U,12),LRXDP=LRXD_"0)",LRXDP=@LRXDP "RTN","LRVER5",107,0) X:'(X="*"!($E(X)="?")!(X="C")!(X="#")!(X="canc")!(X="pending")) $P(LRXDP,U,5,99) "RTN","LRVER5",108,0) I '$D(X)#2 D HELP G V42 "RTN","LRVER5",109,0) I $D(X)#2,X["?" D HELP G:'($P(LRXDP,U,2)["S") V42 "RTN","LRVER5",110,0) I $D(X)#2,$P(LRXDP,U,2)["S",X'="*",X'="#",X'="canc",X'="pending" D LRSET G:'$D(X)#2 V42 "RTN","LRVER5",111,0) I $D(X)#2,X="C",$P(LRXDP,U,2)'["S" D COMP G V42 "RTN","LRVER5",112,0) ; "RTN","LRVER5",113,0) V46 ; "RTN","LRVER5",114,0) G V42:'$D(X)#2 "RTN","LRVER5",115,0) I LRVF,$D(LRSB(LRSB)),$D(LRSA(LRSB)) S LRSA(LRSB,1)=LRTEST "RTN","LRVER5",116,0) S X1=$S($D(^LR(LRDFN,LRSS,+LRLDT,LRSB)):$P(^(LRSB),U),1:"") "RTN","LRVER5",117,0) S:X="*" X="canc" S:X="#" X="comment" "RTN","LRVER5",118,0) ; "RTN","LRVER5",119,0) I '$G(LRAMEND(LRSB)) S LRFLG="" "RTN","LRVER5",120,0) S Y=0 "RTN","LRVER5",121,0) I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA K LRQ "RTN","LRVER5",122,0) I '$G(LRAMEND(LRSB)) D RANGE^LRVER4 "RTN","LRVER5",123,0) ; "RTN","LRVER5",124,0) S:$P(X,U)="" $P(LRSB(LRSB),U)="" "RTN","LRVER5",125,0) I $P(X,U)'="" D "RTN","LRVER5",126,0) . S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG "RTN","LRVER5",127,0) . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3) "RTN","LRVER5",128,0) . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I) "RTN","LRVER5",129,0) . S $P(LRSB(LRSB),U,3)=LRY "RTN","LRVER5",130,0) . I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3 "RTN","LRVER5",131,0) . D "RTN","LRVER5",132,0) . . I '$D(LRSA(LRSB))#2 D Q "RTN","LRVER5",133,0) . . . S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER5",134,0) . . . S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2))) "RTN","LRVER5",135,0) . . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER5",136,0) . S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!") "RTN","LRVER5",137,0) . S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2))) "RTN","LRVER5",138,0) G:$D(LRNUF) V44 K LRNUF G V40:'$D(LRSKIP) S X=LRSKIP G Q43:X["^",V40 "RTN","LRVER5",139,0) ; "RTN","LRVER5",140,0) ; "RTN","LRVER5",141,0) RANGE ; "RTN","LRVER5",142,0) ; "RTN","LRVER5",143,0) ;ZEXCEPT: LRDUZ,LRSB,X "RTN","LRVER5",144,0) ; "RTN","LRVER5",145,0) S $P(LRSB(LRSB),"^")=X "RTN","LRVER5",146,0) ; If previous results from another laboratory then use normals and units "RTN","LRVER5",147,0) ; associated with those results. "RTN","LRVER5",148,0) D "RTN","LRVER5",149,0) . I $G(LRDUZ(2)),DUZ(2)'=LRDUZ(2) D PLNR^LRVR4 Q "RTN","LRVER5",150,0) . I $P(LRSB(LRSB),"^",9),DUZ(2)'=$P(LRSB(LRSB),"^",9) D PLNR^LRVR4 "RTN","LRVER5",151,0) D RANGE^LRVER4 "RTN","LRVER5",152,0) Q "RTN","LRVER5",153,0) ; "RTN","LRVER5",154,0) ; "RTN","LRVER5",155,0) LRSUBS ; From LRVR5 "RTN","LRVER5",156,0) ; "RTN","LRVER5",157,0) ;ZEXCEPT: LRNX,LRORD,LRSB,LRTS "RTN","LRVER5",158,0) ; "RTN","LRVER5",159,0) S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB))#2:^(LRSB),1:0) "RTN","LRVER5",160,0) Q "RTN","LRVER5",161,0) ; "RTN","LRVER5",162,0) ; "RTN","LRVER5",163,0) LRSET ; from above and LRVR5 "RTN","LRVER5",164,0) ; Also called from Input Transform of file #60.01 field #9 "RTN","LRVER5",165,0) ; "RTN","LRVER5",166,0) ;ZEXCEPT: DA,X "RTN","LRVER5",167,0) ; "RTN","LRVER5",168,0) N DIERR,I,LRERR,LRESULT "RTN","LRVER5",169,0) ; "RTN","LRVER5",170,0) ; If called from EXECUTABLE HELP of file #60, field #9 then set LRSB from DD info. "RTN","LRVER5",171,0) I $G(LRSB)<1 N LRSB S LRSB=+$G(^LAB(60,+$G(DA(1)),.2)) "RTN","LRVER5",172,0) ; "RTN","LRVER5",173,0) D CHK^DIE(63.04,LRSB,"EH",X,.LRESULT,"LRERR") "RTN","LRVER5",174,0) I LRESULT'="^" D Q ; "RTN","LRVER5",175,0) . D EN^DDIOL(" "_LRESULT(0),"","$C(32)") "RTN","LRVER5",176,0) . S X=LRESULT "RTN","LRVER5",177,0) ; "RTN","LRVER5",178,0) I LRESULT="^" D "RTN","LRVER5",179,0) . D MSG^DIALOG("WHB","","","","LRERR") "RTN","LRVER5",180,0) . K X "RTN","LRVER5",181,0) ; "RTN","LRVER5",182,0) Q "RTN","LRVER5",183,0) ; "RTN","LRVER5",184,0) ; "RTN","LRVER5",185,0) COMP ; from LRVR5 "RTN","LRVER5",186,0) ; "RTN","LRVER5",187,0) ;ZEXCEPT: C,I,X "RTN","LRVER5",188,0) ; "RTN","LRVER5",189,0) S X="^%ET",@^%ZOSF("TRAP") "RTN","LRVER5",190,0) R !,"Enter your computation: ",C:DTIME "RTN","LRVER5",191,0) Q:"^"[C G CH:C="?"!(C["""") S C=$P(C," ",1) "RTN","LRVER5",192,0) S X="TRAP^LRVER5",@^%ZOSF("TRAP") D ^DIM S X="W "_C "RTN","LRVER5",193,0) I '$D(X)#2 W !,"Something's wrong with the syntax." G CH "RTN","LRVER5",194,0) F I=1:1:$L(C) I $E(C,I)?1A S I=.9 Q "RTN","LRVER5",195,0) G CH:I=.9,CH:C["/0",CH:C["\0" W !," equals ",@C G COMP "RTN","LRVER5",196,0) ; "RTN","LRVER5",197,0) TRAP ; Error trap for COMP subroutine above "RTN","LRVER5",198,0) W !!,"Error in your mathematical formula ",! "RTN","LRVER5",199,0) CH W !,"Enter for example: 5*2/4+1 and 3.5 will be returned [i.e. ((5*2)/4)+1=3.5]" "RTN","LRVER5",200,0) G COMP "RTN","LRVER5",201,0) ; "RTN","LRVER5",202,0) ; "RTN","LRVER5",203,0) V25 ; From LRVER4, LRSTUF2 "RTN","LRVER5",204,0) ; "RTN","LRVER5",205,0) ;ZEXCEPT: AGE,LRDEL,LRDUZ,LRDV,LRFP,LRNG,LRNGS,LRSA,LRSB,LRSPEC,LRTS,LRVF,N,SEX,X2 "RTN","LRVER5",206,0) ; "RTN","LRVER5",207,0) N LRTX,LRX "RTN","LRVER5",208,0) S (LRDV,LRNG,LRDEL,LRNGS)="" "RTN","LRVER5",209,0) I '$D(^LAB(60,+LRTS,0))#2 Q "RTN","LRVER5",210,0) S LRX=+$P($P(^LAB(60,+LRTS,0),U,5),";",2) "RTN","LRVER5",211,0) S LRTX=$S($L($P(^LAB(60,+LRTS,0),U,5)):$O(^LAB(60,"C",$P(^LAB(60,+LRTS,0),U,5),0)),1:+LRTS) "RTN","LRVER5",212,0) S LRFP=$P(^LAB(60,LRTX,.1),U,3) "RTN","LRVER5",213,0) I LRFP="" S LRFP="$J(X,8)" "RTN","LRVER5",214,0) ; "RTN","LRVER5",215,0) ; Normal ranges, units, delta checks and default value "RTN","LRVER5",216,0) I $D(^LAB(60,LRTX,1,+$G(LRSPEC),0)) D "RTN","LRVER5",217,0) . S LRNG=^LAB(60,LRTX,1,+$G(LRSPEC),0) "RTN","LRVER5",218,0) . S LRDEL=$G(^LAB(62.1,+$P(LRNG,U,8),1)) "RTN","LRVER5",219,0) . S LRDEL(1)=$G(^LAB(62.1,+$P(LRNG,U,8),2),"Q") "RTN","LRVER5",220,0) . S X2=$P(LRNG,U,9) "RTN","LRVER5",221,0) . S LRDV=$S('$D(LRSB(LRX)):$P(LRNG,U,10),1:"") "RTN","LRVER5",222,0) ; "RTN","LRVER5",223,0) ; When entering results from a reference lab check if flag to use normals/units from file 60. "RTN","LRVER5",224,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),'$G(^LAB(60,LRTX,1,+$G(LRSPEC),.1)) D PLNR^LRVR4 "RTN","LRVER5",225,0) ; "RTN","LRVER5",226,0) NORM ; "RTN","LRVER5",227,0) ; "RTN","LRVER5",228,0) ; Use previously stored units/normals if editing previous verified results. "RTN","LRVER5",229,0) I $G(LRSB) D "RTN","LRVER5",230,0) . I $D(LRSA(LRSB)) D "RTN","LRVER5",231,0) . . I $P(LRSA(LRSB),"^")?1(1"pending",1"comment",1"canc") Q "RTN","LRVER5",232,0) . . S LRNG=$P(LRSA(LRSB),"^",5),LRNG=$TR(LRNG,"!","^") "RTN","LRVER5",233,0) ; "RTN","LRVER5",234,0) D NORM2 "RTN","LRVER5",235,0) ; "RTN","LRVER5",236,0) Q "RTN","LRVER5",237,0) ; "RTN","LRVER5",238,0) NORM2 ; "RTN","LRVER5",239,0) ; "RTN","LRVER5",240,0) ;ZEXCEPT: AGE,LRNG,LRNGS,LRX,SEX "RTN","LRVER5",241,0) ; "RTN","LRVER5",242,0) I $G(SEX)="" S SEX="M" "RTN","LRVER5",243,0) I $G(AGE)="" S AGE=99 "RTN","LRVER5",244,0) ; "RTN","LRVER5",245,0) S LRNGS=LRNG "RTN","LRVER5",246,0) F LRX=2:1:5 D "RTN","LRVER5",247,0) . N LRY "RTN","LRVER5",248,0) . S LRY=$P(LRNG,"^",LRX) "RTN","LRVER5",249,0) . ; enclose in quotes if text or structured numeric "RTN","LRVER5",250,0) . I LRY'="",$E(LRY)?.(1A,1"<",1">") S LRY=$C(34)_LRY_$C(34) "RTN","LRVER5",251,0) . I LRY'="",$E(LRY)'=$C(34),LRY'?.N.1".".N S @("LRY"_"="_LRY) "RTN","LRVER5",252,0) . S $P(LRNG,"^",LRX)=LRY,$P(LRNGS,"^",LRX)=LRY,@("LRNG"_LRX)=LRY "RTN","LRVER5",253,0) Q "RTN","LRVER5",254,0) ; "RTN","LRVER5",255,0) ; "RTN","LRVER5",256,0) LROUT ; "RTN","LRVER5",257,0) ; "RTN","LRVER5",258,0) ;ZEXCEPT: LROUT,SX "RTN","LRVER5",259,0) ; "RTN","LRVER5",260,0) K SX "RTN","LRVER5",261,0) S LROUT=1 "RTN","LRVER5",262,0) Q "RTN","LRVER5",263,0) ; "RTN","LRVER5",264,0) ; "RTN","LRVER5",265,0) HELP ; Display help prompt from test result entry. "RTN","LRVER5",266,0) ; "RTN","LRVER5",267,0) ;ZEXCEPT: LRXD,LRXDH "RTN","LRVER5",268,0) ; "RTN","LRVER5",269,0) N LRKEY "RTN","LRVER5",270,0) W !," ??",$C(7) S LRXDH=LRXD_"3)" "RTN","LRVER5",271,0) W:$D(@LRXDH) " ",@LRXDH "RTN","LRVER5",272,0) W !,"Enter * to report ""canc"" for canceled." "RTN","LRVER5",273,0) W !,"Enter # to report ""comment""." "RTN","LRVER5",274,0) W:'($P(LRXDP,U,2)["S") !,"Enter C to enter calculate mode." "RTN","LRVER5",275,0) D OWNSKEY^XUSRB(.LRKEY,"LRDATA") "RTN","LRVER5",276,0) I LRKEY(0)=1 W !,"Enter ~ to edit units/reference ranges." "RTN","LRVER5",277,0) Q "RTN","LRVER5",278,0) ; "RTN","LRVER5",279,0) ; "RTN","LRVER5",280,0) EDITUNR ; Allow user to edit units and normal reference ranges. "RTN","LRVER5",281,0) ; "RTN","LRVER5",282,0) ;ZEXCEPT: LRNG,LRNGS,LRSB,LRSPEC,LRTS "RTN","LRVER5",283,0) ; "RTN","LRVER5",284,0) N LRX,LRY,LRUNR "RTN","LRVER5",285,0) S LRUNR=0 "RTN","LRVER5",286,0) I $D(^LAB(60,+LRTS,1,+$G(LRSPEC),0)) D "RTN","LRVER5",287,0) . N DIR,DIRUT,DTOUT,DUOUT,LRNNG,LRNNG2,LRNNG3,LRNNG4,LRNNG5,X,Y "RTN","LRVER5",288,0) . S LRNNG=^LAB(60,+LRTS,1,+$G(LRSPEC),0) "RTN","LRVER5",289,0) . F LRX=2:1:5 D "RTN","LRVER5",290,0) . . S LRY=$P(LRNNG,"^",LRX) "RTN","LRVER5",291,0) . . ; enclose in quotes if text or structured numeric "RTN","LRVER5",292,0) . . I LRY'="",$E(LRY)?.(1A,1"<",1">") S LRY=$C(34)_LRY_$C(34) "RTN","LRVER5",293,0) . . I LRY'="",$E(LRY)'=$C(34),LRY'?.N.1".".N S @("LRY"_"="_LRY) "RTN","LRVER5",294,0) . . S $P(LRNNG,"^",LRX)=LRY,@("LRNNG"_LRX)=LRY "RTN","LRVER5",295,0) . W ! "RTN","LRVER5",296,0) . S DIR("A",1)="Current Laboratory Test File Values" "RTN","LRVER5",297,0) . S DIR("A",2)="Current Ref Range: "_LRNNG2_"-"_LRNNG3_" Units: "_$P(LRNNG,"^",7) "RTN","LRVER5",298,0) . I LRNNG4="",LRNNG5="" "RTN","LRVER5",299,0) . E S DIR("A",3)=" Critical Low: "_LRNNG4_" Critical High: "_LRNNG5 "RTN","LRVER5",300,0) . S DIR(0)="YO",DIR("A")="Use these values",DIR("B")="NO" "RTN","LRVER5",301,0) . D ^DIR "RTN","LRVER5",302,0) . I Y'=1 S LRUNR=1 Q "RTN","LRVER5",303,0) . S LRX=$P(LRNNG,"^",2,5),LRX=$TR(LRX,"^","!") "RTN","LRVER5",304,0) . S LRY=$P($G(LRSB(LRSB)),"^",5),$P(LRY,"!",2,5)=LRX,$P(LRY,"!",7)=$P(LRNNG,"^",7) "RTN","LRVER5",305,0) . S $P(LRSB(LRSB),"^",5)=LRY,(LRNG,LRNGS)=LRNNG "RTN","LRVER5",306,0) ; "RTN","LRVER5",307,0) I LRUNR D ASKPLNR "RTN","LRVER5",308,0) ; "RTN","LRVER5",309,0) F LRX=2:1:5 D "RTN","LRVER5",310,0) . N LRY "RTN","LRVER5",311,0) . S LRY=$P(LRNG,"^",LRX) "RTN","LRVER5",312,0) . ; enclose in quotes if text or structured numeric "RTN","LRVER5",313,0) . I LRY'="",$E(LRY)?.(1A,1"<",1">") S LRY=$C(34)_LRY_$C(34) "RTN","LRVER5",314,0) . I LRY'="",$E(LRY)'=$C(34),LRY'?.N.1".".N S @("LRY"_"="_LRY) "RTN","LRVER5",315,0) . S $P(LRNG,"^",LRX)=LRY,$P(LRNGS,"^",LRX)=LRY,@("LRNG"_LRX)=LRY "RTN","LRVER5",316,0) ; "RTN","LRVER5",317,0) S LRX=$P(LRNGS,"^",2,5),LRX=$TR(LRX,"^","!") "RTN","LRVER5",318,0) S LRY=$P($G(LRSB(LRSB)),"^",5),$P(LRY,"!",2,5)=LRX,$P(LRY,"!",7)=$P(LRNGS,"^",7) "RTN","LRVER5",319,0) S $P(LRSB(LRSB),"^",5)=LRY "RTN","LRVER5",320,0) ; "RTN","LRVER5",321,0) Q "RTN","LRVER5",322,0) ; "RTN","LRVER5",323,0) ; "RTN","LRVER5",324,0) AMEND ; Process amended results and prompt user "RTN","LRVER5",325,0) ; "RTN","LRVER5",326,0) ;ZEXCEPT: LRAMEND,LRFLG,LRNG,LRNGS,LRSB,LRUID,X "RTN","LRVER5",327,0) ; "RTN","LRVER5",328,0) N DIR,DIRUT,DTOUT,DUOUT,LRANS,LRI,LRJ,LRLL,LRROOT,LRSQ,LRX,LRY,Y "RTN","LRVER5",329,0) ; "RTN","LRVER5",330,0) ; flag to indicate if amended results have been extracted from LAH "RTN","LRVER5",331,0) S LRAMEND=0 "RTN","LRVER5",332,0) ; "RTN","LRVER5",333,0) ; save current value of X "RTN","LRVER5",334,0) S LRX=X "RTN","LRVER5",335,0) ; "RTN","LRVER5",336,0) S LRROOT=$Q(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB)) "RTN","LRVER5",337,0) I LRROOT="" Q "RTN","LRVER5",338,0) I $QS(LRROOT,1)'="LA7 AMENDED RESULTS"!($QS(LRROOT,2)'=LRUID)!($QS(LRROOT,3)'=LRSB) Q "RTN","LRVER5",339,0) S LRLL=$QS(LRROOT,4),LRSQ=$QS(LRROOT,5) "RTN","LRVER5",340,0) ; "RTN","LRVER5",341,0) ; If corresponding corrected value has been deleted from LAH global "RTN","LRVER5",342,0) ; - then cleanup cross-reference and quit "RTN","LRVER5",343,0) I '$D(^LAH(LRLL,1,LRSQ,LRSB)) D Q "RTN","LRVER5",344,0) . W !!,"The related amended result has been purged" "RTN","LRVER5",345,0) . W !,"Unable to process this result." "RTN","LRVER5",346,0) . K ^LAH("LA7 AMENDED RESULTS",LRUID,LRSB,LRLL,LRSQ) "RTN","LRVER5",347,0) . S X=LRX "RTN","LRVER5",348,0) ; "RTN","LRVER5",349,0) S LRY=^LAH(LRLL,1,LRSQ,LRSB) "RTN","LRVER5",350,0) S DIR(0)="SOA^0:No;1:Yes;2:Keep but do not process",DIR("B")="Yes" "RTN","LRVER5",351,0) S DIR("A",1)=" ",DIR("A",2)="Amended result: "_$P(LRY,"^") "RTN","LRVER5",352,0) S DIR("A",2)=DIR("A",2)_" flag: "_$S($P(LRY,"^",2)'="":$P(LRY,"^",2),1:"None") "RTN","LRVER5",353,0) S DIR("A",2)=DIR("A",2)_" units: "_$P($P(LRY,"^",5),"!",7) "RTN","LRVER5",354,0) S DIR("A")="Accept amended results: " "RTN","LRVER5",355,0) S DIR("?",1)="Answer with" "RTN","LRVER5",356,0) S DIR("?",2)="0 - No to not accept amended result and delete." "RTN","LRVER5",357,0) S DIR("?",3)="1 - Yes to process amended result." "RTN","LRVER5",358,0) S DIR("?")="or 2 - Keep which skips processing but leaves result for future processing." "RTN","LRVER5",359,0) D ^DIR "RTN","LRVER5",360,0) I $D(DIRUT) Q "RTN","LRVER5",361,0) S LRANS=Y "RTN","LRVER5",362,0) ; "RTN","LRVER5",363,0) ; Process this amended result, set LRX to amended value "RTN","LRVER5",364,0) I LRANS=1 D "RTN","LRVER5",365,0) . S LRX=$P(LRY,"^"),LRFLG=$P(LRY,"^",2),LRSB(LRSB)=LRY,LRJ=$P(LRY,"^",5) "RTN","LRVER5",366,0) . F LRI=1,2,3,4,5,7,11,12 S $P(LRNG,"^",LRI)=$P(LRJ,"!",LRI) "RTN","LRVER5",367,0) . S LRNGS=LRNG,(LRAMEND,LRAMEND(LRSB))=1 "RTN","LRVER5",368,0) . D LRSBCOM^LRVR4 ; also process any comments "RTN","LRVER5",369,0) ; "RTN","LRVER5",370,0) ; Cleanup cross-reference unless user indicates they want to keep. "RTN","LRVER5",371,0) I LRANS<2 D "RTN","LRVER5",372,0) . K ^LAH(LRLL,1,LRSQ,LRSB) "RTN","LRVER5",373,0) . K ^LAH("LA7 AMENDED RESULTS",LRUID,LRSB,LRLL,LRSQ) "RTN","LRVER5",374,0) ; "RTN","LRVER5",375,0) ; If no other results then cleanup entry in LAH. "RTN","LRVER5",376,0) I +$O(^LAH(LRLL,1,LRSQ,1))<1 D ZAPALL^LRVR3(LRLL,LRSQ) "RTN","LRVER5",377,0) ; "RTN","LRVER5",378,0) ; Restore X to either original value of X or new amended value "RTN","LRVER5",379,0) S X=LRX "RTN","LRVER5",380,0) Q "RTN","LRVER5",381,0) ; "RTN","LRVER5",382,0) ; "RTN","LRVER5",383,0) ASKPLNR ; Ask user for performing lab normal ranges and units when entering "RTN","LRVER5",384,0) ; manually and not using values from file #60. "RTN","LRVER5",385,0) ; "RTN","LRVER5",386,0) ;ZEXCEPT: LRNG,LRNGS,LRRFLAG,LRSB,LRSPEC,LRTEST "RTN","LRVER5",387,0) ; "RTN","LRVER5",388,0) N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRI,LRJ,LRX,LRY,Y,X,Y "RTN","LRVER5",389,0) ; "RTN","LRVER5",390,0) S LRX=$TR(LRNGS,"^","!") "RTN","LRVER5",391,0) ; "RTN","LRVER5",392,0) W !!,"For test ",LRTEST "RTN","LRVER5",393,0) S DIR(0)="60.01,6" "RTN","LRVER5",394,0) I $P(LRX,"!",7)'="" S DIR("B")=$P(LRX,"!",7) "RTN","LRVER5",395,0) D ^DIR "RTN","LRVER5",396,0) I $D(DTOUT)!($D(DUOUT)) Q "RTN","LRVER5",397,0) ; Set units into component 7 of piece 5 "RTN","LRVER5",398,0) S $P(LRX,"!",7)=Y,$P(LRSB(LRSB),"^",5)=LRX "RTN","LRVER5",399,0) ; "RTN","LRVER5",400,0) ; Ask normals - high/low and critical "RTN","LRVER5",401,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","LRVER5",402,0) F LRJ=1,2,3,4 D Q:$D(DTOUT)!($D(DUOUT)) "RTN","LRVER5",403,0) . K DIR "RTN","LRVER5",404,0) . S DIR(0)="60.01,"_LRJ,LRI=LRJ+1 "RTN","LRVER5",405,0) . I $P(LRX,"!",LRI)'="" D "RTN","LRVER5",406,0) . . S DIR("B")=$P(LRX,"!",LRI) "RTN","LRVER5",407,0) . . I $E(DIR("B"))=$C(34) Q "RTN","LRVER5",408,0) . . I DIR("B")'?.N.1".".N S DIR("B")=$C(34)_DIR("B")_$C(34) ; enclose in quotes if text "RTN","LRVER5",409,0) . D ^DIR "RTN","LRVER5",410,0) . I $D(DTOUT)!($D(DUOUT)) Q "RTN","LRVER5",411,0) . S $P(LRX,"!",LRI)=Y "RTN","LRVER5",412,0) ; "RTN","LRVER5",413,0) ; Ask user for normality in case user does not know high/low/critical. "RTN","LRVER5",414,0) S LRRFLAG(LRSB)=$$RFLAG^LRVERA($P($G(LRSB(LRSB)),"^",2)) "RTN","LRVER5",415,0) ; "RTN","LRVER5",416,0) ; Update normal variable LRNG "RTN","LRVER5",417,0) I $P(LRX,"!")="" S $P(LRX,"!")=LRSPEC "RTN","LRVER5",418,0) F LRI=1,2,3,4,5,7 S $P(LRNG,"^",LRI)=$P(LRX,"!",LRI) "RTN","LRVER5",419,0) S LRNGS=LRNG "RTN","LRVER5",420,0) ; "RTN","LRVER5",421,0) Q "VER") 8.0^22.2 "BLD",10555,6) ^391 **END** **END**