Released LR*5.2*524 SEQ #433 Extracted from mail message **KIDS**:LR*5.2*524^ **INSTALL NAME** LR*5.2*524 "BLD",11501,0) LR*5.2*524^LAB SERVICE^0^3200115^y "BLD",11501,1,0) ^^10^10^3190805^ "BLD",11501,1,1,0) This patch addresses three (3) issues: "BLD",11501,1,2,0) "BLD",11501,1,3,0) 1. An atomic test which is a component of a panel might appear on the "BLD",11501,1,4,0) pending list even though the test is verified. "BLD",11501,1,5,0) "BLD",11501,1,6,0) 2. A lab panel might appear on the pending list even though all components "BLD",11501,1,7,0) have been verified. "BLD",11501,1,8,0) "BLD",11501,1,9,0) 3. If a test is marked as "not performed", the LRVR result verification "BLD",11501,1,10,0) option might delete the "not performed" status of the test. "BLD",11501,4,0) ^9.64PA^^ "BLD",11501,6.3) 14 "BLD",11501,"ABPKG") n "BLD",11501,"KRN",0) ^9.67PA^1.5^24 "BLD",11501,"KRN",.4,0) .4 "BLD",11501,"KRN",.401,0) .401 "BLD",11501,"KRN",.402,0) .402 "BLD",11501,"KRN",.403,0) .403 "BLD",11501,"KRN",.5,0) .5 "BLD",11501,"KRN",.84,0) .84 "BLD",11501,"KRN",1.5,0) 1.5 "BLD",11501,"KRN",1.6,0) 1.6 "BLD",11501,"KRN",1.61,0) 1.61 "BLD",11501,"KRN",1.62,0) 1.62 "BLD",11501,"KRN",3.6,0) 3.6 "BLD",11501,"KRN",3.8,0) 3.8 "BLD",11501,"KRN",9.2,0) 9.2 "BLD",11501,"KRN",9.8,0) 9.8 "BLD",11501,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",11501,"KRN",9.8,"NM",1,0) LRVER3A^^0^B218379813 "BLD",11501,"KRN",9.8,"NM",2,0) LRVR1^^0^B64078428 "BLD",11501,"KRN",9.8,"NM","B","LRVER3A",1) "BLD",11501,"KRN",9.8,"NM","B","LRVR1",2) "BLD",11501,"KRN",19,0) 19 "BLD",11501,"KRN",19.1,0) 19.1 "BLD",11501,"KRN",101,0) 101 "BLD",11501,"KRN",409.61,0) 409.61 "BLD",11501,"KRN",771,0) 771 "BLD",11501,"KRN",779.2,0) 779.2 "BLD",11501,"KRN",870,0) 870 "BLD",11501,"KRN",8989.51,0) 8989.51 "BLD",11501,"KRN",8989.52,0) 8989.52 "BLD",11501,"KRN",8994,0) 8994 "BLD",11501,"KRN","B",.4,.4) "BLD",11501,"KRN","B",.401,.401) "BLD",11501,"KRN","B",.402,.402) "BLD",11501,"KRN","B",.403,.403) "BLD",11501,"KRN","B",.5,.5) "BLD",11501,"KRN","B",.84,.84) "BLD",11501,"KRN","B",1.5,1.5) "BLD",11501,"KRN","B",1.6,1.6) "BLD",11501,"KRN","B",1.61,1.61) "BLD",11501,"KRN","B",1.62,1.62) "BLD",11501,"KRN","B",3.6,3.6) "BLD",11501,"KRN","B",3.8,3.8) "BLD",11501,"KRN","B",9.2,9.2) "BLD",11501,"KRN","B",9.8,9.8) "BLD",11501,"KRN","B",19,19) "BLD",11501,"KRN","B",19.1,19.1) "BLD",11501,"KRN","B",101,101) "BLD",11501,"KRN","B",409.61,409.61) "BLD",11501,"KRN","B",771,771) "BLD",11501,"KRN","B",779.2,779.2) "BLD",11501,"KRN","B",870,870) "BLD",11501,"KRN","B",8989.51,8989.51) "BLD",11501,"KRN","B",8989.52,8989.52) "BLD",11501,"KRN","B",8994,8994) "BLD",11501,"QDEF") ^^^^NO^^^^NO^^NO "BLD",11501,"QUES",0) ^9.62^^ "BLD",11501,"REQB",0) ^9.611^1^1 "BLD",11501,"REQB",1,0) LR*5.2*512^1 "BLD",11501,"REQB","B","LR*5.2*512",1) "MBREQ") 0 "PKG",26,-1) 1^1 "PKG",26,0) LAB SERVICE^LR^CORE LAB SYSTEM "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) 524^3200115 "PKG",26,22,1,"PAH",1,1,0) ^^10^10^3200115 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses three (3) issues: "PKG",26,22,1,"PAH",1,1,2,0) "PKG",26,22,1,"PAH",1,1,3,0) 1. An atomic test which is a component of a panel might appear on the "PKG",26,22,1,"PAH",1,1,4,0) pending list even though the test is verified. "PKG",26,22,1,"PAH",1,1,5,0) "PKG",26,22,1,"PAH",1,1,6,0) 2. A lab panel might appear on the pending list even though all components "PKG",26,22,1,"PAH",1,1,7,0) have been verified. "PKG",26,22,1,"PAH",1,1,8,0) "PKG",26,22,1,"PAH",1,1,9,0) 3. If a test is marked as "not performed", the LRVR result verification "PKG",26,22,1,"PAH",1,1,10,0) option might delete the "not performed" status of the test. "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","LRVER3A") 0^1^B218379813^B124646001 "RTN","LRVER3A",1,0) LRVER3A ;DALOI/FHS - DATA VERIFICATION;Sep 27, 2018@10:00:00 "RTN","LRVER3A",2,0) ;;5.2;LAB SERVICE;**1,5,42,100,121,153,190,221,254,263,266,274,295,373,350,512,524**;Sep 27, 1994;Build 14 "RTN","LRVER3A",3,0) ; "RTN","LRVER3A",4,0) ; Also contains LRORFLG to restrict multiple OERR alerts (VER+2) "RTN","LRVER3A",5,0) ; Reference to ^DIC(42 supported by IA #10039 "RTN","LRVER3A",6,0) ; "RTN","LRVER3A",7,0) VER ; Call with L ^LR(LRDFN,LRSS,LRIDT) from LRGV2, LRGVG1, LRSTUF1, LRSTUF2, LRVR3 "RTN","LRVER3A",8,0) Q:'$O(LRSB(0)) "RTN","LRVER3A",9,0) K ^TMP("LR",$J,"PANEL") "RTN","LRVER3A",10,0) ; "RTN","LRVER3A",11,0) N LRVCHK,LRORTST,LRORFLG,LRT "RTN","LRVER3A",12,0) S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),(LRAOD,LRACD)=$P(^(0),U,3) "RTN","LRVER3A",13,0) S LRACD=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,9)):^(9),1:LRACD) "RTN","LRVER3A",14,0) S:'($D(^LRO(68,LRAA,1,LRACD,1,LRAN,0))#2) LRACD=LRAD "RTN","LRVER3A",15,0) S LRAOD=$S($D(^LRO(68,LRAA,1,LRAOD,1,LRAN,0))#2:LRAOD,1:LRAD) "RTN","LRVER3A",16,0) I '$G(LRFIX) S LRNOW=$$NOW^XLFDT,$P(^LR(LRDFN,LRSS,LRIDT,0),U,3,4)=LRNOW_U_$S($G(LRDUZ):LRDUZ,1:DUZ) "RTN","LRVER3A",17,0) K A2 "RTN","LRVER3A",18,0) I '$D(PNM) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX S:PNM="" PNM="NONAME" "RTN","LRVER3A",19,0) N LRT "RTN","LRVER3A",20,0) S LRT=0 "RTN","LRVER3A",21,0) F S LRT=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT)) Q:LRT<.5 S:$P(^(LRT,0),U,5)="" A2(LRT)=1 I $D(^TMP("LR",$J,"VTO",LRT)) S LRVCHK=+^(LRT) D "RTN","LRVER3A",22,0) . I $S(LRVCHK<1:1,$D(LRSB(LRVCHK))#2:1,1:0) D "RTN","LRVER3A",23,0) . . I $D(LRSB(LRVCHK)) Q:$P(LRSB(LRVCHK),U)="" "RTN","LRVER3A",24,0) . . I LRVCHK<1,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),U,6)'="" Q "RTN","LRVER3A",25,0) . . ; "RTN","LRVER3A",26,0) . . ;LR7OB3 will correctly evaluate the panel status due to setting of ^XTMP("LR",$J,"PANEL".. "RTN","LRVER3A",27,0) . . ;Panel statuses (i.e LRVCHK<1) will be set after all component statuses are "RTN","LRVER3A",28,0) . . ;evaluated "RTN","LRVER3A",29,0) . . I LRVCHK>1 D "RTN","LRVER3A",30,0) . . . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",31,0) . . . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",32,0) . . . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",33,0) . . S LRORTST(LRT)="" "RTN","LRVER3A",34,0) . . ; "RTN","LRVER3A",35,0) . . I LRVCHK>1,LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0)) D "RTN","LRVER3A",36,0) . . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",37,0) . . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",38,0) . . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",39,0) . . I $P($G(LRPARAM),U,14),$P($G(^LRO(68,+LRAA,0)),U,16) S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)="" "RTN","LRVER3A",40,0) . . K A2(LRT) "RTN","LRVER3A",41,0) ; "RTN","LRVER3A",42,0) S D1=1,X=0 "RTN","LRVER3A",43,0) F S X=$O(^TMP("LR",$J,"TMP",X)) Q:X<1 S LRT=+^(X) I $D(LRM(X)) D REQ "RTN","LRVER3A",44,0) I $D(^LRO(69,LRODT,1,LRSN,0)) S ^(3)=$S($D(^(3)):+^(3),1:LRNOW) S:'$P(^(3),U,2) $P(^(3),U,2)=LRNOW "RTN","LRVER3A",45,0) ;LR*5.2*524 - line below was moved to after the "PANEL" call "RTN","LRVER3A",46,0) ;keeping previous location commented out below in case it is needed for later research "RTN","LRVER3A",47,0) ;I D1,'$D(A2) S:'$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) $P(^(3),U,4)=LRNOW,^LRO(68,LRAA,1,LRAD,1,"AC",LRNOW,LRAN)="" "RTN","LRVER3A",48,0) ; Class I CareVue routine TASKED if CareVue ward - pwc/10-2000 "RTN","LRVER3A",49,0) D "RTN","LRVER3A",50,0) . N I,LR7DLOC D IN5^VADPT S LR7DLOC=$G(^DIC(42,+$P($G(VAIP(5)),"^"),44)) "RTN","LRVER3A",51,0) . Q:'LR7DLOC D:$D(^LAB(62.487,"C",LR7DLOC)) ;good ward location "RTN","LRVER3A",52,0) . . S ZTRTN="^LA7DLOC",ZTDESC="LAB AUTOMATION CAREVUE SUPPORTED WARDS" "RTN","LRVER3A",53,0) . . S ZTIO="",ZTDTH=$H,ZTSAVE("L*")="" D ^%ZTLOAD "RTN","LRVER3A",54,0) . . K ZTSAVE,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTREQ,ZTQUEUED "RTN","LRVER3A",55,0) ; "RTN","LRVER3A",56,0) ;LR*5.2*524 - line below was moved to after the "PANEL" call "RTN","LRVER3A",57,0) ;keeping previous location commented out below in case it is needed for later research "RTN","LRVER3A",58,0) ;I D1,'$D(A2),LRAD'=LRACD S:'$P(^LRO(68,LRAA,1,LRACD,1,LRAN,3),U,4) $P(^(3),U,4)=LRNOW,^LRO(68,LRAA,1,LRACD,1,"AC",LRNOW,LRAN)="" "RTN","LRVER3A",59,0) D XREF I $D(^LRO(68,LRAA,.2))'[0 X ^(.2) "RTN","LRVER3A",60,0) ; "RTN","LRVER3A",61,0) ;LR*5.2*512 added panel evaluation which builds ^TMP("LR",$J,"PANEL",order number)=status "RTN","LRVER3A",62,0) ;Routine LR7OB3 evaluates the panel status before setting "CM" or "SC" in the ORC segment. "RTN","LRVER3A",63,0) D PANEL "RTN","LRVER3A",64,0) ; "RTN","LRVER3A",65,0) I D1,'$D(A2),LRAD'=LRACD S:'$P(^LRO(68,LRAA,1,LRACD,1,LRAN,3),U,4) $P(^(3),U,4)=LRNOW,^LRO(68,LRAA,1,LRACD,1,"AC",LRNOW,LRAN)="" "RTN","LRVER3A",66,0) I D1,'$D(A2) S:'$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) $P(^(3),U,4)=LRNOW,^LRO(68,LRAA,1,LRAD,1,"AC",LRNOW,LRAN)="" "RTN","LRVER3A",67,0) N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE",,.LRORTST) "RTN","LRVER3A",68,0) L -^LR(LRDFN,LRSS,LRIDT) ; unlock "RTN","LRVER3A",69,0) ;second kill to be safe "RTN","LRVER3A",70,0) K ^TMP("LR",$J,"PANEL") "RTN","LRVER3A",71,0) Q "RTN","LRVER3A",72,0) ; "RTN","LRVER3A",73,0) ; "RTN","LRVER3A",74,0) XREF ; from COM1^LRVER4, LRTSTOUT and VER^LRVER3A "RTN","LRVER3A",75,0) I LRDPF=62.3 S ^LRO(68,LRAA,1,LRAD,1,"AD",DT,LRAN)="" Q "RTN","LRVER3A",76,0) S LRPRAC=$$PRAC^LRX($P(^LR(LRDFN,LRSS,LRIDT,0),U,10)) ;get doc name "RTN","LRVER3A",77,0) S ^LRO(68,LRAA,1,LRAD,1,"AD",DT,LRAN)="" "RTN","LRVER3A",78,0) S ^LRO(69,9999999-LRIDT\1,1,"AP",LRPRAC,$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",79,0) I $G(LRLLOC)'="" D "RTN","LRVER3A",80,0) . S ^LRO(69,9999999-LRIDT\1,1,"AL",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",81,0) . S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="" "RTN","LRVER3A",82,0) . S ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",83,0) . S ^LRO(69,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="" "RTN","LRVER3A",84,0) I LRDPF=2 D CHSET^LRPX(LRDFN,LRIDT) "RTN","LRVER3A",85,0) Q:'$P(LRPARAM,U,3) "RTN","LRVER3A",86,0) ; "RTN","LRVER3A",87,0) TSKM ; "RTN","LRVER3A",88,0) N KK,ZTSK,ZTRTN,ZTDTH,ZTSAVE,ZTIO "RTN","LRVER3A",89,0) F KK="LRDFN","LRAA","LRAOD","LRAD","LRAN","LRIDT","LRSS","LRLLOC","LRSN","LRODT" S ZTSAVE(KK)="" "RTN","LRVER3A",90,0) S ZTRTN="DQ^LRTP",ZTIO="",ZTDTH=$H,ZTDESC="LAB INTERIM REPORTS" D ^%ZTLOAD "RTN","LRVER3A",91,0) Q "RTN","LRVER3A",92,0) ; "RTN","LRVER3A",93,0) PANEL ; "RTN","LRVER3A",94,0) ;LRCOMP - array which updates parent levels in file 68 "RTN","LRVER3A",95,0) ;LRCOMP2 - array used to update file 100 "RTN","LRVER3A",96,0) N LRPNL,LRCOMP,LRCOMP2,LRPARENT,LR69TST,LRORDTST,LRDONE,LROR100,LRCPORD "RTN","LRVER3A",97,0) D PANEL1,PANEL2 "RTN","LRVER3A",98,0) ;^TMP("LR",$J,"PANEL" used by LR7OB3 to update CPRS status "RTN","LRVER3A",99,0) S LRPARENT="" "RTN","LRVER3A",100,0) F S LRPARENT=$O(LRCOMP(LRPARENT)) Q:'LRPARENT D "RTN","LRVER3A",101,0) . ;if only an atomic test was specified in a subsequent verification "RTN","LRVER3A",102,0) . ;session, only the parent might have been set into the A2 array "RTN","LRVER3A",103,0) . ;A2 is used to determine whether the overall status of the accession at "RTN","LRVER3A",104,0) . ;the "3" subscript should be set to complete "RTN","LRVER3A",105,0) . I LRCOMP2(LRPARENT) K A2(LRPARENT) "RTN","LRVER3A",106,0) . S LRORDTST=$G(LROR100(LRPARENT)) "RTN","LRVER3A",107,0) . Q:LRORDTST']"" "RTN","LRVER3A",108,0) . ;This parent was not ordered in CPRS as the overall panel. "RTN","LRVER3A",109,0) . Q:'$D(LRCPORD(LRORDTST,LRPARENT)) "RTN","LRVER3A",110,0) . S ^TMP("LR",$J,"PANEL",LRORDTST)=LRCOMP2(LRPARENT) "RTN","LRVER3A",111,0) Q "RTN","LRVER3A",112,0) ; "RTN","LRVER3A",113,0) PANEL1 ;gather panel components and related information "RTN","LRVER3A",114,0) ; "RTN","LRVER3A",115,0) N LRTST,LRSTR,LRPANX,LRSUBAR,LR68X,LRPANELX "RTN","LRVER3A",116,0) S LRTST=0 "RTN","LRVER3A",117,0) F S LRTST=$O(^TMP("LR",$J,"VTO",LRTST)) Q:'LRTST D "RTN","LRVER3A",118,0) . ;check to see if the test is a panel within a panel "RTN","LRVER3A",119,0) . ;LRCOMP is initially set to "not complete". If any component is verified/complete, "RTN","LRVER3A",120,0) . ;the status will be set to "complete" for a later complete date/time set in file 68 "RTN","LRVER3A",121,0) . ;at subscript 4 for the panel. "RTN","LRVER3A",122,0) . ;LRCOMP2 is initially set to "complete". If any components are NOT verified/complete, "RTN","LRVER3A",123,0) . ;the status will be set to "not complete" for later determination of file 100 "RTN","LRVER3A",124,0) . ;status. "RTN","LRVER3A",125,0) . I $O(^LAB(60,LRTST,2,0)),'$D(LRCOMP(LRTST)) S LRCOMP(LRTST)=0,LRCOMP2(LRTST)=1 "RTN","LRVER3A",126,0) . S LRPARENT=$P($G(^TMP("LR",$J,"VTO",LRTST,"P")),U) "RTN","LRVER3A",127,0) . ;not a panel, so quit "RTN","LRVER3A",128,0) . I LRPARENT']""!('$O(^LAB(60,+LRPARENT,2,0))) Q "RTN","LRVER3A",129,0) . ;initialize if first time evaluating this parent "RTN","LRVER3A",130,0) . I '$D(LRCOMP(LRPARENT)) S LRCOMP(LRPARENT)=0,LRCOMP2(LRPARENT)=1 "RTN","LRVER3A",131,0) . ;panel should be set in LRORTST array for use by "RTN","LRVER3A",132,0) . ;downstream LR7OB* routines "RTN","LRVER3A",133,0) . S LRORTST(LRPARENT)="" "RTN","LRVER3A",134,0) . ;does this panel contain other panels "RTN","LRVER3A",135,0) . D SUBPAN(LRPARENT) "RTN","LRVER3A",136,0) D OR100 "RTN","LRVER3A",137,0) F S LRTST=$O(LRCOMP(LRTST)) Q:'LRTST D "RTN","LRVER3A",138,0) . ;check whether all atomic tests have correct status, etc. "RTN","LRVER3A",139,0) . D ATOMIC(LRTST) "RTN","LRVER3A",140,0) . ;retrieve all atomic tests for this parent "RTN","LRVER3A",141,0) . I '$D(LRPNL(LRTST)) D LRTST(LRTST,LRTST,1) "RTN","LRVER3A",142,0) . ;If there are still no LRPNL array entries, there are no required tests "RTN","LRVER3A",143,0) . ;in this panel. In that case, set LRCOMP to 1 so that the panel in file 68 will "RTN","LRVER3A",144,0) . ;be marked as complete if any tests have been verified. "RTN","LRVER3A",145,0) . I '$D(LRPNL(LRTST)),$G(LRPANELX(LRTST)) S LRCOMP(LRTST)=1 "RTN","LRVER3A",146,0) Q "RTN","LRVER3A",147,0) ; "RTN","LRVER3A",148,0) SUBPAN(LRPRCHK) ; "RTN","LRVER3A",149,0) ;find all sub-panels within panels "RTN","LRVER3A",150,0) N LRSUBPXN,LRSUBTST "RTN","LRVER3A",151,0) S LRSUBPXN=0 "RTN","LRVER3A",152,0) F S LRSUBPXN=$O(^LAB(60,LRPRCHK,2,LRSUBPXN)) Q:'LRSUBPXN D "RTN","LRVER3A",153,0) . S LRSUBTST=$P($G(^LAB(60,LRPRCHK,2,LRSUBPXN,0)),U) "RTN","LRVER3A",154,0) . Q:LRSUBTST']"" "RTN","LRVER3A",155,0) . ;If the test being verified is a component of a panel within a panel, and the "RTN","LRVER3A",156,0) . ;user selected only the test (not "all"), the package reference field in file 100 "RTN","LRVER3A",157,0) . ;won't be set by downstream routines if LRORTST isn't set for the sub-panel. "RTN","LRVER3A",158,0) . I LRSUBTST=LRTST S LRORTST(LRPRCHK)="" "RTN","LRVER3A",159,0) . I $O(^LAB(60,LRSUBTST,2,0))]"" D "RTN","LRVER3A",160,0) . . ;this is also a panel "RTN","LRVER3A",161,0) . . I '$D(LRCOMP(LRSUBTST)) S LRCOMP(LRSUBTST)=0,LRCOMP2(LRSUBTST)=1 "RTN","LRVER3A",162,0) . . ;will need to later evaluate all components of this panel "RTN","LRVER3A",163,0) . . ;to determine whether any are also panels "RTN","LRVER3A",164,0) . . S LRSUBAR(LRSUBTST)="" "RTN","LRVER3A",165,0) ;not finished yet going through LRSUBAR2 "RTN","LRVER3A",166,0) I $O(LRSUBAR2(LRPRCHK))'="" Q "RTN","LRVER3A",167,0) ; "RTN","LRVER3A",168,0) N LRSUBAR2 "RTN","LRVER3A",169,0) I $O(LRSUBAR(0))]"" D "RTN","LRVER3A",170,0) . N LRSUBSQ "RTN","LRVER3A",171,0) . ;LRSUBAR might be re-set so need to keep values for this loop "RTN","LRVER3A",172,0) . ;in LRSUBAR2 "RTN","LRVER3A",173,0) . M LRSUBAR2=LRSUBAR "RTN","LRVER3A",174,0) . K LRSUBAR "RTN","LRVER3A",175,0) . S LRSUBSQ=0 "RTN","LRVER3A",176,0) . F S LRSUBSQ=$O(LRSUBAR2(LRSUBSQ)) Q:'LRSUBSQ D SUBPAN(LRSUBSQ) "RTN","LRVER3A",177,0) Q "RTN","LRVER3A",178,0) ; "RTN","LRVER3A",179,0) OR100 ; "RTN","LRVER3A",180,0) ;are parents a sub-panel under a profile which was ordered "RTN","LRVER3A",181,0) N LRX69,LRX100,LRX10143,LRX60 "RTN","LRVER3A",182,0) S LRX69=0 "RTN","LRVER3A",183,0) F S LRX69=$O(^LRO(69,LRODT,1,LRSN,2,LRX69)) Q:'LRX69 D "RTN","LRVER3A",184,0) . S LRX100=$P($G(^LRO(69,LRODT,1,LRSN,2,LRX69,0)),U,7) "RTN","LRVER3A",185,0) . Q:LRX100']"" "RTN","LRVER3A",186,0) . ;used later in PANEL to find order number again "RTN","LRVER3A",187,0) . S LRX60=$P($G(^LRO(69,LRODT,1,LRSN,2,LRX69,0)),U) Q:LRX60="" "RTN","LRVER3A",188,0) . S LROR100(LRX60)=LRX100 "RTN","LRVER3A",189,0) . S LRX10143=0 "RTN","LRVER3A",190,0) . F S LRX10143=$O(^OR(100,LRX100,.1,"B",LRX10143)) Q:'LRX10143 D "RTN","LRVER3A",191,0) . . S LRX60=$P($P($G(^ORD(101.43,LRX10143,0)),U,2),";") "RTN","LRVER3A",192,0) . . ;store Lab test which was ordered in CPRS for each "RTN","LRVER3A",193,0) . . ;order number - validates in PANEL section before setting "RTN","LRVER3A",194,0) . . ;^TMP("LR",$J,"PANEL" which is used by LR7OB3 to determine "RTN","LRVER3A",195,0) . . ;CPRS order status of active or complete "RTN","LRVER3A",196,0) . . ;If this parent is a sub-panel under a profile which was ordered, "RTN","LRVER3A",197,0) . . ;the value of LRX60 will differ from the value of LRPARENT "RTN","LRVER3A",198,0) . . Q:LRX60']"" "RTN","LRVER3A",199,0) . . S LRCPORD(LRX100,LRX60)="" "RTN","LRVER3A",200,0) . . ;if ordered test is not yet in LRCOMP, add because overall status "RTN","LRVER3A",201,0) . . ;needs to be determined "RTN","LRVER3A",202,0) . . I '$D(LRCOMP(LRX60)),$O(^LAB(60,LRX60,2,0))]"" S LRCOMP(LRX60)=0,LRCOMP2(LRX60)=1 "RTN","LRVER3A",203,0) Q "RTN","LRVER3A",204,0) ; "RTN","LRVER3A",205,0) ATOMIC(LR68X) ; "RTN","LRVER3A",206,0) ;if component has been resulted but has been set previously "RTN","LRVER3A",207,0) ;into ^LRO(68, the LRCAP* routines won't update the complete date "RTN","LRVER3A",208,0) ;correcting the issue here so that all panel related logic is "RTN","LRVER3A",209,0) ;in one place "RTN","LRVER3A",210,0) ; "RTN","LRVER3A",211,0) N LR63,LR68Y,LR68Z,LR63RES "RTN","LRVER3A",212,0) S LR63=$P($P(^LAB(60,LR68X,0),U,5),";",2),LR63RES=0 "RTN","LRVER3A",213,0) ;LRPNLX is used to track whether at least one component of a panel which contains "RTN","LRVER3A",214,0) ;only non-required tests has been resulted. "RTN","LRVER3A",215,0) I LR63]"",$D(LRSB(LR63)),$P(LRSB(LR63),U)]"",$P(LRSB(LR63),U)'["pending" D "RTN","LRVER3A",216,0) . S LR63RES=1 "RTN","LRVER3A",217,0) . S LRPANELX(LR68X)=1 "RTN","LRVER3A",218,0) I LR63RES,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0)) D "RTN","LRVER3A",219,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0),U,4) S $P(^(0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",220,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",221,0) . ;kill component out of A2 (if present) if it wasn't exploded out in ^TMP("LR",$J,"VT" "RTN","LRVER3A",222,0) . K A2(LR68X) "RTN","LRVER3A",223,0) . ;not setting workload suffix field (#8) if disposition field (#6) is already set "RTN","LRVER3A",224,0) . ;so as to not affect workload already counted "RTN","LRVER3A",225,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0),U,6) S $P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",226,0) . I $G(LRACD)]"",LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0)) D "RTN","LRVER3A",227,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0),U,4) S $P(^(0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",228,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",229,0) . . ;not setting workload suffix field (#8) if disposition field (#6) is already set "RTN","LRVER3A",230,0) . . ;so as to not affect workload already counted "RTN","LRVER3A",231,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0),U,6) S $P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",232,0) ;check atomic tests if this test is a panel which has not been broken out in ^TMP("LR",$J,"VTO" "RTN","LRVER3A",233,0) I $O(^LAB(60,LR68X,2,0))]"" D "RTN","LRVER3A",234,0) . S LR68Y=0 "RTN","LRVER3A",235,0) . F S LR68Y=$O(^LAB(60,LR68X,2,LR68Y)) Q:'LR68Y D "RTN","LRVER3A",236,0) . . S LR68Z=$P(^LAB(60,LR68X,2,LR68Y,0),U) "RTN","LRVER3A",237,0) . . I LR68Z]"" D ATOMIC(LR68Z) "RTN","LRVER3A",238,0) . . I $G(LRPANELX(LR68Z)) S LRPANELX(LR68X)=1 "RTN","LRVER3A",239,0) Q "RTN","LRVER3A",240,0) ; "RTN","LRVER3A",241,0) LRTST(LRPARENT,LRSUB,LRGO) ; "RTN","LRVER3A",242,0) ;retrieve all required tests for a panel "RTN","LRVER3A",243,0) N LRA,LRTEST,LRTESTX,LRDISP,LRTX,LRPANZ,LRAAX "RTN","LRVER3A",244,0) S LRA=0 "RTN","LRVER3A",245,0) F S LRA=$O(^LAB(60,LRSUB,2,LRA)) Q:'LRA D "RTN","LRVER3A",246,0) . S LRTEST=+$G(^LAB(60,LRSUB,2,LRA,0)) Q:'LRTEST "RTN","LRVER3A",247,0) . I $O(^LAB(60,LRTEST,2,0))]"" D Q "RTN","LRVER3A",248,0) . . ;this is a panel within a panel - store for later evaluation "RTN","LRVER3A",249,0) . . S LRPANZ(LRTEST)="" "RTN","LRVER3A",250,0) . ;check to see if this test is a required test "RTN","LRVER3A",251,0) . I $P($G(^LAB(60,LRTEST,0)),U,17) D "RTN","LRVER3A",252,0) . . ;get information for each atomic test within the panel "RTN","LRVER3A",253,0) . . D LRPNL "RTN","LRVER3A",254,0) ;if LRGO is 0, panels within panels are being evaluated "RTN","LRVER3A",255,0) ;so need to store off the panels within panels within panels "RTN","LRVER3A",256,0) I 'LRGO,$D(LRPANZ) M LRPANZ1=LRPANZ "RTN","LRVER3A",257,0) ; "RTN","LRVER3A",258,0) I LRGO,$D(LRPANZ1) M LRPANZ=LRPANZ1 K LRPANZ1 "RTN","LRVER3A",259,0) ; "RTN","LRVER3A",260,0) ;break down panels within panels "RTN","LRVER3A",261,0) I $D(LRPANZ),LRGO D "RTN","LRVER3A",262,0) . ;must merge to new array because LRPANZ might be "RTN","LRVER3A",263,0) . ;re-created for panels within panels within panels... "RTN","LRVER3A",264,0) . K LRPANX "RTN","LRVER3A",265,0) . M LRPANX=LRPANZ K LRPANZ "RTN","LRVER3A",266,0) . S LRB="",LRDONE=0 "RTN","LRVER3A",267,0) . F S LRB=$O(LRPANX(LRB)) Q:'LRB D "RTN","LRVER3A",268,0) . . ;flag that this is the last entry in the array indicates "RTN","LRVER3A",269,0) . . ;that may continue looking for panel within a panel "RTN","LRVER3A",270,0) . . I $O(LRPANX(LRB))="" S LRDONE=1 "RTN","LRVER3A",271,0) . . D LRTST(LRPARENT,LRB,LRDONE) "RTN","LRVER3A",272,0) . ; "RTN","LRVER3A",273,0) . ;a second kill of LRPANX is needed for certain situations "RTN","LRVER3A",274,0) . ;when a single panel is embedded within another panel. "RTN","LRVER3A",275,0) . ;Execution occurs twice which causes no harm, but adding "RTN","LRVER3A",276,0) . ;second kill in case a situation occurs which would cause "RTN","LRVER3A",277,0) . ;an endless loop. "RTN","LRVER3A",278,0) . K LRPANX "RTN","LRVER3A",279,0) Q "RTN","LRVER3A",280,0) ; "RTN","LRVER3A",281,0) LRPNL ; "RTN","LRVER3A",282,0) N LRTX,LRSTR,LRAAX,LRADX,LRANX,LRIDTX "RTN","LRVER3A",283,0) S LRTX=$P(^LAB(60,LRTEST,0),U,5) "RTN","LRVER3A",284,0) Q:LRTX']"" "RTN","LRVER3A",285,0) S LR69TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRSUB,"")) "RTN","LRVER3A",286,0) ;Accession area and accession number might differ among components "RTN","LRVER3A",287,0) I 'LR69TST S LR69TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRTEST,"")) "RTN","LRVER3A",288,0) Q:'LR69TST "RTN","LRVER3A",289,0) S LRSTR=$G(^LRO(69,LRODT,1,LRSN,2,LR69TST,0)) "RTN","LRVER3A",290,0) S LRAAX=$P(LRSTR,U,4) "RTN","LRVER3A",291,0) S LRADX=$P(LRSTR,U,3) "RTN","LRVER3A",292,0) S LRANX=$P(LRSTR,U,5) "RTN","LRVER3A",293,0) S LRIDTX=$P($G(^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,3)),U,5) "RTN","LRVER3A",294,0) ;LRPNL(LRPARENT,LRTEST)=File 63 dept (2nd) subscript^File 63 test (4rd) subscript^accession area "RTN","LRVER3A",295,0) ; ^accession date^accession number^File 63 inverted date/time (3rd) subscript "RTN","LRVER3A",296,0) S LRPNL(LRPARENT,LRTEST)=$P(LRTX,";")_U_$P(LRTX,";",2)_U_LRAAX_U_LRADX_U_LRANX_U_LRIDTX "RTN","LRVER3A",297,0) Q "RTN","LRVER3A",298,0) ; "RTN","LRVER3A",299,0) PANEL2 ; "RTN","LRVER3A",300,0) ;evaluate all components / atomic tests of each parent "RTN","LRVER3A",301,0) N LRPARENT,LRTX,LRTSTX,LRSTR,LR63X,LRAAX,LRADX,LRANX,LRIDTX,LRADX2,LR63STR "RTN","LRVER3A",302,0) ; "RTN","LRVER3A",303,0) ;LRPNL(PARENT,TEST NUMBER)=FILE 63 DEPT (2ND) SUBSCRIPT_"^"_TEST (4TH) SUBSCRIPT IN FILE 63 "RTN","LRVER3A",304,0) ; _"^"_ACCESSION AREA IN FILE 68_"^"_ACCESSION DATE_"^"_ "RTN","LRVER3A",305,0) ; ACCESSION NUMBER"_"^"_FILE 63 INVERTED DATE/TIME (3RD) SUBSCRIPT "RTN","LRVER3A",306,0) ; "RTN","LRVER3A",307,0) S (LRPARENT,LRTSTX)="" "RTN","LRVER3A",308,0) F S LRPARENT=$O(LRPNL(LRPARENT)) Q:LRPARENT="" D "RTN","LRVER3A",309,0) . F S LRTSTX=$O(LRPNL(LRPARENT,LRTSTX)) Q:LRTSTX="" D "RTN","LRVER3A",310,0) . . S LRSTR=LRPNL(LRPARENT,LRTSTX) "RTN","LRVER3A",311,0) . . ; "RTN","LRVER3A",312,0) . . ;LR63X = file 63 dept subscript "RTN","LRVER3A",313,0) . . ;LRTX = file 63 test subscript "RTN","LRVER3A",314,0) . . ;LRAAX = accession area "RTN","LRVER3A",315,0) . . ;LRADX = accession date "RTN","LRVER3A",316,0) . . ;LRANX = accession number "RTN","LRVER3A",317,0) . . ;LRIDTX = file 63 inverted date/time subscript "RTN","LRVER3A",318,0) . . S LR63X=$P(LRSTR,U) "RTN","LRVER3A",319,0) . . S LRTX=$P(LRSTR,U,2) "RTN","LRVER3A",320,0) . . S LRAAX=$P(LRSTR,U,3) "RTN","LRVER3A",321,0) . . S LRADX=$P(LRSTR,U,4) "RTN","LRVER3A",322,0) . . S LRANX=$P(LRSTR,U,5) "RTN","LRVER3A",323,0) . . S LRIDTX=$P(LRSTR,U,6) "RTN","LRVER3A",324,0) . . I $G(^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,9)) S LRADX=^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,9) "RTN","LRVER3A",325,0) . . I LRIDTX>1,LR63X]"" S LR63STR=$G(^LR(LRDFN,LR63X,+LRIDTX,+LRTX)) D "RTN","LRVER3A",326,0) . . . ;This component is still pending, so order in file 100 should not be "complete" "RTN","LRVER3A",327,0) . . . ;since at least one component of a panel is pending. "RTN","LRVER3A",328,0) . . . I LR63STR=""!($P(LR63STR,U)["pending") S LRCOMP2(LRPARENT)=0 Q "RTN","LRVER3A",329,0) . . . ;This component has been verified. File 68 status for the parent should be complete "RTN","LRVER3A",330,0) . . . ;since at least one component has been verified. "RTN","LRVER3A",331,0) . . . S LRCOMP(LRPARENT)=1 "RTN","LRVER3A",332,0) ;update parent level in file 68 "RTN","LRVER3A",333,0) D UPDPAR "RTN","LRVER3A",334,0) Q "RTN","LRVER3A",335,0) ; "RTN","LRVER3A",336,0) UPDPAR ; "RTN","LRVER3A",337,0) ; "RTN","LRVER3A",338,0) ;If the panel encompasses multiple accession areas, an entry may "RTN","LRVER3A",339,0) ;not be present in file 68 at the panel level. "RTN","LRVER3A",340,0) ; "RTN","LRVER3A",341,0) S LRPARENT="" "RTN","LRVER3A",342,0) F S LRPARENT=$O(LRCOMP(LRPARENT)) Q:LRPARENT="" D "RTN","LRVER3A",343,0) . I '$G(LRCOMP(LRPARENT))!('$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0))) Q "RTN","LRVER3A",344,0) . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",345,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",346,0) . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",347,0) . I $G(LRACD)]"",LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0)) D "RTN","LRVER3A",348,0) . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0),U,4)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"") "RTN","LRVER3A",349,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",350,0) . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",351,0) Q "RTN","LRVER3A",352,0) ; "RTN","LRVER3A",353,0) REQ ; "RTN","LRVER3A",354,0) Q:$P($G(LRSB(X)),U)="comment" "RTN","LRVER3A",355,0) I $D(LRSB(X)),$P(LRSB(X),U)="canc" Q "RTN","LRVER3A",356,0) I $D(LRSB(X)),$P(LRSB(X),U)'["pend" Q "RTN","LRVER3A",357,0) I $P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0)),U,6)'="" Q "RTN","LRVER3A",358,0) S:'$G(LRALERT) LRALERT=$S($G(LROUTINE):LROUTINE,1:9) "RTN","LRVER3A",359,0) S D1=0 N A,LRPPURG "RTN","LRVER3A",360,0) I $D(LRSB(X)),LRSB(X)["pending",$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0))#2 D Q "RTN","LRVER3A",361,0) . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,4)="",$P(^(0),U,5,6)="^",$P(^(0),U,9)=+$G(LRM(X,"P")) "RTN","LRVER3A",362,0) . D REQ1 "RTN","LRVER3A",363,0) ; "RTN","LRVER3A",364,0) ; If required test with no result then store 'pending' and related info (NLT/LOINC codes, user and division). "RTN","LRVER3A",365,0) I '$D(LRSB(X)),$P($G(^LR(LRDFN,"CH",LRIDT,X)),U)="" D STOREP "RTN","LRVER3A",366,0) ; "RTN","LRVER3A",367,0) I '$D(LRSB(X)),$P($G(^LR(LRDFN,"CH",LRIDT,X)),U)'="pending" Q "RTN","LRVER3A",368,0) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0))#2 S $P(^(0),U,4,5)="^",A=$P(^(0),U,2) I A>49 S $P(^(0),U,2)=$S(A=50:9,1:A-50) "RTN","LRVER3A",369,0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0))#2 D "RTN","LRVER3A",370,0) . S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRT,+LRT)="" "RTN","LRVER3A",371,0) . S LRPPURG=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$G(LRM(X,"P")),0)),U,2) "RTN","LRVER3A",372,0) . S:'LRPPURG LRPPURG=$S($G(LRALERT):+LRALERT,1:9) "RTN","LRVER3A",373,0) . S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0)=+LRT_U_LRPPURG,$P(^(0),U,9)=+$G(LRM(X,"P")) "RTN","LRVER3A",374,0) . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),U,3)=+LRT,$P(^(0),U,4)=$P(^(0),U,4)+1 Q "RTN","LRVER3A",375,0) ; "RTN","LRVER3A",376,0) REQ1 ; "RTN","LRVER3A",377,0) Q:LRACD=LRAD "RTN","LRVER3A",378,0) I $D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0))#2,'$L($P(^(0),U,6)) S ^(0)=$P(^(0),U,1,2),$P(^(0),U,7)=1,$P(^(0),U,9)=+$G(LRM(X,"P")) "RTN","LRVER3A",379,0) K CNT,LRAMC "RTN","LRVER3A",380,0) Q "RTN","LRVER3A",381,0) ; "RTN","LRVER3A",382,0) ; "RTN","LRVER3A",383,0) STOREP ; Store pending as a result "RTN","LRVER3A",384,0) N LRX "RTN","LRVER3A",385,0) S LRX=$G(^LR(LRDFN,"CH",LRIDT,X)) "RTN","LRVER3A",386,0) S $P(LRX,"^")="pending" "RTN","LRVER3A",387,0) I $P(LRX,"^",3)="" S $P(LRX,"^",3)=$P($G(LRM(X,"P")),"^",2) "RTN","LRVER3A",388,0) S $P(LRX,"^",4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER3A",389,0) S $P(LRX,"^",9)=$S($G(DUZ(2)):DUZ(2),1:"") "RTN","LRVER3A",390,0) S ^LR(LRDFN,"CH",LRIDT,X)=LRX "RTN","LRVER3A",391,0) Q "RTN","LRVR1") 0^2^B64078428^B62383256 "RTN","LRVR1",1,0) LRVR1 ;DALOI/CJS/JAH - LAB ROUTINE DATA VERIFICATION;Sep 27, 2018@10:00:00 "RTN","LRVR1",2,0) ;;5.2;LAB SERVICE;**42,153,221,286,291,350,424,440,512,524**;Sep 27, 1994;Build 14 "RTN","LRVR1",3,0) ; "RTN","LRVR1",4,0) N LRBETST,LRBEY,LRI,LRN,LRPRGSQ "RTN","LRVR1",5,0) S (LRI,LRN)=0 "RTN","LRVR1",6,0) F S LRI=$O(^LAH(LRLL,1,"C",LRAN,LRI)) Q:LRI<1 D "RTN","LRVR1",7,0) . N LRX "RTN","LRVR1",8,0) . S LRX=$G(^LAH(LRLL,1,LRI,0)) "RTN","LRVR1",9,0) . ; Quit if different accession area. "RTN","LRVR1",10,0) . I $P(LRX,"^",3),$P(LRX,"^",3)'=LRAA Q "RTN","LRVR1",11,0) . ; Quit if different accession date and not a rollover accession (same original accession date). "RTN","LRVR1",12,0) . I $P(LRX,"^",4),$P(LRX,"^",4)'=LRAD,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",3)'=$P($G(^LRO(68,LRAA,1,$P(LRX,"^",4),1,LRAN,0)),"^",3) Q "RTN","LRVR1",13,0) . I LRN W ! "RTN","LRVR1",14,0) . S LRN=LRN+1,LRSQ=LRI,LRPRGSQ(LRI)="" "RTN","LRVR1",15,0) . W !,?2,"Seq #: ",LRI,?13," Accession: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^") "RTN","LRVR1",16,0) . I $P(LRX,"^",10) W ?40," Results received: ",$$FMTE^XLFDT($P(LRX,"^",10),"1M") "RTN","LRVR1",17,0) . W !,?20,"UID: ",$P($G(^LAH(LRLL,1,LRI,.3),"UNKNOWN"),"^") "RTN","LRVR1",18,0) . I $P(LRX,"^",11) W ?44," Last updated: ",$$FMTE^XLFDT($P(LRX,"^",11),"1M") "RTN","LRVR1",19,0) ; "RTN","LRVR1",20,0) ; If multiple sets of results then query user if they want to display a specific sequence "RTN","LRVR1",21,0) I LRN>1 D "RTN","LRVR1",22,0) . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y "RTN","LRVR1",23,0) . S DIR(0)="SO^0:Skip Display" "RTN","LRVR1",24,0) . S I=0 F S I=$O(LRPRGSQ(I)) Q:'I S DIR(0)=DIR(0)_";"_I_":Seq # "_I "RTN","LRVR1",25,0) . S DIR("A")="Display results associated with sequence #",DIR("B")="Skip Display" "RTN","LRVR1",26,0) . D ^DIR "RTN","LRVR1",27,0) . I Y<1 W ! Q "RTN","LRVR1",28,0) . D SEQDISP(LRLL,Y) "RTN","LRVR1",29,0) ; "RTN","LRVR1",30,0) G VER:LRN=1,T3:LRN>1 "RTN","LRVR1",31,0) ; "RTN","LRVR1",32,0) ; If attempting to verify reference lab results and no entry in LAH "RTN","LRVR1",33,0) ; associated with this accession then quit - do not allow manual entry "RTN","LRVR1",34,0) ; of ref lab results via this option. Will not store units/normals. "RTN","LRVR1",35,0) I $G(LRDUZ(2)),DUZ(2)'=LRDUZ(2) W !,"No data there" Q "RTN","LRVR1",36,0) ; "RTN","LRVR1",37,0) T1 R !,"What tray: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T1 "RTN","LRVR1",38,0) I X'="" S LRTRAY=X G T2 "RTN","LRVR1",39,0) I $D(^LRO(68.2,"AS",LRLL)) W !,"Can't MANUALLY add to a SEQUENCE instrument data file." G QUIT "RTN","LRVR1",40,0) W !,"Enter manually" S %=1 D YN^DICN G QUIT:%<1,T1:%=2 S LRSQ=-1 G VER "RTN","LRVR1",41,0) G VER "RTN","LRVR1",42,0) ; "RTN","LRVR1",43,0) T2 R !,"What cup: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T2 "RTN","LRVR1",44,0) Q:X="" "RTN","LRVR1",45,0) S LRTRCP=LRTRAY_";"_X I $L(LRTRCP)>200 S LRN=0 G T3 ;*424 - Do not allow string over 200 "RTN","LRVR1",46,0) K LRPRGSQ "RTN","LRVR1",47,0) S LRN=0 "RTN","LRVR1",48,0) F LRI=0:0 S LRI=$O(^LAH(LRLL,1,"B",LRTRCP,LRI)) Q:LRI<1 S LRN=LRN+1,LRSQ=LRI,LRPRGSQ(LRI)="" W !,?5,LRI "RTN","LRVR1",49,0) ; "RTN","LRVR1",50,0) T3 I LRN=0 W !,"No data for that tray & cup" Q "RTN","LRVR1",51,0) I LRN>1 R !,"Choose sequence number: ",X:DTIME Q:'$T I X["?"!(X'?.N) W !,"Enter a number" G T3 "RTN","LRVR1",52,0) I X["^"!(X="") K LRPRGSQ Q "RTN","LRVR1",53,0) S:LRN'=1 LRSQ=X "RTN","LRVR1",54,0) I '$D(^LAH(LRLL,1,LRSQ,0)) W !,"No data there" G T3 "RTN","LRVR1",55,0) ; "RTN","LRVR1",56,0) VER ; from LRFLAG, LRGP, LRVRW "RTN","LRVR1",57,0) N LRROOT "RTN","LRVR1",58,0) K LRTEST,LRNM,^TMP("LR",$J,"TMP") "RTN","LRVR1",59,0) S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") "RTN","LRVR1",60,0) ; "RTN","LRVR1",61,0) ; Determine if there are amended results to process via "EM" "RTN","LRVR1",62,0) S LRROOT=$Q(^LAH("LA7 AMENDED RESULTS",LRUID,1,LRLL)) "RTN","LRVR1",63,0) I LRROOT'="",$QS(LRROOT,1)="LA7 AMENDED RESULTS",$QS(LRROOT,2)=LRUID,$QS(LRROOT,4)=LRLL D Q "RTN","LRVR1",64,0) . W !!,"Amended results exist for this accession. Please process these" "RTN","LRVR1",65,0) . W !,"first using option Enter/verify/modify data (manual) [LRENTER]" "RTN","LRVR1",66,0) ; "RTN","LRVR1",67,0) D TEST "RTN","LRVR1",68,0) I $O(^TMP("LR",$J,"TMP",0))="" W !,"No tests in editing profile" Q "RTN","LRVR1",69,0) S X=DUZ D DUZ^LRX "RTN","LRVR1",70,0) G V2:LRSQ>0 "RTN","LRVR1",71,0) ; "RTN","LRVR1",72,0) L +^LAH(LRLL):DILOCKTM "RTN","LRVR1",73,0) I '$T Q "RTN","LRVR1",74,0) ; "RTN","LRVR1",75,0) S (^LAH(LRLL),LRSQ)=1+$G(^LAH(LRLL)) "RTN","LRVR1",76,0) S ^LAH(LRLL,1,LRSQ,0)="^^"_LRAA_"^"_LRAD_"^"_LRAN_"^^MANUAL" "RTN","LRVR1",77,0) D UID^LAGEN(LRLL,LRSQ,LRUID) "RTN","LRVR1",78,0) D UPDT^LAGEN(LRLL,LRSQ) "RTN","LRVR1",79,0) S ^LAH(LRLL,1,"C",LRAN,LRSQ)="" "RTN","LRVR1",80,0) L -^LAH(LRLL) "RTN","LRVR1",81,0) ; "RTN","LRVR1",82,0) V2 K LRPRGSQ(LRSQ) "RTN","LRVR1",83,0) S LRLLOC=0,LROUTINE=$P(^LAB(69.9,1,3),U,2) "RTN","LRVR1",84,0) I $D(^LRO(69,LRODT,1,LRSN,0)) S LRLLOC=$P(^(0),U,7) S:'$L(LRLLOC) LRLLOC=0 W !,$P(^LRO(69,LRODT,1,LRSN,1),U,6) "RTN","LRVR1",85,0) S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U) "RTN","LRVR1",86,0) I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",3) D "RTN","LRVR1",87,0) . N %DT,LRA1,LRA2,LRA3 "RTN","LRVR1",88,0) . S %DT("B")=$$FMTE^XLFDT(LRCDT,"1") "RTN","LRVR1",89,0) . S LRSTATUS="C",LRA1=LRAA,LRA2=LRAD,LRA3=LRAN "RTN","LRVR1",90,0) . D P15^LROE1 "RTN","LRVR1",91,0) . S LRAA=LRA1,LRAD=LRA2,LRAN=LRA3 "RTN","LRVR1",92,0) . I LRCDT<1 Q "RTN","LRVR1",93,0) . I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) S $P(^(3),U,3)=$$NOW^XLFDT "RTN","LRVR1",94,0) ; If user did not update then go to next "RTN","LRVR1",95,0) I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) Q "RTN","LRVR1",96,0) S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U) "RTN","LRVR1",97,0) I LRCDT<1 Q "RTN","LRVR1",98,0) S LREAL=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,2),LRALERT=LROUTINE "RTN","LRVR1",99,0) S I=0 "RTN","LRVR1",100,0) F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 I $G(^(I,0)) S LRAL=$P($G(^(0)),U,2) D "RTN","LRVR1",101,0) . I $G(LRAL) S LRALERT=$S(LRAL<50&(LRAL50&(LRAL-50>>>ERROR - NO POINTER TO FILE #63 - PLEASE NOTIFY SYSTEM MANAGER^ <<<<<",! Q "RTN","LRVR1",109,0) I '$D(^LR(LRDFN,LRSS,LRIDT,0)) W !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<^ <<<",! Q "RTN","LRVR1",110,0) ; "RTN","LRVR1",111,0) S LRCW=8 "RTN","LRVR1",112,0) LD S LRSS="CH" "RTN","LRVR1",113,0) ; "RTN","LRVR1",114,0) ; If bad entry then cleanup as best as possible. "RTN","LRVR1",115,0) I '($D(^LAH(LRLL,1,LRSQ,0))#2) D Q "RTN","LRVR1",116,0) . W !!?5,"No Data for this Accession ",!! "RTN","LRVR1",117,0) . D ZAPALL^LRVR3(LRLL,LRSQ) "RTN","LRVR1",118,0) . K LRPRGSQ "RTN","LRVR1",119,0) ; "RTN","LRVR1",120,0) ; Store any new methods with existing methods on file. "RTN","LRVR1",121,0) S LRMETH=$P(^LAH(LRLL,1,LRSQ,0),U,7) S:$D(LRGVP) LRMETH=LRMETH_"(GV)" "RTN","LRVR1",122,0) I $P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,8)'="" D "RTN","LRVR1",123,0) . N I,X "RTN","LRVR1",124,0) . S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,8) "RTN","LRVR1",125,0) . F I=1:1:$L(X,";") I $P(X,";",I)'="",LRMETH'[$P(X,";",I) S LRMETH=LRMETH_";"_$P(X,";",I) "RTN","LRVR1",126,0) I LRMETH'="" S $P(^LR(LRDFN,LRSS,LRIDT,0),U,8)=LRMETH "RTN","LRVR1",127,0) ; "RTN","LRVR1",128,0) S LRTM60=$$LRTM60^LRVR(LRCDT) "RTN","LRVR1",129,0) ; "RTN","LRVR1",130,0) W:$D(^LAB(62,+LRSAMP,0)) !,"Sample: ",$P(^(0),U) "RTN","LRVR1",131,0) ; "RTN","LRVR1",132,0) D ^LRVR2 "RTN","LRVR1",133,0) K LRDL,LRPRGSQ "RTN","LRVR1",134,0) Q ; leave LRVR1, back to LRVR "RTN","LRVR1",135,0) ; "RTN","LRVR1",136,0) ; "RTN","LRVR1",137,0) TEST ; from LRGV1 "RTN","LRVR1",138,0) N LRI,LRX "RTN","LRVR1",139,0) S LRI=0 "RTN","LRVR1",140,0) F S LRI=$O(^TMP("LR",$J,"VTO",LRI)) Q:LRI<1 K ^(LRI,"P") "RTN","LRVR1",141,0) S (LRI,LRNT)=0 "RTN","LRVR1",142,0) F S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:LRI<.5 I $D(^(LRI,0)),'$L($P(^(0),U,6)) S X=^(0) I $D(^TMP("LR",$J,"VTO",+X)) D "RTN","LRVR1",143,0) . ;LR*5.2*512: modified line below to always set the panel as the parent test "RTN","LRVR1",144,0) . ;line was formerly: "RTN","LRVR1",145,0) . ; . S LRNT=LRNT+1,LRTEST(LRNT)=+X,LRX=$S($P(X,"^",2)>50:$P(X,"^",9),1:$P(X,"^")) "RTN","LRVR1",146,0) . ;The line above may have been coded based on the urgency field in LR*5.2*291 "RTN","LRVR1",147,0) . ;which was released in 2006 but the functionality regarding bundling/unbundling "RTN","LRVR1",148,0) . ;was not implemented. "RTN","LRVR1",149,0) . S LRNT=LRNT+1,LRTEST(LRNT)=+X,LRX=$P(X,"^",9) "RTN","LRVR1",150,0) . I $P(X,"^",9),$P(X,"^")'=$P(X,"^",9),'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$P(X,"^",9))) S LRX=$P(X,"^",9) "RTN","LRVR1",151,0) . S LRTEST(LRNT,"P")=LRX_U_$$NLT^LRVER1(LRX)_"!" "RTN","LRVR1",152,0) . S ^TMP("LR",$J,"VTO",+X,"P")=$P(LRTEST(LRNT,"P"),"!") "RTN","LRVR1",153,0) ; "RTN","LRVR1",154,0) TEST1 ; from LRFLAG "RTN","LRVR1",155,0) ; "RTN","LRVR1",156,0) N LRI "RTN","LRVR1",157,0) F LRI=1:1:LRNT S:$D(^LAB(60,+LRTEST(LRI),0)) (LRTEST(LRI),LRBETST(LRI))=LRTEST(LRI)_U_^(0) "RTN","LRVR1",158,0) I $G(LRORDR)'="P" K ^TMP("LR",$J,"TMP") "RTN","LRVR1",159,0) S LRNX=0 "RTN","LRVR1",160,0) K LRM "RTN","LRVR1",161,0) F I=1:1 Q:'$D(LRTEST(I)) D "RTN","LRVR1",162,0) . S X=LRTEST(I),XP=$G(LRTEST(I,"P")) "RTN","LRVR1",163,0) . K LRTEST(I) "RTN","LRVR1",164,0) . D EX2 "RTN","LRVR1",165,0) K LRTEST "RTN","LRVR1",166,0) Q "RTN","LRVR1",167,0) ; "RTN","LRVR1",168,0) ; "RTN","LRVR1",169,0) EX2 ; "RTN","LRVR1",170,0) ; If dataname then process and quit "RTN","LRVR1",171,0) S LRSUB=$P(X,U,6) "RTN","LRVR1",172,0) I LRSUB'="" D Q "RTN","LRVR1",173,0) . S LRSB=$P(LRSUB,";",2) "RTN","LRVR1",174,0) . Q:'$D(LRVTS(LRSB)) "RTN","LRVR1",175,0) . I $D(^TMP("LR",$J,"TMP",LRSB)) S ^(LRSB,"P")=XP "RTN","LRVR1",176,0) . S ^TMP("LR",$J,"TMP",LRSB)=+X "RTN","LRVR1",177,0) . S XP=XP_$$RNLT^LRVER1(+X) "RTN","LRVR1",178,0) . S ^TMP("LR",$J,"TMP",LRSB,"P")=XP "RTN","LRVR1",179,0) . S:$P(X,U,18) LRM(LRSB)=+X,LRM(LRSB,"P")=XP "RTN","LRVR1",180,0) . S LRBEY(+X,LRSB)="" ; CIDC "RTN","LRVR1",181,0) ; "RTN","LRVR1",182,0) I $D(^LAB(60,+X,4)),$P(^(4),"^",2) S LRCFL=LRCFL_$P(^(4),"^",2)_U "RTN","LRVR1",183,0) ; "RTN","LRVR1",184,0) ; If panel then explode components of panel and "RTN","LRVR1",185,0) ; set parent("P" node) to file #60 test being exploded "RTN","LRVR1",186,0) S J=0 "RTN","LRVR1",187,0) F S J=$O(^LAB(60,+X,2,J)) Q:J<1 I $D(^(J,0))#2 D "RTN","LRVR1",188,0) . S Y=^LAB(60,+X,2,J,0) "RTN","LRVR1",189,0) . ;quit if merged or not performed - LR*5.2*524 "RTN","LRVR1",190,0) . Q:$L($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+Y,0)),U,6)) "RTN","LRVR1",191,0) . S LRNT=LRNT+1 "RTN","LRVR1",192,0) . S LRTEST(LRNT)=+Y_U_^LAB(60,+Y,0) "RTN","LRVR1",193,0) . S LRTEST(LRNT,"P")=+XP_U_$$NLT^LRVER1(+XP)_"!" "RTN","LRVR1",194,0) Q "RTN","LRVR1",195,0) ; "RTN","LRVR1",196,0) ; "RTN","LRVR1",197,0) QUIT Q "RTN","LRVR1",198,0) ; "RTN","LRVR1",199,0) ; "RTN","LRVR1",200,0) WAIT W !,"Type ""^"" to skip " "RTN","LRVR1",201,0) WAIT1 R X:10 "RTN","LRVR1",202,0) G LRVR1:X[U,WAIT1:$O(^LAH(LRLL,1,"C",LRAN,0))<1 "RTN","LRVR1",203,0) G LRVR1 "RTN","LRVR1",204,0) ; "RTN","LRVR1",205,0) ; "RTN","LRVR1",206,0) SEQDISP(LRLL,LRISQN) ; Display test results for a LAH entry. "RTN","LRVR1",207,0) ; Call with LRLL = ien of enry in LAH "RTN","LRVR1",208,0) ; LRISQN = sequence ien of enry in LAH "RTN","LRVR1",209,0) ; "RTN","LRVR1",210,0) N LR60,LRI,LRJ,LRSB,LRX,LRY "RTN","LRVR1",211,0) ; "RTN","LRVR1",212,0) W !!,"Results for Sequence #"_LRISQN "RTN","LRVR1",213,0) ; "RTN","LRVR1",214,0) I $O(^LAH(LRLL,1,LRISQN,1)) D "RTN","LRVR1",215,0) . W !,"Test",?25,"Value",?40,"Flag",?50,"Units" "RTN","LRVR1",216,0) . W !,"----",?25,"-----",?40,"----",?50,"-----" "RTN","LRVR1",217,0) ; "RTN","LRVR1",218,0) ; Display CH subsript results. "RTN","LRVR1",219,0) S LRSB=1 "RTN","LRVR1",220,0) F S LRSB=$O(^LAH(LRLL,1,LRISQN,LRSB)) Q:LRSB<1 D "RTN","LRVR1",221,0) . S LRX=^LAH(LRLL,1,LRISQN,LRSB) "RTN","LRVR1",222,0) . S LR60=+$O(^LAB(60,"C","CH;"_LRSB_";1",0)) "RTN","LRVR1",223,0) . S LR60(0)=$G(^LAB(60,LR60,0)) "RTN","LRVR1",224,0) . W !,$E($P(LR60(0),"^"),1,24),?25," ",$P(LRX,"^"),?39," ",$P(LRX,"^",2),?49," ",$P($P(LRX,"^",5),"!",7) "RTN","LRVR1",225,0) ; "RTN","LRVR1",226,0) ; Display comments "RTN","LRVR1",227,0) I $D(^LAH(LRLL,1,LRISQN,1)) D "RTN","LRVR1",228,0) . W !,"Comments" "RTN","LRVR1",229,0) . S (LRI,LRY)=0,LRJ="" "RTN","LRVR1",230,0) . F S LRY=$O(^LAH(LRLL,1,LRISQN,1,LRY)) Q:LRY<1 D "RTN","LRVR1",231,0) . . S LRX=^LAH(LRLL,1,LRISQN,1,LRY),LRI=LRI+1 "RTN","LRVR1",232,0) . . W !,"#",LRI," ",$P(LRX,"^") "RTN","LRVR1",233,0) . . I $P(LRX,"^",2) S LRJ=LRJ_$S(LRJ'="":",",1:"")_LRJ "RTN","LRVR1",234,0) . W !,"Comments # ",LRJ," previously processed" "RTN","LRVR1",235,0) ; "RTN","LRVR1",236,0) W ! "RTN","LRVR1",237,0) ; "RTN","LRVR1",238,0) Q "VER") 8.0^22.2 "BLD",11501,6) ^433 **END** **END**