Released LR*5.2*545 SEQ #446 Extracted from mail message **KIDS**:LR*5.2*545^ **INSTALL NAME** LR*5.2*545 "BLD",12182,0) LR*5.2*545^LAB SERVICE^0^3210526^y "BLD",12182,1,0) ^^6^6^3210412^ "BLD",12182,1,1,0) This patch addresses the following issues: "BLD",12182,1,2,0) "BLD",12182,1,3,0) If a test is canceled from an accession or merged to another accession "BLD",12182,1,4,0) after the accession has been resulted on an instrument, it is possible to "BLD",12182,1,5,0) verify a result on the canceled or merged test using option "Enter/verify "BLD",12182,1,6,0) data (auto instrument) (LRVR)". "BLD",12182,4,0) ^9.64PA^^ "BLD",12182,6) 2 "BLD",12182,6.3) 5 "BLD",12182,"ABPKG") n "BLD",12182,"KRN",0) ^9.67PA^1.5^25 "BLD",12182,"KRN",.4,0) .4 "BLD",12182,"KRN",.401,0) .401 "BLD",12182,"KRN",.402,0) .402 "BLD",12182,"KRN",.403,0) .403 "BLD",12182,"KRN",.5,0) .5 "BLD",12182,"KRN",.84,0) .84 "BLD",12182,"KRN",1.5,0) 1.5 "BLD",12182,"KRN",1.6,0) 1.6 "BLD",12182,"KRN",1.61,0) 1.61 "BLD",12182,"KRN",1.62,0) 1.62 "BLD",12182,"KRN",3.6,0) 3.6 "BLD",12182,"KRN",3.8,0) 3.8 "BLD",12182,"KRN",9.2,0) 9.2 "BLD",12182,"KRN",9.8,0) 9.8 "BLD",12182,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",12182,"KRN",9.8,"NM",1,0) LRVER3A^^0^B238929163 "BLD",12182,"KRN",9.8,"NM","B","LRVER3A",1) "BLD",12182,"KRN",19,0) 19 "BLD",12182,"KRN",19.1,0) 19.1 "BLD",12182,"KRN",101,0) 101 "BLD",12182,"KRN",409.61,0) 409.61 "BLD",12182,"KRN",771,0) 771 "BLD",12182,"KRN",779.2,0) 779.2 "BLD",12182,"KRN",870,0) 870 "BLD",12182,"KRN",8989.51,0) 8989.51 "BLD",12182,"KRN",8989.52,0) 8989.52 "BLD",12182,"KRN",8993,0) 8993 "BLD",12182,"KRN",8994,0) 8994 "BLD",12182,"KRN","B",.4,.4) "BLD",12182,"KRN","B",.401,.401) "BLD",12182,"KRN","B",.402,.402) "BLD",12182,"KRN","B",.403,.403) "BLD",12182,"KRN","B",.5,.5) "BLD",12182,"KRN","B",.84,.84) "BLD",12182,"KRN","B",1.5,1.5) "BLD",12182,"KRN","B",1.6,1.6) "BLD",12182,"KRN","B",1.61,1.61) "BLD",12182,"KRN","B",1.62,1.62) "BLD",12182,"KRN","B",3.6,3.6) "BLD",12182,"KRN","B",3.8,3.8) "BLD",12182,"KRN","B",9.2,9.2) "BLD",12182,"KRN","B",9.8,9.8) "BLD",12182,"KRN","B",19,19) "BLD",12182,"KRN","B",19.1,19.1) "BLD",12182,"KRN","B",101,101) "BLD",12182,"KRN","B",409.61,409.61) "BLD",12182,"KRN","B",771,771) "BLD",12182,"KRN","B",779.2,779.2) "BLD",12182,"KRN","B",870,870) "BLD",12182,"KRN","B",8989.51,8989.51) "BLD",12182,"KRN","B",8989.52,8989.52) "BLD",12182,"KRN","B",8993,8993) "BLD",12182,"KRN","B",8994,8994) "BLD",12182,"QDEF") ^^^^NO^^^^NO^^NO "BLD",12182,"QUES",0) ^9.62^^ "BLD",12182,"REQB",0) ^9.611^1^1 "BLD",12182,"REQB",1,0) LR*5.2*538^1 "BLD",12182,"REQB","B","LR*5.2*538",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) 545^3210526 "PKG",26,22,1,"PAH",1,1,0) ^^6^6^3210526 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses the following issues: "PKG",26,22,1,"PAH",1,1,2,0) "PKG",26,22,1,"PAH",1,1,3,0) If a test is canceled from an accession or merged to another accession "PKG",26,22,1,"PAH",1,1,4,0) after the accession has been resulted on an instrument, it is possible to "PKG",26,22,1,"PAH",1,1,5,0) verify a result on the canceled or merged test using option "Enter/verify "PKG",26,22,1,"PAH",1,1,6,0) data (auto instrument) (LRVR)". "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","LRVER3A") 0^1^B238929163^B224170360 "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,538,545**;Sep 27, 1994;Build 5 "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) . ;LR*5.2*545: Test might have been run on instrument and then canceled "RTN","LRVER3A",23,0) . ; or merged to another accession. "RTN","LRVER3A",24,0) . ; Do not verify results for canceled or merged tests. "RTN","LRVER3A",25,0) . ;Only checking for "Not Performed" and "Merged" in case other dispositions "RTN","LRVER3A",26,0) . ;are added in future releases. "RTN","LRVER3A",27,0) . Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),U,6)["*Not Performed"!($P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),U,6)["*Merged") "RTN","LRVER3A",28,0) . I $S(LRVCHK<1:1,$D(LRSB(LRVCHK))#2:1,1:0) D "RTN","LRVER3A",29,0) . . I $D(LRSB(LRVCHK)) Q:$P(LRSB(LRVCHK),U)="" "RTN","LRVER3A",30,0) . . I LRVCHK<1,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),U,6)'="" Q "RTN","LRVER3A",31,0) . . ; "RTN","LRVER3A",32,0) . . ;LR7OB3 will correctly evaluate the panel status due to setting of ^XTMP("LR",$J,"PANEL".. "RTN","LRVER3A",33,0) . . ;Panel statuses (i.e LRVCHK<1) will be set after all component statuses are "RTN","LRVER3A",34,0) . . ;evaluated "RTN","LRVER3A",35,0) . . I LRVCHK>1 D "RTN","LRVER3A",36,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",37,0) . . . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",38,0) . . . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",39,0) . . S LRORTST(LRT)="" "RTN","LRVER3A",40,0) . . ; "RTN","LRVER3A",41,0) . . I LRVCHK>1,LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0)) D "RTN","LRVER3A",42,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",43,0) . . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",44,0) . . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,+LRT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",45,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",46,0) . . K A2(LRT) "RTN","LRVER3A",47,0) ; "RTN","LRVER3A",48,0) S D1=1,X=0 "RTN","LRVER3A",49,0) F S X=$O(^TMP("LR",$J,"TMP",X)) Q:X<1 S LRT=+^(X) I $D(LRM(X)) D REQ "RTN","LRVER3A",50,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",51,0) ;LR*5.2*524 - line below was moved to after the "PANEL" call "RTN","LRVER3A",52,0) ;keeping previous location commented out below in case it is needed for later research "RTN","LRVER3A",53,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",54,0) ; Class I CareVue routine TASKED if CareVue ward - pwc/10-2000 "RTN","LRVER3A",55,0) D "RTN","LRVER3A",56,0) . N I,LR7DLOC D IN5^VADPT S LR7DLOC=$G(^DIC(42,+$P($G(VAIP(5)),"^"),44)) "RTN","LRVER3A",57,0) . Q:'LR7DLOC D:$D(^LAB(62.487,"C",LR7DLOC)) ;good ward location "RTN","LRVER3A",58,0) . . S ZTRTN="^LA7DLOC",ZTDESC="LAB AUTOMATION CAREVUE SUPPORTED WARDS" "RTN","LRVER3A",59,0) . . S ZTIO="",ZTDTH=$H,ZTSAVE("L*")="" D ^%ZTLOAD "RTN","LRVER3A",60,0) . . K ZTSAVE,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTREQ,ZTQUEUED "RTN","LRVER3A",61,0) ; "RTN","LRVER3A",62,0) ;LR*5.2*524 - line below was moved to after the "PANEL" call "RTN","LRVER3A",63,0) ;keeping previous location commented out below in case it is needed for later research "RTN","LRVER3A",64,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",65,0) D XREF I $D(^LRO(68,LRAA,.2))'[0 X ^(.2) "RTN","LRVER3A",66,0) ; "RTN","LRVER3A",67,0) ;LR*5.2*512 added panel evaluation which builds ^TMP("LR",$J,"PANEL",order number)=status "RTN","LRVER3A",68,0) ;Routine LR7OB3 evaluates the panel status before setting "CM" or "SC" in the ORC segment. "RTN","LRVER3A",69,0) D PANEL "RTN","LRVER3A",70,0) ; "RTN","LRVER3A",71,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",72,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",73,0) N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE",,.LRORTST) "RTN","LRVER3A",74,0) L -^LR(LRDFN,LRSS,LRIDT) ; unlock "RTN","LRVER3A",75,0) ;second kill to be safe "RTN","LRVER3A",76,0) K ^TMP("LR",$J,"PANEL") "RTN","LRVER3A",77,0) Q "RTN","LRVER3A",78,0) ; "RTN","LRVER3A",79,0) ; "RTN","LRVER3A",80,0) XREF ; from COM1^LRVER4, LRTSTOUT and VER^LRVER3A "RTN","LRVER3A",81,0) I LRDPF=62.3 S ^LRO(68,LRAA,1,LRAD,1,"AD",DT,LRAN)="" Q "RTN","LRVER3A",82,0) S LRPRAC=$$PRAC^LRX($P(^LR(LRDFN,LRSS,LRIDT,0),U,10)) ;get doc name "RTN","LRVER3A",83,0) S ^LRO(68,LRAA,1,LRAD,1,"AD",DT,LRAN)="" "RTN","LRVER3A",84,0) S ^LRO(69,9999999-LRIDT\1,1,"AP",LRPRAC,$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",85,0) I $G(LRLLOC)'="" D "RTN","LRVER3A",86,0) . S ^LRO(69,9999999-LRIDT\1,1,"AL",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",87,0) . S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="" "RTN","LRVER3A",88,0) . S ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="" "RTN","LRVER3A",89,0) . S ^LRO(69,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="" "RTN","LRVER3A",90,0) I LRDPF=2 D CHSET^LRPX(LRDFN,LRIDT) "RTN","LRVER3A",91,0) Q:'$P(LRPARAM,U,3) "RTN","LRVER3A",92,0) ; "RTN","LRVER3A",93,0) TSKM ; "RTN","LRVER3A",94,0) N KK,ZTSK,ZTRTN,ZTDTH,ZTSAVE,ZTIO "RTN","LRVER3A",95,0) F KK="LRDFN","LRAA","LRAOD","LRAD","LRAN","LRIDT","LRSS","LRLLOC","LRSN","LRODT" S ZTSAVE(KK)="" "RTN","LRVER3A",96,0) S ZTRTN="DQ^LRTP",ZTIO="",ZTDTH=$H,ZTDESC="LAB INTERIM REPORTS" D ^%ZTLOAD "RTN","LRVER3A",97,0) Q "RTN","LRVER3A",98,0) ; "RTN","LRVER3A",99,0) PANEL ; "RTN","LRVER3A",100,0) ;LRCOMP - array which updates parent levels in file 68 "RTN","LRVER3A",101,0) ;LRCOMP2 - array used to update file 100 "RTN","LRVER3A",102,0) N LRPNL,LRCOMP,LRCOMP2,LRPARENT,LR69TST,LRORDTST,LRDONE,LROR100,LRCPORD "RTN","LRVER3A",103,0) D PANEL1,PANEL2 "RTN","LRVER3A",104,0) ;^TMP("LR",$J,"PANEL" used by LR7OB3 to update CPRS status "RTN","LRVER3A",105,0) S LRPARENT="" "RTN","LRVER3A",106,0) F S LRPARENT=$O(LRCOMP(LRPARENT)) Q:'LRPARENT D "RTN","LRVER3A",107,0) . ;if only an atomic test was specified in a subsequent verification "RTN","LRVER3A",108,0) . ;session, only the parent might have been set into the A2 array "RTN","LRVER3A",109,0) . ;A2 is used to determine whether the overall status of the accession at "RTN","LRVER3A",110,0) . ;the "3" subscript should be set to complete "RTN","LRVER3A",111,0) . I LRCOMP2(LRPARENT) K A2(LRPARENT) "RTN","LRVER3A",112,0) . S LRORDTST=$G(LROR100(LRPARENT)) "RTN","LRVER3A",113,0) . Q:LRORDTST']"" "RTN","LRVER3A",114,0) . ;This parent was not ordered in CPRS as the overall panel. "RTN","LRVER3A",115,0) . Q:'$D(LRCPORD(LRORDTST,LRPARENT)) "RTN","LRVER3A",116,0) . S ^TMP("LR",$J,"PANEL",LRORDTST)=LRCOMP2(LRPARENT) "RTN","LRVER3A",117,0) Q "RTN","LRVER3A",118,0) ; "RTN","LRVER3A",119,0) PANEL1 ;gather panel components and related information "RTN","LRVER3A",120,0) ; "RTN","LRVER3A",121,0) N LRTST,LRSTR,LRPANX,LRSUBAR,LR68X,LRPANELX "RTN","LRVER3A",122,0) S LRTST=0 "RTN","LRVER3A",123,0) F S LRTST=$O(^TMP("LR",$J,"VTO",LRTST)) Q:'LRTST D "RTN","LRVER3A",124,0) . ;check to see if the test is a panel within a panel "RTN","LRVER3A",125,0) . ;LRCOMP is initially set to "not complete". If any component is verified/complete, "RTN","LRVER3A",126,0) . ;the status will be set to "complete" for a later complete date/time set in file 68 "RTN","LRVER3A",127,0) . ;at subscript 4 for the panel. "RTN","LRVER3A",128,0) . ;LRCOMP2 is initially set to "complete". If any components are NOT verified/complete, "RTN","LRVER3A",129,0) . ;the status will be set to "not complete" for later determination of file 100 "RTN","LRVER3A",130,0) . ;status. "RTN","LRVER3A",131,0) . I $O(^LAB(60,LRTST,2,0)),'$D(LRCOMP(LRTST)) S LRCOMP(LRTST)=0,LRCOMP2(LRTST)=1 "RTN","LRVER3A",132,0) . S LRPARENT=$P($G(^TMP("LR",$J,"VTO",LRTST,"P")),U) "RTN","LRVER3A",133,0) . ;not a panel, so quit "RTN","LRVER3A",134,0) . I LRPARENT']""!('$O(^LAB(60,+LRPARENT,2,0))) Q "RTN","LRVER3A",135,0) . ;initialize if first time evaluating this parent "RTN","LRVER3A",136,0) . I '$D(LRCOMP(LRPARENT)) S LRCOMP(LRPARENT)=0,LRCOMP2(LRPARENT)=1 "RTN","LRVER3A",137,0) . ;panel should be set in LRORTST array for use by "RTN","LRVER3A",138,0) . ;downstream LR7OB* routines "RTN","LRVER3A",139,0) . S LRORTST(LRPARENT)="" "RTN","LRVER3A",140,0) . ;does this panel contain other panels "RTN","LRVER3A",141,0) . D SUBPAN(LRPARENT) "RTN","LRVER3A",142,0) D OR100 "RTN","LRVER3A",143,0) F S LRTST=$O(LRCOMP(LRTST)) Q:'LRTST D "RTN","LRVER3A",144,0) . ;check whether all atomic tests have correct status, etc. "RTN","LRVER3A",145,0) . D ATOMIC(LRTST) "RTN","LRVER3A",146,0) . ;retrieve all atomic tests for this parent "RTN","LRVER3A",147,0) . I '$D(LRPNL(LRTST)) D LRTST(LRTST,LRTST,1) "RTN","LRVER3A",148,0) . ;If there are still no LRPNL array entries, there are no required tests "RTN","LRVER3A",149,0) . ;in this panel. In that case, set LRCOMP to 1 so that the panel in file 68 will "RTN","LRVER3A",150,0) . ;be marked as complete if any tests have been verified. "RTN","LRVER3A",151,0) . I '$D(LRPNL(LRTST)),$G(LRPANELX(LRTST)) S LRCOMP(LRTST)=1 "RTN","LRVER3A",152,0) Q "RTN","LRVER3A",153,0) ; "RTN","LRVER3A",154,0) SUBPAN(LRPRCHK) ; "RTN","LRVER3A",155,0) ;find all sub-panels within panels "RTN","LRVER3A",156,0) N LRSUBPXN,LRSUBTST "RTN","LRVER3A",157,0) S LRSUBPXN=0 "RTN","LRVER3A",158,0) F S LRSUBPXN=$O(^LAB(60,LRPRCHK,2,LRSUBPXN)) Q:'LRSUBPXN D "RTN","LRVER3A",159,0) . S LRSUBTST=$P($G(^LAB(60,LRPRCHK,2,LRSUBPXN,0)),U) "RTN","LRVER3A",160,0) . Q:LRSUBTST']"" "RTN","LRVER3A",161,0) . ;If the test being verified is a component of a panel within a panel, and the "RTN","LRVER3A",162,0) . ;user selected only the test (not "all"), the package reference field in file 100 "RTN","LRVER3A",163,0) . ;won't be set by downstream routines if LRORTST isn't set for the sub-panel. "RTN","LRVER3A",164,0) . I LRSUBTST=LRTST S LRORTST(LRPRCHK)="" "RTN","LRVER3A",165,0) . I $O(^LAB(60,LRSUBTST,2,0))]"" D "RTN","LRVER3A",166,0) . . ;this is also a panel "RTN","LRVER3A",167,0) . . I '$D(LRCOMP(LRSUBTST)) S LRCOMP(LRSUBTST)=0,LRCOMP2(LRSUBTST)=1 "RTN","LRVER3A",168,0) . . ;will need to later evaluate all components of this panel "RTN","LRVER3A",169,0) . . ;to determine whether any are also panels "RTN","LRVER3A",170,0) . . S LRSUBAR(LRSUBTST)="" "RTN","LRVER3A",171,0) ;not finished yet going through LRSUBAR2 "RTN","LRVER3A",172,0) I $O(LRSUBAR2(LRPRCHK))'="" Q "RTN","LRVER3A",173,0) ; "RTN","LRVER3A",174,0) N LRSUBAR2 "RTN","LRVER3A",175,0) I $O(LRSUBAR(0))]"" D "RTN","LRVER3A",176,0) . N LRSUBSQ "RTN","LRVER3A",177,0) . ;LRSUBAR might be re-set so need to keep values for this loop "RTN","LRVER3A",178,0) . ;in LRSUBAR2 "RTN","LRVER3A",179,0) . M LRSUBAR2=LRSUBAR "RTN","LRVER3A",180,0) . K LRSUBAR "RTN","LRVER3A",181,0) . S LRSUBSQ=0 "RTN","LRVER3A",182,0) . F S LRSUBSQ=$O(LRSUBAR2(LRSUBSQ)) Q:'LRSUBSQ D SUBPAN(LRSUBSQ) "RTN","LRVER3A",183,0) Q "RTN","LRVER3A",184,0) ; "RTN","LRVER3A",185,0) OR100 ; "RTN","LRVER3A",186,0) ;are parents a sub-panel under a profile which was ordered "RTN","LRVER3A",187,0) N LRX69,LRX100,LRX10143,LRX60 "RTN","LRVER3A",188,0) S LRX69=0 "RTN","LRVER3A",189,0) F S LRX69=$O(^LRO(69,LRODT,1,LRSN,2,LRX69)) Q:'LRX69 D "RTN","LRVER3A",190,0) . S LRX100=$P($G(^LRO(69,LRODT,1,LRSN,2,LRX69,0)),U,7) "RTN","LRVER3A",191,0) . Q:LRX100']"" "RTN","LRVER3A",192,0) . ;used later in PANEL to find order number again "RTN","LRVER3A",193,0) . S LRX60=$P($G(^LRO(69,LRODT,1,LRSN,2,LRX69,0)),U) Q:LRX60="" "RTN","LRVER3A",194,0) . S LROR100(LRX60)=LRX100 "RTN","LRVER3A",195,0) . S LRX10143=0 "RTN","LRVER3A",196,0) . F S LRX10143=$O(^OR(100,LRX100,.1,"B",LRX10143)) Q:'LRX10143 D "RTN","LRVER3A",197,0) . . S LRX60=$P($P($G(^ORD(101.43,LRX10143,0)),U,2),";") "RTN","LRVER3A",198,0) . . ;store Lab test which was ordered in CPRS for each "RTN","LRVER3A",199,0) . . ;order number - validates in PANEL section before setting "RTN","LRVER3A",200,0) . . ;^TMP("LR",$J,"PANEL" which is used by LR7OB3 to determine "RTN","LRVER3A",201,0) . . ;CPRS order status of active or complete "RTN","LRVER3A",202,0) . . ;If this parent is a sub-panel under a profile which was ordered, "RTN","LRVER3A",203,0) . . ;the value of LRX60 will differ from the value of LRPARENT "RTN","LRVER3A",204,0) . . Q:LRX60']"" "RTN","LRVER3A",205,0) . . S LRCPORD(LRX100,LRX60)="" "RTN","LRVER3A",206,0) . . ;if ordered test is not yet in LRCOMP, add because overall status "RTN","LRVER3A",207,0) . . ;needs to be determined "RTN","LRVER3A",208,0) . . I '$D(LRCOMP(LRX60)),$O(^LAB(60,LRX60,2,0))]"" S LRCOMP(LRX60)=0,LRCOMP2(LRX60)=1 "RTN","LRVER3A",209,0) Q "RTN","LRVER3A",210,0) ; "RTN","LRVER3A",211,0) ATOMIC(LR68X) ; "RTN","LRVER3A",212,0) ;if component has been resulted but has been set previously "RTN","LRVER3A",213,0) ;into ^LRO(68, the LRCAP* routines won't update the complete date "RTN","LRVER3A",214,0) ;correcting the issue here so that all panel related logic is "RTN","LRVER3A",215,0) ;in one place "RTN","LRVER3A",216,0) ; "RTN","LRVER3A",217,0) N LR63,LR68Y,LR68Z,LR63RES "RTN","LRVER3A",218,0) S LR63=$P($P(^LAB(60,LR68X,0),U,5),";",2),LR63RES=0 "RTN","LRVER3A",219,0) ;LRPNLX is used to track whether at least one component of a panel which contains "RTN","LRVER3A",220,0) ;only non-required tests has been resulted. "RTN","LRVER3A",221,0) I LR63]"",$D(LRSB(LR63)),$P(LRSB(LR63),U)]"",$P(LRSB(LR63),U)'["pending" D "RTN","LRVER3A",222,0) . S LR63RES=1 "RTN","LRVER3A",223,0) . S LRPANELX(LR68X)=1 "RTN","LRVER3A",224,0) I LR63RES,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0)) D "RTN","LRVER3A",225,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",226,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR68X,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",227,0) . ;kill component out of A2 (if present) if it wasn't exploded out in ^TMP("LR",$J,"VT" "RTN","LRVER3A",228,0) . K A2(LR68X) "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,LRAD,1,LRAN,4,LR68X,0),U,6) S $P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",232,0) . I $G(LRACD)]"",LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0)) D "RTN","LRVER3A",233,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",234,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",235,0) . . ;not setting workload suffix field (#8) if disposition field (#6) is already set "RTN","LRVER3A",236,0) . . ;so as to not affect workload already counted "RTN","LRVER3A",237,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LR68X,0),U,6) S $P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",238,0) ;check atomic tests if this test is a panel which has not been broken out in ^TMP("LR",$J,"VTO" "RTN","LRVER3A",239,0) I $O(^LAB(60,LR68X,2,0))]"" D "RTN","LRVER3A",240,0) . S LR68Y=0 "RTN","LRVER3A",241,0) . F S LR68Y=$O(^LAB(60,LR68X,2,LR68Y)) Q:'LR68Y D "RTN","LRVER3A",242,0) . . S LR68Z=$P(^LAB(60,LR68X,2,LR68Y,0),U) "RTN","LRVER3A",243,0) . . I LR68Z]"" D ATOMIC(LR68Z) "RTN","LRVER3A",244,0) . . I $G(LRPANELX(LR68Z)) S LRPANELX(LR68X)=1 "RTN","LRVER3A",245,0) Q "RTN","LRVER3A",246,0) ; "RTN","LRVER3A",247,0) LRTST(LRPARENT,LRSUB,LRGO) ; "RTN","LRVER3A",248,0) ;retrieve all required tests for a panel "RTN","LRVER3A",249,0) N LRA,LRTEST,LRTESTX,LRDISP,LRTX,LRPANZ,LRAAX "RTN","LRVER3A",250,0) S LRA=0 "RTN","LRVER3A",251,0) F S LRA=$O(^LAB(60,LRSUB,2,LRA)) Q:'LRA D "RTN","LRVER3A",252,0) . S LRTEST=+$G(^LAB(60,LRSUB,2,LRA,0)) Q:'LRTEST "RTN","LRVER3A",253,0) . I $O(^LAB(60,LRTEST,2,0))]"" D Q "RTN","LRVER3A",254,0) . . ;this is a panel within a panel - store for later evaluation "RTN","LRVER3A",255,0) . . S LRPANZ(LRTEST)="" "RTN","LRVER3A",256,0) . ;check to see if this test is a required test "RTN","LRVER3A",257,0) . I $P($G(^LAB(60,LRTEST,0)),U,17) D "RTN","LRVER3A",258,0) . . ;get information for each atomic test within the panel "RTN","LRVER3A",259,0) . . D LRPNL "RTN","LRVER3A",260,0) ;if LRGO is 0, panels within panels are being evaluated "RTN","LRVER3A",261,0) ;so need to store off the panels within panels within panels "RTN","LRVER3A",262,0) I 'LRGO,$D(LRPANZ) M LRPANZ1=LRPANZ "RTN","LRVER3A",263,0) ; "RTN","LRVER3A",264,0) I LRGO,$D(LRPANZ1) M LRPANZ=LRPANZ1 K LRPANZ1 "RTN","LRVER3A",265,0) ; "RTN","LRVER3A",266,0) ;break down panels within panels "RTN","LRVER3A",267,0) I $D(LRPANZ),LRGO D "RTN","LRVER3A",268,0) . ;must merge to new array because LRPANZ might be "RTN","LRVER3A",269,0) . ;re-created for panels within panels within panels... "RTN","LRVER3A",270,0) . K LRPANX "RTN","LRVER3A",271,0) . M LRPANX=LRPANZ K LRPANZ "RTN","LRVER3A",272,0) . S LRB="",LRDONE=0 "RTN","LRVER3A",273,0) . F S LRB=$O(LRPANX(LRB)) Q:'LRB D "RTN","LRVER3A",274,0) . . ;flag that this is the last entry in the array indicates "RTN","LRVER3A",275,0) . . ;that may continue looking for panel within a panel "RTN","LRVER3A",276,0) . . I $O(LRPANX(LRB))="" S LRDONE=1 "RTN","LRVER3A",277,0) . . D LRTST(LRPARENT,LRB,LRDONE) "RTN","LRVER3A",278,0) . ; "RTN","LRVER3A",279,0) . ;a second kill of LRPANX is needed for certain situations "RTN","LRVER3A",280,0) . ;when a single panel is embedded within another panel. "RTN","LRVER3A",281,0) . ;Execution occurs twice which causes no harm, but adding "RTN","LRVER3A",282,0) . ;second kill in case a situation occurs which would cause "RTN","LRVER3A",283,0) . ;an endless loop. "RTN","LRVER3A",284,0) . K LRPANX "RTN","LRVER3A",285,0) Q "RTN","LRVER3A",286,0) ; "RTN","LRVER3A",287,0) LRPNL ; "RTN","LRVER3A",288,0) N LRTX,LRSTR,LRAAX,LRADX,LRANX,LRIDTX,LRTXI "RTN","LRVER3A",289,0) S LRTX=$P(^LAB(60,LRTEST,0),U,5) "RTN","LRVER3A",290,0) Q:LRTX']"" "RTN","LRVER3A",291,0) ;LR*5.2*538 - allow for the fact that a test might exist on more than "RTN","LRVER3A",292,0) ; one subscript "RTN","LRVER3A",293,0) S LRTXI=0 "RTN","LRVER3A",294,0) LRPNL1 ; "RTN","LRVER3A",295,0) S LR69TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRSUB,LRTXI)) "RTN","LRVER3A",296,0) I LR69TST,$P($G(^LRO(69,LRODT,1,LRSN,2,LR69TST,0)),U,9)="CA" S LRTXI=LR69TST G LRPNL1 "RTN","LRVER3A",297,0) ;Accession area and accession number might differ among components "RTN","LRVER3A",298,0) I 'LR69TST S LR69TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRTEST,LRTXI)) "RTN","LRVER3A",299,0) I LR69TST,$P($G(^LRO(69,LRODT,1,LRSN,2,LR69TST,0)),U,9)="CA" S LRTXI=LR69TST G LRPNL1 "RTN","LRVER3A",300,0) Q:'LR69TST "RTN","LRVER3A",301,0) S LRSTR=$G(^LRO(69,LRODT,1,LRSN,2,LR69TST,0)) "RTN","LRVER3A",302,0) S LRAAX=$P(LRSTR,U,4) "RTN","LRVER3A",303,0) S LRADX=$P(LRSTR,U,3) "RTN","LRVER3A",304,0) S LRANX=$P(LRSTR,U,5) "RTN","LRVER3A",305,0) S LRIDTX=$P($G(^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,3)),U,5) "RTN","LRVER3A",306,0) ;LRPNL(LRPARENT,LRTEST)=File 63 dept (2nd) subscript^File 63 test (4rd) subscript^accession area "RTN","LRVER3A",307,0) ; ^accession date^accession number^File 63 inverted date/time (3rd) subscript "RTN","LRVER3A",308,0) S LRPNL(LRPARENT,LRTEST)=$P(LRTX,";")_U_$P(LRTX,";",2)_U_LRAAX_U_LRADX_U_LRANX_U_LRIDTX "RTN","LRVER3A",309,0) Q "RTN","LRVER3A",310,0) ; "RTN","LRVER3A",311,0) PANEL2 ; "RTN","LRVER3A",312,0) ;evaluate all components / atomic tests of each parent "RTN","LRVER3A",313,0) N LRPARENT,LRTX,LRTSTX,LRSTR,LR63X,LRAAX,LRADX,LRANX,LRIDTX,LRADX2,LR63STR "RTN","LRVER3A",314,0) ; "RTN","LRVER3A",315,0) ;LRPNL(PARENT,TEST NUMBER)=FILE 63 DEPT (2ND) SUBSCRIPT_"^"_TEST (4TH) SUBSCRIPT IN FILE 63 "RTN","LRVER3A",316,0) ; _"^"_ACCESSION AREA IN FILE 68_"^"_ACCESSION DATE_"^"_ "RTN","LRVER3A",317,0) ; ACCESSION NUMBER"_"^"_FILE 63 INVERTED DATE/TIME (3RD) SUBSCRIPT "RTN","LRVER3A",318,0) ; "RTN","LRVER3A",319,0) S (LRPARENT,LRTSTX)="" "RTN","LRVER3A",320,0) F S LRPARENT=$O(LRPNL(LRPARENT)) Q:LRPARENT="" D "RTN","LRVER3A",321,0) . F S LRTSTX=$O(LRPNL(LRPARENT,LRTSTX)) Q:LRTSTX="" D "RTN","LRVER3A",322,0) . . S LRSTR=LRPNL(LRPARENT,LRTSTX) "RTN","LRVER3A",323,0) . . ; "RTN","LRVER3A",324,0) . . ;LR63X = file 63 dept subscript "RTN","LRVER3A",325,0) . . ;LRTX = file 63 test subscript "RTN","LRVER3A",326,0) . . ;LRAAX = accession area "RTN","LRVER3A",327,0) . . ;LRADX = accession date "RTN","LRVER3A",328,0) . . ;LRANX = accession number "RTN","LRVER3A",329,0) . . ;LRIDTX = file 63 inverted date/time subscript "RTN","LRVER3A",330,0) . . S LR63X=$P(LRSTR,U) "RTN","LRVER3A",331,0) . . S LRTX=$P(LRSTR,U,2) "RTN","LRVER3A",332,0) . . S LRAAX=$P(LRSTR,U,3) "RTN","LRVER3A",333,0) . . S LRADX=$P(LRSTR,U,4) "RTN","LRVER3A",334,0) . . S LRANX=$P(LRSTR,U,5) "RTN","LRVER3A",335,0) . . S LRIDTX=$P(LRSTR,U,6) "RTN","LRVER3A",336,0) . . I $G(^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,9)) S LRADX=^LRO(68,+LRAAX,1,+LRADX,1,+LRANX,9) "RTN","LRVER3A",337,0) . . I LRIDTX>1,LR63X]"" S LR63STR=$G(^LR(LRDFN,LR63X,+LRIDTX,+LRTX)) D "RTN","LRVER3A",338,0) . . . ;This component is still pending, so order in file 100 should not be "complete" "RTN","LRVER3A",339,0) . . . ;since at least one component of a panel is pending. "RTN","LRVER3A",340,0) . . . I LR63STR=""!($P(LR63STR,U)["pending") S LRCOMP2(LRPARENT)=0 Q "RTN","LRVER3A",341,0) . . . ;This component has been verified. File 68 status for the parent should be complete "RTN","LRVER3A",342,0) . . . ;since at least one component has been verified. "RTN","LRVER3A",343,0) . . . S LRCOMP(LRPARENT)=1 "RTN","LRVER3A",344,0) ;update parent level in file 68 "RTN","LRVER3A",345,0) D UPDPAR "RTN","LRVER3A",346,0) Q "RTN","LRVER3A",347,0) ; "RTN","LRVER3A",348,0) UPDPAR ; "RTN","LRVER3A",349,0) ; "RTN","LRVER3A",350,0) ;If the panel encompasses multiple accession areas, an entry may "RTN","LRVER3A",351,0) ;not be present in file 68 at the panel level. "RTN","LRVER3A",352,0) ; "RTN","LRVER3A",353,0) S LRPARENT="" "RTN","LRVER3A",354,0) F S LRPARENT=$O(LRCOMP(LRPARENT)) Q:LRPARENT="" D "RTN","LRVER3A",355,0) . I '$G(LRCOMP(LRPARENT))!('$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0))) Q "RTN","LRVER3A",356,0) . ;LR*5.2*545: add check as to whether the parent (i.e. panel) has been merged or canceled "RTN","LRVER3A",357,0) . Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,6)["*Not Performed"!($P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,6)["*Merged") "RTN","LRVER3A",358,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",359,0) . I '$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",360,0) . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRPARENT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",361,0) . I $G(LRACD)]"",LRACD'=LRAD,$D(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0)) D "RTN","LRVER3A",362,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",363,0) . . I '$P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0),U,5) S $P(^(0),U,5)=LRNOW "RTN","LRVER3A",364,0) . . S $P(^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRPARENT,0),U,6)="",$P(^(0),U,8)=$G(LRCDEF) "RTN","LRVER3A",365,0) Q "RTN","LRVER3A",366,0) ; "RTN","LRVER3A",367,0) REQ ; "RTN","LRVER3A",368,0) Q:$P($G(LRSB(X)),U)="comment" "RTN","LRVER3A",369,0) I $D(LRSB(X)),$P(LRSB(X),U)="canc" Q "RTN","LRVER3A",370,0) I $D(LRSB(X)),$P(LRSB(X),U)'["pend" Q "RTN","LRVER3A",371,0) I $P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0)),U,6)'="" Q "RTN","LRVER3A",372,0) S:'$G(LRALERT) LRALERT=$S($G(LROUTINE):LROUTINE,1:9) "RTN","LRVER3A",373,0) S D1=0 N A,LRPPURG "RTN","LRVER3A",374,0) I $D(LRSB(X)),LRSB(X)["pending",$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0))#2 D Q "RTN","LRVER3A",375,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",376,0) . D REQ1 "RTN","LRVER3A",377,0) ; "RTN","LRVER3A",378,0) ; If required test with no result then store 'pending' and related info (NLT/LOINC codes, user and division). "RTN","LRVER3A",379,0) I '$D(LRSB(X)),$P($G(^LR(LRDFN,"CH",LRIDT,X)),U)="" D STOREP "RTN","LRVER3A",380,0) ; "RTN","LRVER3A",381,0) I '$D(LRSB(X)),$P($G(^LR(LRDFN,"CH",LRIDT,X)),U)'="pending" Q "RTN","LRVER3A",382,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",383,0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRT,0))#2 D "RTN","LRVER3A",384,0) . S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRT,+LRT)="" "RTN","LRVER3A",385,0) . S LRPPURG=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$G(LRM(X,"P")),0)),U,2) "RTN","LRVER3A",386,0) . S:'LRPPURG LRPPURG=$S($G(LRALERT):+LRALERT,1:9) "RTN","LRVER3A",387,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",388,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",389,0) ; "RTN","LRVER3A",390,0) REQ1 ; "RTN","LRVER3A",391,0) Q:LRACD=LRAD "RTN","LRVER3A",392,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",393,0) K CNT,LRAMC "RTN","LRVER3A",394,0) Q "RTN","LRVER3A",395,0) ; "RTN","LRVER3A",396,0) ; "RTN","LRVER3A",397,0) STOREP ; Store pending as a result "RTN","LRVER3A",398,0) N LRX "RTN","LRVER3A",399,0) S LRX=$G(^LR(LRDFN,"CH",LRIDT,X)) "RTN","LRVER3A",400,0) S $P(LRX,"^")="pending" "RTN","LRVER3A",401,0) I $P(LRX,"^",3)="" S $P(LRX,"^",3)=$P($G(LRM(X,"P")),"^",2) "RTN","LRVER3A",402,0) S $P(LRX,"^",4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","LRVER3A",403,0) S $P(LRX,"^",9)=$S($G(DUZ(2)):DUZ(2),1:"") "RTN","LRVER3A",404,0) S ^LR(LRDFN,"CH",LRIDT,X)=LRX "RTN","LRVER3A",405,0) Q "VER") 8.0^22.2 "BLD",12182,6) ^446 **END** **END**