Released LR*5.2*536 SEQ #442 Extracted from mail message **KIDS**:LR*5.2*536^ **INSTALL NAME** LR*5.2*536 "BLD",11744,0) LR*5.2*536^LAB SERVICE^0^3200522^y "BLD",11744,1,0) ^^11^11^3200522^ "BLD",11744,1,1,0) This patch addresses four (4) issues: "BLD",11744,1,2,0) "BLD",11744,1,3,0) 1. Microbiology reports might not display the accurate status of a test. "BLD",11744,1,4,0) "BLD",11744,1,5,0) 2. Unverified Microbiology results are visible in CPRS reports. "BLD",11744,1,6,0) "BLD",11744,1,7,0) 3. VistA reports might not list an accurate status for Microbiology "BLD",11744,1,8,0) accessions. "BLD",11744,1,9,0) "BLD",11744,1,10,0) 4. If a session times out while entering Microbiology sensitivity results, "BLD",11744,1,11,0) the user may not be aware that the sensitivity results were not stored. "BLD",11744,4,0) ^9.64PA^^ "BLD",11744,6.3) 18 "BLD",11744,"ABPKG") n "BLD",11744,"KRN",0) ^9.67PA^1.5^25 "BLD",11744,"KRN",.4,0) .4 "BLD",11744,"KRN",.401,0) .401 "BLD",11744,"KRN",.402,0) .402 "BLD",11744,"KRN",.403,0) .403 "BLD",11744,"KRN",.5,0) .5 "BLD",11744,"KRN",.84,0) .84 "BLD",11744,"KRN",1.5,0) 1.5 "BLD",11744,"KRN",1.6,0) 1.6 "BLD",11744,"KRN",1.61,0) 1.61 "BLD",11744,"KRN",1.62,0) 1.62 "BLD",11744,"KRN",3.6,0) 3.6 "BLD",11744,"KRN",3.8,0) 3.8 "BLD",11744,"KRN",9.2,0) 9.2 "BLD",11744,"KRN",9.8,0) 9.8 "BLD",11744,"KRN",9.8,"NM",0) ^9.68A^7^7 "BLD",11744,"KRN",9.8,"NM",1,0) LRMIBUG^^0^B13779848 "BLD",11744,"KRN",9.8,"NM",2,0) LRWRKINC^^0^B113702611 "BLD",11744,"KRN",9.8,"NM",3,0) LRMIEDZ2^^0^B79846257 "BLD",11744,"KRN",9.8,"NM",4,0) LR7OSMZ1^^0^B18762463 "BLD",11744,"KRN",9.8,"NM",5,0) LRMIPSZ1^^0^B51039845 "BLD",11744,"KRN",9.8,"NM",6,0) LRWRKLST^^0^B78191861 "BLD",11744,"KRN",9.8,"NM",7,0) LRLSTWRK^^0^B24160992 "BLD",11744,"KRN",9.8,"NM","B","LR7OSMZ1",4) "BLD",11744,"KRN",9.8,"NM","B","LRLSTWRK",7) "BLD",11744,"KRN",9.8,"NM","B","LRMIBUG",1) "BLD",11744,"KRN",9.8,"NM","B","LRMIEDZ2",3) "BLD",11744,"KRN",9.8,"NM","B","LRMIPSZ1",5) "BLD",11744,"KRN",9.8,"NM","B","LRWRKINC",2) "BLD",11744,"KRN",9.8,"NM","B","LRWRKLST",6) "BLD",11744,"KRN",19,0) 19 "BLD",11744,"KRN",19.1,0) 19.1 "BLD",11744,"KRN",101,0) 101 "BLD",11744,"KRN",409.61,0) 409.61 "BLD",11744,"KRN",771,0) 771 "BLD",11744,"KRN",779.2,0) 779.2 "BLD",11744,"KRN",870,0) 870 "BLD",11744,"KRN",8989.51,0) 8989.51 "BLD",11744,"KRN",8989.52,0) 8989.52 "BLD",11744,"KRN",8993,0) 8993 "BLD",11744,"KRN",8994,0) 8994 "BLD",11744,"KRN","B",.4,.4) "BLD",11744,"KRN","B",.401,.401) "BLD",11744,"KRN","B",.402,.402) "BLD",11744,"KRN","B",.403,.403) "BLD",11744,"KRN","B",.5,.5) "BLD",11744,"KRN","B",.84,.84) "BLD",11744,"KRN","B",1.5,1.5) "BLD",11744,"KRN","B",1.6,1.6) "BLD",11744,"KRN","B",1.61,1.61) "BLD",11744,"KRN","B",1.62,1.62) "BLD",11744,"KRN","B",3.6,3.6) "BLD",11744,"KRN","B",3.8,3.8) "BLD",11744,"KRN","B",9.2,9.2) "BLD",11744,"KRN","B",9.8,9.8) "BLD",11744,"KRN","B",19,19) "BLD",11744,"KRN","B",19.1,19.1) "BLD",11744,"KRN","B",101,101) "BLD",11744,"KRN","B",409.61,409.61) "BLD",11744,"KRN","B",771,771) "BLD",11744,"KRN","B",779.2,779.2) "BLD",11744,"KRN","B",870,870) "BLD",11744,"KRN","B",8989.51,8989.51) "BLD",11744,"KRN","B",8989.52,8989.52) "BLD",11744,"KRN","B",8993,8993) "BLD",11744,"KRN","B",8994,8994) "BLD",11744,"QDEF") ^^^^NO^^^^NO^^NO "BLD",11744,"QUES",0) ^9.62^^ "BLD",11744,"REQB",0) ^9.611^5^4 "BLD",11744,"REQB",2,0) LR*5.2*453^1 "BLD",11744,"REQB",3,0) LR*5.2*520^1 "BLD",11744,"REQB",4,0) LR*5.2*474^1 "BLD",11744,"REQB",5,0) LR*5.2*381^1 "BLD",11744,"REQB","B","LR*5.2*381",5) "BLD",11744,"REQB","B","LR*5.2*453",2) "BLD",11744,"REQB","B","LR*5.2*474",4) "BLD",11744,"REQB","B","LR*5.2*520",3) "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) 536^3200522 "PKG",26,22,1,"PAH",1,1,0) ^^11^11^3200522 "PKG",26,22,1,"PAH",1,1,1,0) This patch addresses four (4) issues: "PKG",26,22,1,"PAH",1,1,2,0) "PKG",26,22,1,"PAH",1,1,3,0) 1. Microbiology reports might not display the accurate status of a test. "PKG",26,22,1,"PAH",1,1,4,0) "PKG",26,22,1,"PAH",1,1,5,0) 2. Unverified Microbiology results are visible in CPRS reports. "PKG",26,22,1,"PAH",1,1,6,0) "PKG",26,22,1,"PAH",1,1,7,0) 3. VistA reports might not list an accurate status for Microbiology "PKG",26,22,1,"PAH",1,1,8,0) accessions. "PKG",26,22,1,"PAH",1,1,9,0) "PKG",26,22,1,"PAH",1,1,10,0) 4. If a session times out while entering Microbiology sensitivity results, "PKG",26,22,1,"PAH",1,1,11,0) the user may not be aware that the sensitivity results were not stored. "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") 7 "RTN","LR7OSMZ1") 0^4^B18762463^B18324120 "RTN","LR7OSMZ1",1,0) LR7OSMZ1 ;DALOI/JMC - Silent Micro rpt Cont. ;Mar 05, 2019@13:04:42 "RTN","LR7OSMZ1",2,0) ;;5.2;LAB SERVICE;**121,244,350,520,536**;Sep 27, 1994;Build 18 "RTN","LR7OSMZ1",3,0) ; "RTN","LR7OSMZ1",4,0) EN ; from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1 "RTN","LR7OSMZ1",5,0) S LRSPEC=$P(LRLLT,U,5) "RTN","LR7OSMZ1",6,0) I LRONESPC'="",LRSPEC'=LRONESPC Q "RTN","LR7OSMZ1",7,0) ; "RTN","LR7OSMZ1",8,0) N GIOM "RTN","LR7OSMZ1",9,0) S GIOM=$G(LRGIOM) "RTN","LR7OSMZ1",10,0) I GIOM="" D "RTN","LR7OSMZ1",11,0) . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q") "RTN","LR7OSMZ1",12,0) . I GIOM="" S GIOM=80 "RTN","LR7OSMZ1",13,0) ; "RTN","LR7OSMZ1",14,0) D RPT "RTN","LR7OSMZ1",15,0) K %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRAO,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFMT,LRGRM,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM "RTN","LR7OSMZ1",16,0) K LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N "RTN","LR7OSMZ1",17,0) Q "RTN","LR7OSMZ1",18,0) ; "RTN","LR7OSMZ1",19,0) ; "RTN","LR7OSMZ1",20,0) RPT ; "RTN","LR7OSMZ1",21,0) ; "RTN","LR7OSMZ1",22,0) N J,LRTSTS,LRTS,LRTESTCOMPLE,LRX,LRY,LRDISP "RTN","LR7OSMZ1",23,0) ; "RTN","LR7OSMZ1",24,0) S:'$D(LRSB) LRSB=0 "RTN","LR7OSMZ1",25,0) S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRPATLOC=$P(LRLLT,U,8) "RTN","LR7OSMZ1",26,0) S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"") "RTN","LR7OSMZ1",27,0) S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:""),Y=LRTK "RTN","LR7OSMZ1",28,0) D D^LRU "RTN","LR7OSMZ1",29,0) S LRTK=Y,Y=LRRC "RTN","LR7OSMZ1",30,0) D D^LRU "RTN","LR7OSMZ1",31,0) S LRRC=Y,X=$P(LRLLT,U,7) "RTN","LR7OSMZ1",32,0) D DOC^LRX "RTN","LR7OSMZ1",33,0) ; "RTN","LR7OSMZ1",34,0) K ^TMP("LR",$J,"T"),LRTSTS "RTN","LR7OSMZ1",35,0) ; "RTN","LR7OSMZ1",36,0) S (LRBRR,LRTESTCOMPLE)=0 "RTN","LR7OSMZ1",37,0) F S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1 D EN1 "RTN","LR7OSMZ1",38,0) I 'LRPRINT,LRONETST Q "RTN","LR7OSMZ1",39,0) S LRPG=0 "RTN","LR7OSMZ1",40,0) D HDR^LR7OSMZU "RTN","LR7OSMZ1",41,0) Q:LREND "RTN","LR7OSMZ1",42,0) ; "RTN","LR7OSMZ1",43,0) I $D(^TMP("LR",$J,"T")) D "RTN","LR7OSMZ1",44,0) . D LINE^LR7OSUM4,LN "RTN","LR7OSMZ1",45,0) . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(2,CCNT,"Test(s) ordered:") "RTN","LR7OSMZ1",46,0) . S J="" "RTN","LR7OSMZ1",47,0) . F S J=$O(^TMP("LR",$J,"T",J)) Q:J="" S X=^(J) D "RTN","LR7OSMZ1",48,0) . . S LRX=$P(X,"^") "RTN","LR7OSMZ1",49,0) . . I LRTESTCOMPLE S LRX=$$LJ^XLFSTR(LRX,30,".") "RTN","LR7OSMZ1",50,0) . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(19,CCNT,LRX) "RTN","LR7OSMZ1",51,0) . . S:'$D(^TMP("LRT",$J,$P(X,"^"))) ^($P(X,"^"))="MICROBIOLOGY"_"^"_GCNT "RTN","LR7OSMZ1",52,0) . . I '$P(X,U,2) D LN S ^TMP("LRC",$J,GCNT,0)="" Q "RTN","LR7OSMZ1",53,0) . . S Y=$P(X,U,2) "RTN","LR7OSMZ1",54,0) . . ; LR*5.2*520 and LR*5.2*536 "RTN","LR7OSMZ1",55,0) . . S LRDISP=$P(X,U,3) "RTN","LR7OSMZ1",56,0) . . D D^LRU S LRY=$S(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y "RTN","LR7OSMZ1",57,0) . . I (19+$L(LRX)+$L(LRY))>GIOM D LN S ^TMP("LRC",$J,GCNT,0)="" "RTN","LR7OSMZ1",58,0) . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(50,CCNT,LRY) "RTN","LR7OSMZ1",59,0) . . D LN S ^TMP("LRC",$J,GCNT,0)="" "RTN","LR7OSMZ1",60,0) ; "RTN","LR7OSMZ1",61,0) K ^TMP("LR",$J,"T"),LRTSTS "RTN","LR7OSMZ1",62,0) ; "RTN","LR7OSMZ1",63,0) I $D(^LR(LRDFN,"MI",LRIDT,14)) D ANTI^LR7OSMZ2,LINE^LR7OSUM4 "RTN","LR7OSMZ1",64,0) I $D(^LR(LRDFN,"MI",LRIDT,1)) D BACT^LR7OSMZ2,REFS^LR7OSMZU,LINE^LR7OSUM4 "RTN","LR7OSMZ1",65,0) I $D(^LR(LRDFN,"MI",LRIDT,31)) D STER^LR7OSMZ3,LINE^LR7OSUM4 "RTN","LR7OSMZ1",66,0) I $D(^LR(LRDFN,"MI",LRIDT,5)) D PARA^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4 "RTN","LR7OSMZ1",67,0) I $D(^LR(LRDFN,"MI",LRIDT,16)) D VIR^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4 "RTN","LR7OSMZ1",68,0) I $D(^LR(LRDFN,"MI",LRIDT,11)) D TB^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4 "RTN","LR7OSMZ1",69,0) I $D(^LR(LRDFN,"MI",LRIDT,8)) D FUNG^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4 "RTN","LR7OSMZ1",70,0) ; "RTN","LR7OSMZ1",71,0) ; List performing labs "RTN","LR7OSMZ1",72,0) D PPL(LRDFN,"MI",LRIDT) "RTN","LR7OSMZ1",73,0) ; "RTN","LR7OSMZ1",74,0) Q "RTN","LR7OSMZ1",75,0) ; "RTN","LR7OSMZ1",76,0) ; "RTN","LR7OSMZ1",77,0) EN1 ; "RTN","LR7OSMZ1",78,0) ; LR*5.2*520 Set disposition to LRDISP "RTN","LR7OSMZ1",79,0) S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5),LRDISP=$P(^(0),U,6) "RTN","LR7OSMZ1",80,0) Q:'$L($P($G(^LAB(60,LRTS,0)),U,3)) "RTN","LR7OSMZ1",81,0) I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q "RTN","LR7OSMZ1",82,0) ; "RTN","LR7OSMZ1",83,0) ; Set flag that at least one test is completed "RTN","LR7OSMZ1",84,0) I LRTS(1) S LRTESTCOMPLE=1 "RTN","LR7OSMZ1",85,0) ; "RTN","LR7OSMZ1",86,0) S:LRTS=LRONETST LRPRINT=1 "RTN","LR7OSMZ1",87,0) S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test"),^TMP("LR",$J,"T",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)_U_LRDISP "RTN","LR7OSMZ1",88,0) Q "RTN","LR7OSMZ1",89,0) ; "RTN","LR7OSMZ1",90,0) ; "RTN","LR7OSMZ1",91,0) LN ;Increment counter "RTN","LR7OSMZ1",92,0) S GCNT=GCNT+1,CCNT=1 "RTN","LR7OSMZ1",93,0) Q "RTN","LR7OSMZ1",94,0) ; "RTN","LR7OSMZ1",95,0) ; "RTN","LR7OSMZ1",96,0) PPL(LRDFN,LRSS,LRIDT) ; Print any performing laboratories "RTN","LR7OSMZ1",97,0) ; Call with LRDFN = file #63 IEN "RTN","LR7OSMZ1",98,0) ; LRSS = File #63 subscript "RTN","LR7OSMZ1",99,0) ; LRIDT = file #63 specimen inverse date/time "RTN","LR7OSMZ1",100,0) ; "RTN","LR7OSMZ1",101,0) N LRPL,LRI,LRX "RTN","LR7OSMZ1",102,0) ; "RTN","LR7OSMZ1",103,0) D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,0) "RTN","LR7OSMZ1",104,0) I $G(LRPL)<1 Q "RTN","LR7OSMZ1",105,0) ; "RTN","LR7OSMZ1",106,0) D LN S LRX="=--",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX)) "RTN","LR7OSMZ1",107,0) D LN S ^TMP("LRC",$J,GCNT,0)="Performing Laboratory:" "RTN","LR7OSMZ1",108,0) ; "RTN","LR7OSMZ1",109,0) S LRI=0 "RTN","LR7OSMZ1",110,0) F S LRI=$O(LRPL(LRI)) Q:'LRI D LN S ^TMP("LRC",$J,GCNT,0)=LRPL(LRI) "RTN","LR7OSMZ1",111,0) D LN S ^TMP("LRC",$J,GCNT,0)="" "RTN","LR7OSMZ1",112,0) ; "RTN","LR7OSMZ1",113,0) Q "RTN","LRLSTWRK") 0^7^B24160992^B19738735 "RTN","LRLSTWRK",1,0) LRLSTWRK ;SLC/CJS/DALISC/DRH - BRIEF ACCESSION LIST ;2/19/91 10:44 ; "RTN","LRLSTWRK",2,0) ;;5.2;LAB SERVICE;**153,381,536**;Sep 27, 1994;Build 18 "RTN","LRLSTWRK",3,0) EN ; "RTN","LRLSTWRK",4,0) K ^TMP($J),LRTEST,LR,LRTSTS,LRAA "RTN","LRLSTWRK",5,0) D ADATE^LRWU3 "RTN","LRLSTWRK",6,0) G END^LRLSTWRL:LREND "RTN","LRLSTWRK",7,0) S LRAD=Y,DIC="^LRO(68,",DIC(0)="AEMOQ",LR(1)=0,LRTEST(0)=0 "RTN","LRLSTWRK",8,0) D LRAA^LRLSTWRL G END:LREND,LRLSTWRK:LR(1)<1 "RTN","LRLSTWRK",9,0) I '$D(LRSTAR) S LREND=0 D LRAN^LRWU3 G END:LREND "RTN","LRLSTWRK",10,0) L2 ; "RTN","LRLSTWRK",11,0) W !,"Expand panels" S %=2 D YN^DICN "RTN","LRLSTWRK",12,0) S LREX=(%=1) "RTN","LRLSTWRK",13,0) G END:%=-1 "RTN","LRLSTWRK",14,0) I %=0 W !,"If yes, each panel encountered will be expanded." G L2 "RTN","LRLSTWRK",15,0) L2B ; "RTN","LRLSTWRK",16,0) W !,"Do you wish to see unverified data" "RTN","LRLSTWRK",17,0) S %=2 D YN^DICN "RTN","LRLSTWRK",18,0) S LR(2)=(%=1) "RTN","LRLSTWRK",19,0) G END:%=-1 "RTN","LRLSTWRK",20,0) I %=0 W !,"If yes, unverified data may also be displayed." G L2B "RTN","LRLSTWRK",21,0) L2A ; "RTN","LRLSTWRK",22,0) S LREND=0,LRCEN("W")=0 "RTN","LRLSTWRK",23,0) R !,"Spacing: 1// ",LR(4):DTIME "RTN","LRLSTWRK",24,0) Q:'$T!(LR(4)["^") W:LR(4)["?" !,"Single, Double, Triple spacing, etc." "RTN","LRLSTWRK",25,0) G:X["?" L2A S LR(4)=+LR(4) S:LR(4)<1 LR(4)=1 "RTN","LRLSTWRK",26,0) S %ZIS="QM" D ^%ZIS G END:POP "RTN","LRLSTWRK",27,0) I $D(IO("Q")) D G END "RTN","LRLSTWRK",28,0) . S ZTRTN="DQ^LRLSTWRK",ZTSAVE("L*")="" "RTN","LRLSTWRK",29,0) . D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE,IO("Q") "RTN","LRLSTWRK",30,0) ENT ; "RTN","LRLSTWRK",31,0) U IO D URG^LRX K ^TMP("LR",$J) "RTN","LRLSTWRK",32,0) S LRNTPP=((IOM-4)-45)/$S(LR(4)>1:7,1:5)\1,LRNTP=0 "RTN","LRLSTWRK",33,0) I '$D(LRSTAR) F LRAA=1:1:LR(1) D L11 Q:LREND "RTN","LRLSTWRK",34,0) I $D(LRSTAR) F LRAA=1:1:LR(1) D L3 Q:LREND "RTN","LRLSTWRK",35,0) I $O(^TMP($J,0))<1 W !!,"NO DATA TO REPORT" G END "RTN","LRLSTWRK",36,0) S:LRTEST(0)LRLAN)!(LRAN'?.N) D L12 Q:LREND "RTN","LRLSTWRK",39,0) Q "RTN","LRLSTWRK",40,0) L12 Q:'$D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0))#2 "RTN","LRLSTWRK",41,0) S X=^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0),LRCEN=$S($D(^(.1)):^(.1),1:0),LRACC=$S($D(^(.2)):^(.2),1:"?"),LRIDT=$S($D(^(3)):^(3),1:"") "RTN","LRLSTWRK",42,0) S LRUID=$P($G(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,.3)),"^") "RTN","LRLSTWRK",43,0) S T(2)="",T(5)="",T(3)="",LRDFN=+X,LRSDT=$P(X,U,4)\1,LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7) "RTN","LRLSTWRK",44,0) S:LRCEN&'LRCEN("W") LRCEN("W")=1 "RTN","LRLSTWRK",45,0) I LRIDT'="" D "RTN","LRLSTWRK",46,0) . I +LRIDT S T(2)=+LRIDT_$S($P(LRIDT,U,2):"r",1:"d") "RTN","LRLSTWRK",47,0) . E S T(2)="No Collect Date/Time" "RTN","LRLSTWRK",48,0) . S T(3)=$P(LRIDT,U,4),T(5)=$P(LRIDT,U,3),LRIDT=$P(LRIDT,U,5) "RTN","LRLSTWRK",49,0) S II=0 F S II=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,4,II)) Q:II<1!LREND S X=^(II,0) D L13 "RTN","LRLSTWRK",50,0) S LR(3)=$S(LR(4)>1:7,1:5)*LRTEST(0)+67+$S('LRCEN("W"):0,1:8)<(IOM-4) S:LR(3) LR(3)=22+$S('LRCEN("W"):0,1:8) "RTN","LRLSTWRK",51,0) Q "RTN","LRLSTWRK",52,0) L13 S T(1)=$P(X,U,6),LRURG=+$P(X,U,2),LRURG=$S($D(LRURG(LRURG)):LRURG(LRURG),1:""),T(3)=$P(X,U,5),LRTS=+X "RTN","LRLSTWRK",53,0) I $G(LRURG)>49,'$P($G(LRPARAM),U,3) Q "RTN","LRLSTWRK",54,0) ;LR*5.2*536 - additional logic for Microbiology "RTN","LRLSTWRK",55,0) ;A Microbiology test may have a complete date/time in file 68 but the "RTN","LRLSTWRK",56,0) ;[area] RPT DATE APPROVED field might be null - which means results are "RTN","LRLSTWRK",57,0) ;not displaying in CPRS, and the accession is pending "RTN","LRLSTWRK",58,0) I T(3),$P(^LRO(68,LRAA(LRAA),0),U,2)="MI" D MICRO "RTN","LRLSTWRK",59,0) S T(4)=$S(T(3):"done",$L(T(1)):"#"_$J(T(1),3),LRURG["STAT":"Spen",1:" pen"),LRSPEC=$S($D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,5,1,0)):+^(0),1:""),S4=$S($D(^LAB(60,LRTS,0)):$P(^(0),U,5),1:""),T4=T(4) "RTN","LRLSTWRK",60,0) D STORE I LREX S LRTEST=LRTS,LRTSTLM=100 D ^LREXPD S JJ=0 F S JJ=$O(LRORD(JJ)) Q:JJ<1 S LRTS=LRORD(JJ),S4=$P(^LAB(60,LRTS,0),U,5) D STORE "RTN","LRLSTWRK",61,0) K JJ,LRORD,^TMP("LR",$J,"T") "RTN","LRLSTWRK",62,0) Q "RTN","LRLSTWRK",63,0) ; "RTN","LRLSTWRK",64,0) MICRO ;further evaluation for Microbiology test "RTN","LRLSTWRK",65,0) N LRDFNX,LRIDTX,LREXCODE,LRMIAREA "RTN","LRLSTWRK",66,0) S LRDFNX=$P(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0),U) "RTN","LRLSTWRK",67,0) S LRIDTX=$P($G(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,3)),U,5) "RTN","LRLSTWRK",68,0) S LREXCODE=$P($G(^LAB(60,II,0)),"^",14) "RTN","LRLSTWRK",69,0) Q:'LREXCODE "RTN","LRLSTWRK",70,0) S LREXCODE=$G(^LAB(62.07,LREXCODE,.1)) "RTN","LRLSTWRK",71,0) ;Logic below is the same as the logic in result verification "RTN","LRLSTWRK",72,0) ;routine LRMIEDZ2 which determines which Microbiology area is "RTN","LRLSTWRK",73,0) ;defined for a Microbiology test "RTN","LRLSTWRK",74,0) S LRMIAREA=$S(LREXCODE["11.5":1,LREXCODE["23":11,LREXCODE["19":8,LREXCODE["15":5,LREXCODE["34":16,1:"") "RTN","LRLSTWRK",75,0) ;If the [area] RPT DATE APPROVED field is null, display this test as "pending" "RTN","LRLSTWRK",76,0) I $D(^LR(LRDFNX,"MI",LRIDTX,LRMIAREA)),$P(^(LRMIAREA),U)="" S T(3)="" "RTN","LRLSTWRK",77,0) Q "RTN","LRLSTWRK",78,0) ; "RTN","LRLSTWRK",79,0) STORE S:'$D(LRTEST("B",LRTS)) LRTEST(0)=LRTEST(0)+1,LRTEST(LRTEST(0))=$S($D(^LAB(60,LRTS,0)):$P(^(0),U,1),1:"deleted test"),LRTEST("B",LRTS)=LRTEST(0),LRNTP=LRTEST(0)-1\LRNTPP+1 "RTN","LRLSTWRK",80,0) S LRSS=$P(S4,";",1),S2=$P(S4,";",2),S3=$P(S4,";",3),T(4)=T4 "RTN","LRLSTWRK",81,0) I $L(S4) D "RTN","LRLSTWRK",82,0) . S T(4)=$S(LRURG["STAT":"S...",1:"....") "RTN","LRLSTWRK",83,0) . I LRIDT,$D(^LR(LRDFN,LRSS,LRIDT,S2)),$P(^(0),U,3)!LR(2),$L($P(^(S2),U,S3)) S T(4)=$S($P(^(S2),U,S3)'="pending":$P(^(S2),U,S3),1:"pen") "RTN","LRLSTWRK",84,0) S ^TMP($J,(LRTEST("B",LRTS)-1\LRNTPP+1),LRAN,LRACC,LRDFN,LRTEST("B",LRTS))=LRLLOC_U_LRURG_U_T(4)_U_LRSPEC_U_LRCEN_U_T(2)_U_LRACC_U_T(5)_U_LRUID "RTN","LRLSTWRK",85,0) Q "RTN","LRLSTWRK",86,0) END G END^LRLSTWRL "RTN","LRLSTWRK",87,0) Q "RTN","LRLSTWRK",88,0) YN R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G YN "RTN","LRLSTWRK",89,0) L3 S LRAD=$E(LRSTAR,1,3)_"0000"-.00001 F S LRAD=$O(^LRO(68,LRAA(LRAA),1,LRAD)) Q:LRAD<1!(LRAD>LRWDTL) D AC Q:LREND "RTN","LRLSTWRK",90,0) AC S T1=LRSTAR-.00001 F S T1=$O(^LRO(68,+LRAA(LRAA),1,+LRAD,1,"E",T1)) Q:T1<1!(LAST>1&(T1\1>LAST)) D AC1 "RTN","LRLSTWRK",91,0) Q "RTN","LRLSTWRK",92,0) AC1 S LRAN=0 F S LRAN=$O(^LRO(68,+LRAA(LRAA),1,LRAD,1,"E",T1,LRAN)) Q:LRAN<1 I $D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,0)) D L12 Q:LREND "RTN","LRLSTWRK",93,0) Q "RTN","LRLSTWRK",94,0) DQ S:$D(ZTQUEUED) ZTREQ="@" U IO K ^TMP($J) G ENT "RTN","LRLSTWRK",95,0) Q "RTN","LRMIBUG") 0^1^B13779848^B9500545 "RTN","LRMIBUG",1,0) LRMIBUG ;DALOI/JMC- DISPLAY ORGANISMS ;07/15/09 10:38 "RTN","LRMIBUG",2,0) ;;5.2;LAB SERVICE;**318,321,339,350,536**;Sep 27, 1994;Build 18 "RTN","LRMIBUG",3,0) ; "RTN","LRMIBUG",4,0) ; Reference to ^DIE global supported by ICR #5002 "RTN","LRMIBUG",5,0) ; "RTN","LRMIBUG",6,0) BUGS ; "RTN","LRMIBUG",7,0) Q:$G(LREND) "RTN","LRMIBUG",8,0) N LR1PASS,LRBG,LRBI,LRBG1 "RTN","LRMIBUG",9,0) D KVAR^VADPT "RTN","LRMIBUG",10,0) S LR1PASS=1 "RTN","LRMIBUG",11,0) I '$D(^LR(LRDFN,"MI",LRIDT,3,"B")) D SETBINDX^LRMIBUG(LRDFN,LRIDT,3) "RTN","LRMIBUG",12,0) F D BUGIN Q:Y<1 S LRBG1=Y(0) D:$P(Y,U,3)&($P(LRPARAM,U,14))&($P($G(^LRO(68,LRAA,0)),U,16)) ETIO^LRCAPV1 D BUGGER,BUGOUT "RTN","LRMIBUG",13,0) D BUGOUT "RTN","LRMIBUG",14,0) ; "RTN","LRMIBUG",15,0) Q "RTN","LRMIBUG",16,0) ; "RTN","LRMIBUG",17,0) ; "RTN","LRMIBUG",18,0) BUGIN ; "RTN","LRMIBUG",19,0) S DIC=DIE_DA_",3,",LRODA=DA,LRODIE=DIE,DA(1)=DA,DA(2)=LRDFN "RTN","LRMIBUG",20,0) S DIC(0)="AEFLMOQZ" "RTN","LRMIBUG",21,0) S DIC("S")="I 1 Q:$D(^LR(DA(2),""MI"",DA(1),3,+X)) Q:'$D(^LAB(61.2,+X,0)) I $L($P(^(0),U,5)),""PVRBFM""[$P(^(0),U,5)" "RTN","LRMIBUG",22,0) S:'$D(@(DIC_"0)")) ^(0)="^63.3PA" S LRSPEC=$P(^LR(LRDFN,"MI",LRIDT,0),U,5) "RTN","LRMIBUG",23,0) W ! S LRBG=0 "RTN","LRMIBUG",24,0) F S LRBG=$O(^LR(LRDFN,"MI",DA,3,LRBG)) Q:LRBG<1 S LRBUG=+^(LRBG,0) K DIC("B") S:LRBG=1&LR1PASS DIC("B")=$P(^LAB(61.2,+^LR(LRDFN,"MI",DA,3,1,0),0),U) W !?2,LRBG,?5,$P(^LAB(61.2,LRBUG,0),U) "RTN","LRMIBUG",25,0) S DLAYGO=63 D ^DIC "RTN","LRMIBUG",26,0) K DIC("B"),DIC("S"),DLAYGO "RTN","LRMIBUG",27,0) S LR1PASS=0 "RTN","LRMIBUG",28,0) Q "RTN","LRMIBUG",29,0) ; "RTN","LRMIBUG",30,0) ; "RTN","LRMIBUG",31,0) BUGGER ; "RTN","LRMIBUG",32,0) S LRNB=$S($L($P(^LAB(61.2,+LRBG1,0),U,4)):$P(^(0),U,4),1:LRMIDEF),LRBI=$P(^(0),U,5) "RTN","LRMIBUG",33,0) N LRTHISDA "RTN","LRMIBUG",34,0) S DIE=DIC,DA=+Y,LRTHISDA=DA D TEMP,^DIE,DELINT I '$D(Y) Q "RTN","LRMIBUG",35,0) ; "RTN","LRMIBUG",36,0) ;added for LR*5.2*536 "RTN","LRMIBUG",37,0) ;If the session times out while entering organism and/or sensitivity "RTN","LRMIBUG",38,0) ;(antibiotic) results, the results are not filed into the LAB DATA "RTN","LRMIBUG",39,0) ;(#63) file. The root cause is that TR^DIED sets variable DTOUT to "RTN","LRMIBUG",40,0) ;"^" if a timeout occurs during the execution of an input template. "RTN","LRMIBUG",41,0) ;RE+1^DIED then invokes "I $D(DTOUT) K DQ,DG G QY^DIE1" which causes "RTN","LRMIBUG",42,0) ;the DIE* logic to not file the results. Further tracing was not "RTN","LRMIBUG",43,0) ;performed in the DIE* code. "RTN","LRMIBUG",44,0) ; "RTN","LRMIBUG",45,0) ;$G(DTOUT) = session possibly timed out without DTOUT set to "^" "RTN","LRMIBUG",46,0) ;$G(DTOUT)="^" = session timed out while entering organism and/or "RTN","LRMIBUG",47,0) ; sensitivities "RTN","LRMIBUG",48,0) ; "RTN","LRMIBUG",49,0) I $G(DTOUT)!($G(DTOUT)="^") D Q "RTN","LRMIBUG",50,0) . W !!,"**** WARNING ****" "RTN","LRMIBUG",51,0) . W !,"Your session has timed out. Organism and/or antibiotic" "RTN","LRMIBUG",52,0) . W !,"results need to be re-entered." "RTN","LRMIBUG",53,0) . W !,"Verify all results on this accession are correct." "RTN","LRMIBUG",54,0) . N DIR "RTN","LRMIBUG",55,0) . S DIR(0)="E" "RTN","LRMIBUG",56,0) . S DIR("A")="Press enter to continue" "RTN","LRMIBUG",57,0) . D ^DIR "RTN","LRMIBUG",58,0) . D BUGOUT "RTN","LRMIBUG",59,0) . F D BUGIN Q:Y<1 D "RTN","LRMIBUG",60,0) . . S LRBG1=Y(0) "RTN","LRMIBUG",61,0) . . D:$P(Y,U,3)&($P(LRPARAM,U,14))&($P($G(^LRO(68,LRAA,0)),U,16)) ETIO^LRCAPV1 "RTN","LRMIBUG",62,0) . . D BUGGER,BUGOUT "RTN","LRMIBUG",63,0) ;end of LR*5.2*536 changes "RTN","LRMIBUG",64,0) W !,"Any other antibiotics" S %=2 D YN^DICN I %'=1 Q "RTN","LRMIBUG",65,0) I '$L(LRMIOTH) S DR="S Y=200;2.0000001:200",DR(2,63.32)=.01 D ^DIE Q "RTN","LRMIBUG",66,0) K DR "RTN","LRMIBUG",67,0) S LRNB=LRMIOTH D TEMP F J=1:1 S K=$P(DR,";",J) Q:+K'=K!(K>2)!'$L(K) "RTN","LRMIBUG",68,0) S (DR,DR(1,63.3))=$P(DR,";",J,245) "RTN","LRMIBUG",69,0) D ^DIE "RTN","LRMIBUG",70,0) Q "RTN","LRMIBUG",71,0) ; "RTN","LRMIBUG",72,0) ; "RTN","LRMIBUG",73,0) TEMP ; "RTN","LRMIBUG",74,0) S LRNB=+$O(^DIE("B",$S($L(LRNB):LRNB,1:0),0)) "RTN","LRMIBUG",75,0) I LRNB,$D(^DIE(LRNB,"DR",3,63.3)) S (DR,DR(1,63.3))=^(63.3),J=0 F I=0:0 S J=$O(^DIE(LRNB,"DR",3,63.3,J)) Q:J<1 S DR(1,63.3,J)=^(J) "RTN","LRMIBUG",76,0) I 'LRNB!('$D(^DIE(LRNB,"DR",3,63.3))) S DR=$S(($L(LRBI)&("MFBVRP"[LRBI)):".01;1;2",1:".01;1;2:195") "RTN","LRMIBUG",77,0) Q "RTN","LRMIBUG",78,0) ; "RTN","LRMIBUG",79,0) ; "RTN","LRMIBUG",80,0) BUGOUT ; "RTN","LRMIBUG",81,0) S (DIE,DIC)=LRODIE,DA=LRODA,DA(1)=LRDFN K DR(1,63.3) "RTN","LRMIBUG",82,0) Q "RTN","LRMIBUG",83,0) ; "RTN","LRMIBUG",84,0) ; "RTN","LRMIBUG",85,0) DELINT ; If a Result is (1st piece) deleted in ^LR(LRDFN,"MI",LRIDT,3 "RTN","LRMIBUG",86,0) ; the associated Interpretation (2nd piece) should be deleted "RTN","LRMIBUG",87,0) ; as well. If S^S^ exists, and the Result is deleted, ^S^ Interpretation remains. "RTN","LRMIBUG",88,0) ; This process will clean up the remaining Interpretation "RTN","LRMIBUG",89,0) Q:'LRDFN!('LRIDT)!('LRTHISDA) "RTN","LRMIBUG",90,0) N LRXX "RTN","LRMIBUG",91,0) S LRXX=2 ;This node bumps in fractions exp. 2.001 2.00234 "RTN","LRMIBUG",92,0) F S LRXX=$O(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX)) Q:'LRXX!(LRXX'<3) D "RTN","LRMIBUG",93,0) . I $P(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U)="" S $P(^LR(LRDFN,"MI",LRIDT,3,LRTHISDA,LRXX),U,2)="" "RTN","LRMIBUG",94,0) Q "RTN","LRMIBUG",95,0) ; "RTN","LRMIBUG",96,0) ; "RTN","LRMIBUG",97,0) SETBINDX(LRDFN,LRIDT,LRNODE) ; Set "B" x-ref if "B" x-ref doesn't exist on #.01 field. "RTN","LRMIBUG",98,0) N DA,DIC,DIE,DIK,DLAYGO,DR,X,Y "RTN","LRMIBUG",99,0) S DA(1)=LRIDT,DA(2)=LRDFN "RTN","LRMIBUG",100,0) S DIK="^LR("_LRDFN_",""MI"","_LRIDT_","_LRNODE_"," "RTN","LRMIBUG",101,0) S DIK(1)=".01^B" "RTN","LRMIBUG",102,0) D ENALL^DIK "RTN","LRMIBUG",103,0) Q "RTN","LRMIEDZ2") 0^3^B79846257^B72283385 "RTN","LRMIEDZ2",1,0) LRMIEDZ2 ;DALIO/JMC - MICROBIOLOGY EDIT ROUTINE ;09/07/16 08:06 "RTN","LRMIEDZ2",2,0) ;;5.2;LAB SERVICE;**23,104,242,295,350,427,474,536**;Sep 27, 1994;Build 18 "RTN","LRMIEDZ2",3,0) ; "RTN","LRMIEDZ2",4,0) ; from LRFAST,LRMIEDZ,LRVER "RTN","LRMIEDZ2",5,0) ; "RTN","LRMIEDZ2",6,0) ; Reference to ^DIE global supported by ICR #5002 "RTN","LRMIEDZ2",7,0) ; "RTN","LRMIEDZ2",8,0) PAT ; "RTN","LRMIEDZ2",9,0) N LRUID "RTN","LRMIEDZ2",10,0) ; "RTN","LRMIEDZ2",11,0) I '$D(LRAN) S LRAN="" "RTN","LRMIEDZ2",12,0) F S:LRAN="" LRAN=$$ACCPRMPT(LRAA,LRAD) Q:LRAN<0 D "RTN","LRMIEDZ2",13,0) . I +LRAN=0 D Q "RTN","LRMIEDZ2",14,0) . . D QUES "RTN","LRMIEDZ2",15,0) . . S LRAN="" "RTN","LRMIEDZ2",16,0) . ; "RTN","LRMIEDZ2",17,0) . S LRANOK=1 "RTN","LRMIEDZ2",18,0) . S LRCAPOK=1 "RTN","LRMIEDZ2",19,0) . D PAT1 "RTN","LRMIEDZ2",20,0) . L -^LR(LRDFN,"MI",LRIDT) "RTN","LRMIEDZ2",21,0) . D LEDI^LRVR0 "RTN","LRMIEDZ2",22,0) . K LRTS "RTN","LRMIEDZ2",23,0) . I LRCAPOK&($P(LRPARAM,U,14)) D ^LRCAPV1 "RTN","LRMIEDZ2",24,0) . S LRAN="" "RTN","LRMIEDZ2",25,0) ; "RTN","LRMIEDZ2",26,0) ; "RTN","LRMIEDZ2",27,0) Q "RTN","LRMIEDZ2",28,0) ; "RTN","LRMIEDZ2",29,0) ; "RTN","LRMIEDZ2",30,0) ACCPRMPT(LRAA,LRAD) ;Prompt for accession number or UID "RTN","LRMIEDZ2",31,0) ; "RTN","LRMIEDZ2",32,0) ; Call with LRAA = Accession Area "RTN","LRMIEDZ2",33,0) ; LRAD = Accession Date "RTN","LRMIEDZ2",34,0) ; "RTN","LRMIEDZ2",35,0) ; Accession number/UID entered must have the same accession "RTN","LRMIEDZ2",36,0) ; area and date as LRAA and LRAD "RTN","LRMIEDZ2",37,0) ; "RTN","LRMIEDZ2",38,0) ; Returns LRAN = 0 (not valid input) "RTN","LRMIEDZ2",39,0) ; = -1 (user wants to exit - they entered up-arrow, pressed the Enter/Return key, or timed out) "RTN","LRMIEDZ2",40,0) ; = >0 (valid accession number) "RTN","LRMIEDZ2",41,0) ; "RTN","LRMIEDZ2",42,0) N DIR,DIRUT,DTOUT,DUOUT,LRAN,LRANOK,LRX,LRY,X,Y "RTN","LRMIEDZ2",43,0) ; "RTN","LRMIEDZ2",44,0) S LRAN=0 "RTN","LRMIEDZ2",45,0) ; "RTN","LRMIEDZ2",46,0) W !! "RTN","LRMIEDZ2",47,0) ; "RTN","LRMIEDZ2",48,0) S DIR(0)="FO^1:30",DIR("A")="Select MICROBIOLOGY Accession or UID" "RTN","LRMIEDZ2",49,0) S DIR("?")="^D QUES^LRMIEDZ2" "RTN","LRMIEDZ2",50,0) D ^DIR "RTN","LRMIEDZ2",51,0) I Y=""!$D(DIRUT) Q -1 "RTN","LRMIEDZ2",52,0) S LRX=Y "RTN","LRMIEDZ2",53,0) ; "RTN","LRMIEDZ2",54,0) S:$L(LRX)>2 ^DISV(DUZ,"LRACC")=LRX "RTN","LRMIEDZ2",55,0) S:LRX=" " LRX=$S($D(^DISV(DUZ,"LRACC")):^("LRACC"),1:"?") "RTN","LRMIEDZ2",56,0) ; "RTN","LRMIEDZ2",57,0) I $D(^LRO(68,"C",LRX)) D Q LRAN "RTN","LRMIEDZ2",58,0) . S LRY=$$CHECKUID^LRWU4(LRX,"MI") "RTN","LRMIEDZ2",59,0) . I 'LRY Q "RTN","LRMIEDZ2",60,0) . I $P(LRY,U,2)'=LRAA!($P(LRY,U,3)'=LRAD) Q "RTN","LRMIEDZ2",61,0) . S LRAN=$P(LRY,U,4) "RTN","LRMIEDZ2",62,0) . W " (",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^"),")" "RTN","LRMIEDZ2",63,0) ; "RTN","LRMIEDZ2",64,0) S LRANOK=1 "RTN","LRMIEDZ2",65,0) S X=LRX "RTN","LRMIEDZ2",66,0) D LRANX^LRMIU4 "RTN","LRMIEDZ2",67,0) I 'LRANOK S LRAN=0 "RTN","LRMIEDZ2",68,0) ; "RTN","LRMIEDZ2",69,0) Q LRAN "RTN","LRMIEDZ2",70,0) ; "RTN","LRMIEDZ2",71,0) ; "RTN","LRMIEDZ2",72,0) QUES ; "RTN","LRMIEDZ2",73,0) ; "RTN","LRMIEDZ2",74,0) W $C(7),!,"Enter the accession number or the unique identifier (UID)." "RTN","LRMIEDZ2",75,0) W !,"If entering the accession number, enter just the number portion." "RTN","LRMIEDZ2",76,0) W !,?5," e.g., if the accession is MICRO 13 30173, enter 30173." "RTN","LRMIEDZ2",77,0) W !,?5," Only accessions from subscript MI are selectable." "RTN","LRMIEDZ2",78,0) W !,"If entering the UID, enter the entire 10-15 characters." "RTN","LRMIEDZ2",79,0) W ! "RTN","LRMIEDZ2",80,0) W !,"The accession number/UID entered must have the same accession" "RTN","LRMIEDZ2",81,0) W !,"area and date as the first accession entered." "RTN","LRMIEDZ2",82,0) ; "RTN","LRMIEDZ2",83,0) Q "RTN","LRMIEDZ2",84,0) ; "RTN","LRMIEDZ2",85,0) ; "RTN","LRMIEDZ2",86,0) PAT1 ; Called from above and LRFAST "RTN","LRMIEDZ2",87,0) ; "RTN","LRMIEDZ2",88,0) ; Set LRANOK if called from LRFAST and not set "RTN","LRMIEDZ2",89,0) I $G(LRANOK)="" N LRANOK S LRANOK=1 "RTN","LRMIEDZ2",90,0) ; "RTN","LRMIEDZ2",91,0) S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0) "RTN","LRMIEDZ2",92,0) S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") "RTN","LRMIEDZ2",93,0) S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5),LRCDT=+^(3),LREAL=$P(^(3),U,2),LRI=+$O(^(5,0)),LRSPEC=$S($D(^(LRI,0)):+^(0),1:"") "RTN","LRMIEDZ2",94,0) ; "RTN","LRMIEDZ2",95,0) I '$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) D Q "RTN","LRMIEDZ2",96,0) . W !,"No tests associated with this accession" S LRANOK=0 "RTN","LRMIEDZ2",97,0) . Q:$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))," ")=$P(^LRO(68,LRAA,0),U,11) "RTN","LRMIEDZ2",98,0) . W !,"Verify with accession #: ",$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)) "RTN","LRMIEDZ2",99,0) ; "RTN","LRMIEDZ2",100,0) ; Insure DILOCKTM is defined "RTN","LRMIEDZ2",101,0) I $G(DILOCKTM)="" D "RTN","LRMIEDZ2",102,0) . N DIQUIET "RTN","LRMIEDZ2",103,0) . S DIQUIET=1 D DT^DICRW "RTN","LRMIEDZ2",104,0) ; "RTN","LRMIEDZ2",105,0) L +^LR(LRDFN,"MI",LRIDT):DILOCKTM "RTN","LRMIEDZ2",106,0) I '$T W !!?10,"Someone else is editing this accession ",!,$C(7) S LRANOK=0 Q "RTN","LRMIEDZ2",107,0) I '$D(^LR(LRDFN,"MI",LRIDT,0)) D BB S (LRCAPOK,LRANOK)=0 Q "RTN","LRMIEDZ2",108,0) S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0) "RTN","LRMIEDZ2",109,0) ; "RTN","LRMIEDZ2",110,0) D PATINFO "RTN","LRMIEDZ2",111,0) ; "RTN","LRMIEDZ2",112,0) I $$GET^XPAR("USR^DIV^PKG","LR MI VERIFY DISPLAY PROVIDER",1,"Q") D PROV "RTN","LRMIEDZ2",113,0) ; "RTN","LRMIEDZ2",114,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","LRMIEDZ2",115,0) I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) D "RTN","LRMIEDZ2",116,0) . S DIR("A",1)="Final report has been verified by microbiology supervisor." "RTN","LRMIEDZ2",117,0) . S DIR("A",2)="If you proceed in editing, this report will need to be reverified." "RTN","LRMIEDZ2",118,0) . S DIR("B")="NO" "RTN","LRMIEDZ2",119,0) E S DIR("B")="YES" "RTN","LRMIEDZ2",120,0) S DIR(0)="YO",DIR("A")="Edit this accession" "RTN","LRMIEDZ2",121,0) D ^DIR "RTN","LRMIEDZ2",122,0) I Y<1 S (LRCAPOK,LRANOK)=0 D ASKXQA W ! Q "RTN","LRMIEDZ2",123,0) ; "RTN","LRMIEDZ2",124,0) ; "RTN","LRMIEDZ2",125,0) AUDRTN ; "RTN","LRMIEDZ2",126,0) ; Also called from LRVR0 when verifying Lab UI instrument results and user wants to do full edit. "RTN","LRMIEDZ2",127,0) ; "RTN","LRMIEDZ2",128,0) N LRAMX,LRUNDO "RTN","LRMIEDZ2",129,0) S (LRAMX,LRUNDO)=0 "RTN","LRMIEDZ2",130,0) ;LRAMX = results amended after supervisor verification "RTN","LRMIEDZ2",131,0) I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S (LRUNDO,LRAMX)=1 "RTN","LRMIEDZ2",132,0) ; "RTN","LRMIEDZ2",133,0) D EC^LRMIEDZ4 "RTN","LRMIEDZ2",134,0) I N=0 W !,"No Tests on Accession" S (LRCAPOK,LRANOK)=0 Q "RTN","LRMIEDZ2",135,0) I '$D(LRNPTP) D "RTN","LRMIEDZ2",136,0) . I N=1 S LRI=1 Q "RTN","LRMIEDZ2",137,0) . N DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","LRMIEDZ2",138,0) . S DIR(0)="NO^1:"_N_":0",DIR("A")="Select Test",DIR("B")=1 "RTN","LRMIEDZ2",139,0) . D ^DIR "RTN","LRMIEDZ2",140,0) . I Y<1 S (LRCAPOK,LRANOK)=0 Q "RTN","LRMIEDZ2",141,0) . S LRI=Y "RTN","LRMIEDZ2",142,0) I LRANOK=0 Q "RTN","LRMIEDZ2",143,0) I LRTX(LRI)="" W !,"EDIT CODE IN FILE 60 NOT DEFINED.",! S (LRCAPOK,LRANOK)=0 Q "RTN","LRMIEDZ2",144,0) ; "RTN","LRMIEDZ2",145,0) S LRTS=LRTS(LRI) "RTN","LRMIEDZ2",146,0) K DR "RTN","LRMIEDZ2",147,0) S DA=LRIDT,DA(1)=LRDFN,DIE="^LR(LRDFN,""MI""," "RTN","LRMIEDZ2",148,0) ; "RTN","LRMIEDZ2",149,0) S LRSB=$S(LRTX(LRI)["11.5":1,LRTX(LRI)["23":11,LRTX(LRI)["19":8,LRTX(LRI)["15":5,LRTX(LRI)["34":16,1:"") "RTN","LRMIEDZ2",150,0) ;LR*5.2*536 add check for the Microbiology area's "date approved" field "RTN","LRMIEDZ2",151,0) ;for results which may have previously been verified. "RTN","LRMIEDZ2",152,0) ;Variable LRSB indicates the appropriate Microbiology area "RTN","LRMIEDZ2",153,0) ;Subscripts: 1 = Bacteriology; 5=Parasitology; 8=Mycology; 11=TB; 16=Virology "RTN","LRMIEDZ2",154,0) I LRSB]"",$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U) S LRUNDO=1 "RTN","LRMIEDZ2",155,0) D:LRUNDO UNDO "RTN","LRMIEDZ2",156,0) S LRFIFO=LRTX(LRI)["FIFO",(LREND,LRSAME)=0 D:'LRFIFO TIME^LRMIEDZ3 I LREND K DR Q "RTN","LRMIEDZ2",157,0) ; "RTN","LRMIEDZ2",158,0) S LRSSC=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11) "RTN","LRMIEDZ2",159,0) ; "RTN","LRMIEDZ2",160,0) ; "RTN","LRMIEDZ2",161,0) AUDPT ; "RTN","LRMIEDZ2",162,0) ; Check for "B" x-ref on #.01 field. "RTN","LRMIEDZ2",163,0) F I=3,6,9,12,17 I $D(^LR(LRDFN,"MI",LRIDT,I)),'$D(^LR(LRDFN,"MI",LRIDT,I,"B")) D SETBINDX^LRMIBUG(LRDFN,LRIDT,I) "RTN","LRMIEDZ2",164,0) ; "RTN","LRMIEDZ2",165,0) I $D(LRLEDI) Q "RTN","LRMIEDZ2",166,0) ; "RTN","LRMIEDZ2",167,0) ; Set Y(0) for backward compatibility "RTN","LRMIEDZ2",168,0) S Y(0)=LRBG0 "RTN","LRMIEDZ2",169,0) ; "RTN","LRMIEDZ2",170,0) ; Execute code does not contain an edit template but fields/code "RTN","LRMIEDZ2",171,0) I LRTX(LRI)'["S DR=""[",LRSB D Q "RTN","LRMIEDZ2",172,0) . X LRTX(LRI) "RTN","LRMIEDZ2",173,0) . I $G(LREDITTYPE)=3 Q ; If called from LRVR0 then return to complete post actions. "RTN","LRMIEDZ2",174,0) . D EDIT^LRRPLU(LRDFN,LRSS,LRIDT) ; performing lab "RTN","LRMIEDZ2",175,0) . D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; clinical reminders "RTN","LRMIEDZ2",176,0) . D:'LREND EC3 K DR "RTN","LRMIEDZ2",177,0) . D:LRUNDO&$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'="" VT^LRMIUT1 "RTN","LRMIEDZ2",178,0) . D ASKXQA ; ask CPRS alerts "RTN","LRMIEDZ2",179,0) ; "RTN","LRMIEDZ2",180,0) ; Execute code contains an edit template name "RTN","LRMIEDZ2",181,0) S (X,DR)=$P($P(LRTX(LRI),"[",2),"]",1) S:X'="" X=+$O(^DIE("B",X,0)) I X<1,'$D(^DIE(+X,"DR",2,63.05)) W !,DR," template doesn't exist for Microbiology." K DR Q "RTN","LRMIEDZ2",182,0) S J=1 F S J=+$O(^DIE(X,"DR",J)) Q:J<1 S K=+$O(^DIE(X,"DR",J,0)),DR(J-1,K)=^DIE(X,"DR",J,K) "RTN","LRMIEDZ2",183,0) S DR=DR(1,63.05) "RTN","LRMIEDZ2",184,0) D ^DIE "RTN","LRMIEDZ2",185,0) ; "RTN","LRMIEDZ2",186,0) ; If called from LRVR0 then return to complete post actions. "RTN","LRMIEDZ2",187,0) I $G(LREDITTYPE)=3 Q "RTN","LRMIEDZ2",188,0) ; "RTN","LRMIEDZ2",189,0) ; Ask for performing laboratory assignment "RTN","LRMIEDZ2",190,0) D EDIT^LRRPLU(LRDFN,LRSS,LRIDT) "RTN","LRMIEDZ2",191,0) ; "RTN","LRMIEDZ2",192,0) ; Call clincial reminders "RTN","LRMIEDZ2",193,0) D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) "RTN","LRMIEDZ2",194,0) ; "RTN","LRMIEDZ2",195,0) D EC3 "RTN","LRMIEDZ2",196,0) ; "RTN","LRMIEDZ2",197,0) ; Ask to send CPRS alert "RTN","LRMIEDZ2",198,0) D ASKXQA "RTN","LRMIEDZ2",199,0) ; "RTN","LRMIEDZ2",200,0) K DR "RTN","LRMIEDZ2",201,0) Q "RTN","LRMIEDZ2",202,0) ; "RTN","LRMIEDZ2",203,0) UNDO ;LR*5.2*536 version of UNDO "RTN","LRMIEDZ2",204,0) ;Null out the "RPT DATE APPROVED" field so that unverified results are not visible in CPRS "RTN","LRMIEDZ2",205,0) I $G(LRSB)]"",$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U) S $P(^LR(LRDFN,"MI",LRIDT,LRSB),U)="" "RTN","LRMIEDZ2",206,0) S $P(^LR(LRDFN,"MI",LRIDT,0),U,3,4)=U "RTN","LRMIEDZ2",207,0) ;LR*5.2*536: "RTN","LRMIEDZ2",208,0) ; After discussion with Tier 2, it was decided to preserve the settings in file 68 fields "RTN","LRMIEDZ2",209,0) ; Saving the lines below commented out in case this decision changes in the future. "RTN","LRMIEDZ2",210,0) ; S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)="" "RTN","LRMIEDZ2",211,0) ; S $P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=U "RTN","LRMIEDZ2",212,0) ;only set amended report flag if results were previously released by a supervisor "RTN","LRMIEDZ2",213,0) I LRAMX S $P(^LR(LRDFN,"MI",LRIDT,0),U,9)=1 "RTN","LRMIEDZ2",214,0) D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) "RTN","LRMIEDZ2",215,0) Q "RTN","LRMIEDZ2",216,0) ; "RTN","LRMIEDZ2",217,0) BB ; "RTN","LRMIEDZ2",218,0) W !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<^ <<<",! "RTN","LRMIEDZ2",219,0) Q "RTN","LRMIEDZ2",220,0) ; "RTN","LRMIEDZ2",221,0) ; "RTN","LRMIEDZ2",222,0) EC3 ; "RTN","LRMIEDZ2",223,0) S LRSSCN=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11) "RTN","LRMIEDZ2",224,0) D:LRSSCN'=LRSSC UPDATE "RTN","LRMIEDZ2",225,0) K LRSSCN,LRSSC S LRSAME=1 "RTN","LRMIEDZ2",226,0) D TIME^LRMIEDZ3 D:'LREND STF^LRMIUT "RTN","LRMIEDZ2",227,0) Q "RTN","LRMIEDZ2",228,0) ; "RTN","LRMIEDZ2",229,0) ; "RTN","LRMIEDZ2",230,0) UPDATE ; "RTN","LRMIEDZ2",231,0) D CHECK "RTN","LRMIEDZ2",232,0) K LRSSCOM,LRSSCOM1,LRSSCA,LRSSCAA,LRSSCAY,LRSSCAN,LRSSCOD,LRSSCON "RTN","LRMIEDZ2",233,0) Q "RTN","LRMIEDZ2",234,0) ; "RTN","LRMIEDZ2",235,0) ; "RTN","LRMIEDZ2",236,0) CHECK ; "RTN","LRMIEDZ2",237,0) S LRSSCA=$P(^LR(LRDFN,"MI",LRIDT,0),U,6),LRSSCAA=+$O(^LRO(68,"B",$P(LRSSCA," "),0)) "RTN","LRMIEDZ2",238,0) S X=$P(LRSSCA," ",2) D ^%DT S LRSSCAY=Y,LRSSCAN=$P(LRSSCA," ",3) "RTN","LRMIEDZ2",239,0) S J=0 F S J=+$O(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,5,J)) Q:J<1 I ^(J,0)=LRSSC S ^(0)=LRSSCN Q "RTN","LRMIEDZ2",240,0) I J<1 Q "RTN","LRMIEDZ2",241,0) S LRSSCOD=$P(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,0),U,4),LRSSCON=^(.1) "RTN","LRMIEDZ2",242,0) S J=0 F S J=+$O(^LRO(69,LRSSCOD,1,J)) Q:J<1 I $D(^(J,.1)),^(.1)=LRSSCON D ORDER Q "RTN","LRMIEDZ2",243,0) Q "RTN","LRMIEDZ2",244,0) ; "RTN","LRMIEDZ2",245,0) ; "RTN","LRMIEDZ2",246,0) ORDER ; "RTN","LRMIEDZ2",247,0) S $P(^LRO(69,LRSSCOD,1,J,0),U,3)=$P(LRSSCN,U,2) "RTN","LRMIEDZ2",248,0) S K=0 F S K=+$O(^LRO(69,LRSSCOD,1,J,4,K)) Q:K<1 I ^(K,0)=LRSSC S ^(0)=LRSSCN Q "RTN","LRMIEDZ2",249,0) Q "RTN","LRMIEDZ2",250,0) ; "RTN","LRMIEDZ2",251,0) ; "RTN","LRMIEDZ2",252,0) PATINFO ; Display patient information "RTN","LRMIEDZ2",253,0) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 "RTN","LRMIEDZ2",254,0) D PT^LRX "RTN","LRMIEDZ2",255,0) W !!,?5,PNM," SSN: ",SSN "RTN","LRMIEDZ2",256,0) I LRDPF=2 W " LOC: ",$S(LRWRD'="":LRWRD,1:$S($D(^LR(LRDFN,.1)):^(.1),1:"??")),! "RTN","LRMIEDZ2",257,0) ; "RTN","LRMIEDZ2",258,0) I LRDPF?1(1"62.3",1"67.2",1"67.3",1"67.4") Q "RTN","LRMIEDZ2",259,0) ; "RTN","LRMIEDZ2",260,0) W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U) "RTN","LRMIEDZ2",261,0) W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX) "RTN","LRMIEDZ2",262,0) W ?48," Age: ",$$CALCAGE^LRRPU(DOB,LRCDT)," as of ",$$FMTE^XLFDT(LRCDT,"1D") "RTN","LRMIEDZ2",263,0) Q "RTN","LRMIEDZ2",264,0) ; "RTN","LRMIEDZ2",265,0) ; "RTN","LRMIEDZ2",266,0) PROV ; Display provider and contact numbers. "RTN","LRMIEDZ2",267,0) N LRPRAC,LRX "RTN","LRMIEDZ2",268,0) S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8) "RTN","LRMIEDZ2",269,0) I LRPRAC>0,LRPRAC=+LRPRAC D GETS^DIQ(200,LRPRAC_",",".01;.132;.137;.138","E","LRPRAC(LRPRAC)","LRERR") "RTN","LRMIEDZ2",270,0) ; "RTN","LRMIEDZ2",271,0) W !,"Provider: " "RTN","LRMIEDZ2",272,0) ; "RTN","LRMIEDZ2",273,0) I LRPRAC,$D(LRPRAC(LRPRAC,200)) D Q "RTN","LRMIEDZ2",274,0) . W LRPRAC(LRPRAC,200,LRPRAC_",",.01,"E"),?40," Voice pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.137,"E") "RTN","LRMIEDZ2",275,0) . W !," Phone: ",LRPRAC(LRPRAC,200,LRPRAC_",",.132,"E"),?38," Digital pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.138,"E") "RTN","LRMIEDZ2",276,0) ; "RTN","LRMIEDZ2",277,0) S LRX="" "RTN","LRMIEDZ2",278,0) I LRPRAC?1"REF:"1.AN!(LRDPF=67) S LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT) "RTN","LRMIEDZ2",279,0) I LRX'="" W LRX "RTN","LRMIEDZ2",280,0) E W LRPRAC "RTN","LRMIEDZ2",281,0) ; "RTN","LRMIEDZ2",282,0) Q "RTN","LRMIEDZ2",283,0) ; "RTN","LRMIEDZ2",284,0) ; "RTN","LRMIEDZ2",285,0) ASKXQA ; Determine if user should be ask to send CPRS Alert "RTN","LRMIEDZ2",286,0) ; "RTN","LRMIEDZ2",287,0) N LRDEFAULT "RTN","LRMIEDZ2",288,0) ; "RTN","LRMIEDZ2",289,0) ; No CPRS alert for non-PATIENT file (#2) patients "RTN","LRMIEDZ2",290,0) I +LRDPF'=2 Q "RTN","LRMIEDZ2",291,0) ; "RTN","LRMIEDZ2",292,0) S LRDEFAULT=$$GET^XPAR("USR^DIV^PKG","LR MI VERIFY CPRS ALERT",1,"Q") "RTN","LRMIEDZ2",293,0) I LRDEFAULT>0 D ASKXQA^LR7ORB3(LRDFN,"MI",LRIDT,LRUID,LRDEFAULT) "RTN","LRMIEDZ2",294,0) ; "RTN","LRMIEDZ2",295,0) Q "RTN","LRMIPSZ1") 0^5^B51039845^B50337425 "RTN","LRMIPSZ1",1,0) LRMIPSZ1 ;DALOI/STAFF - MICRO PATIENT REPORT ;Aug 14, 2019@10:00 "RTN","LRMIPSZ1",2,0) ;;5.2;LAB SERVICE;**283,350,520,536**;Sep 27, 1994;Build 18 "RTN","LRMIPSZ1",3,0) ; "RTN","LRMIPSZ1",4,0) ; "RTN","LRMIPSZ1",5,0) DQ ;tasked from LRTASK from IMMEDIATE INTERIM REPORTING thru LRTP "RTN","LRMIPSZ1",6,0) ; "RTN","LRMIPSZ1",7,0) S LRPATLOC=$G(LRLLOC),LRIDT=$G(LRIDT,0),LRSS="MI",LRONETST="",LRONESPC="",LREND=0 "RTN","LRMIPSZ1",8,0) D EN^LRPARAM "RTN","LRMIPSZ1",9,0) S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRAD=$E(LRLLT)_$P(LRACC," ",2)_"0000" "RTN","LRMIPSZ1",10,0) S X=$P(LRACC," "),DIC=68,DIC(0)="M" "RTN","LRMIPSZ1",11,0) I X'="" D ^DIC S LRAA=+Y,LRAN=+$P(LRACC," ",3) "RTN","LRMIPSZ1",12,0) ; "RTN","LRMIPSZ1",13,0) ; ^TMP("LRMI",$J,LRDFN,"MI",LRIDT) will already exist if this is a LEDI result being processed (rtn LRVRMI1) "RTN","LRMIPSZ1",14,0) I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D "RTN","LRMIPSZ1",15,0) . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT) "RTN","LRMIPSZ1",16,0) . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32) "RTN","LRMIPSZ1",17,0) ; "RTN","LRMIPSZ1",18,0) S LRCMNT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99)) "RTN","LRMIPSZ1",19,0) S LRPG=0 "RTN","LRMIPSZ1",20,0) D EN "RTN","LRMIPSZ1",21,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","LRMIPSZ1",22,0) Q "RTN","LRMIPSZ1",23,0) ; "RTN","LRMIPSZ1",24,0) ; "RTN","LRMIPSZ1",25,0) EN ; "RTN","LRMIPSZ1",26,0) ; from LRMINEW2, LRMIPC, LRMIPLOG, LRMIPSZ, LRMIVER1 "RTN","LRMIPSZ1",27,0) ; ^TMP("LRMI",$J,LRDFN,"MI",LRIDT) will already exist if this is a LEDI result being processed (rtn LRVRMI1) "RTN","LRMIPSZ1",28,0) I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D ; "RTN","LRMIPSZ1",29,0) . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT) "RTN","LRMIPSZ1",30,0) . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32) "RTN","LRMIPSZ1",31,0) ; "RTN","LRMIPSZ1",32,0) S LRUID=$P($G(^LR(LRDFN,"MI",LRIDT,"ORU")),U) "RTN","LRMIPSZ1",33,0) I '$D(LRONESPC) S LRONESPC="",DIC="^LAB(61,",DIC("A")="Select SPECIMEN/SOURCE: ANY//",DIC(0)="AEMOQ" D ^DIC S:Y>0 LRONESPC=+Y K DIC("A") "RTN","LRMIPSZ1",34,0) I '$D(LRONETST) S LRONETST="",DIC="^LAB(60,",DIC(0)="AEOQ",DIC("S")="I $P(^(0),U,4)=""MI"")"_$S('$D(LRLABKY):",""BO""[$P(^(0),U,3)",1:""),D="E" D IX^DIC Q:Y<1 I Y>0 S LRONETST=+Y "RTN","LRMIPSZ1",35,0) S LRSPEC=$P(LRLLT,U,5) I LRONESPC'="",LRSPEC'=LRONESPC Q "RTN","LRMIPSZ1",36,0) D RPT "RTN","LRMIPSZ1",37,0) I '$G(EAMODE) K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT) "RTN","LRMIPSZ1",38,0) K %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFLIP,LRFMT,LRGRM,LRHC,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM "RTN","LRMIPSZ1",39,0) K LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N "RTN","LRMIPSZ1",40,0) Q "RTN","LRMIPSZ1",41,0) ; "RTN","LRMIPSZ1",42,0) ; "RTN","LRMIPSZ1",43,0) RPT ; "RTN","LRMIPSZ1",44,0) ; "RTN","LRMIPSZ1",45,0) N LRABORT,LRPGDATA,LRPRNTED,LRDISP "RTN","LRMIPSZ1",46,0) ; "RTN","LRMIPSZ1",47,0) ; If called by another process, i.e. interim reports, then don't reset current page number "RTN","LRMIPSZ1",48,0) S LRPG=$G(LRPG,0) "RTN","LRMIPSZ1",49,0) ; "RTN","LRMIPSZ1",50,0) S LRPGDATA("HDR")="D HDR2^LRMIPSU(.LRPRNTED,.LRABORT,.LRPGDATA)" "RTN","LRMIPSZ1",51,0) S LRPGDATA("BM")=8 "RTN","LRMIPSZ1",52,0) S LRPGDATA("FTR")="D FOOT2^LRMIPSU" "RTN","LRMIPSZ1",53,0) ; Dont print the footer when console device "RTN","LRMIPSZ1",54,0) I $E($G(IOST),1,2)="C-" D ; "RTN","LRMIPSZ1",55,0) . S LRPGDATA("BM")=0 "RTN","LRMIPSZ1",56,0) . S LRPGDATA("FTR")="" "RTN","LRMIPSZ1",57,0) S LRPGDATA("PROMPTX")="S X=$$PROMPT^LRMIPSU()" "RTN","LRMIPSZ1",58,0) S LRPGDATA("ERASE")=1 "RTN","LRMIPSZ1",59,0) S LRPGDATA("PGNUM")=0 "RTN","LRMIPSZ1",60,0) S LRABORT=0 "RTN","LRMIPSZ1",61,0) ; "RTN","LRMIPSZ1",62,0) S:'$D(LRSB) LRSB=0 "RTN","LRMIPSZ1",63,0) S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRHC=$S($E(IOST,1,2)'="C-":1,1:0),LRFLIP=$S(LRHC:11,1:6) "RTN","LRMIPSZ1",64,0) ; "RTN","LRMIPSZ1",65,0) K DIC "RTN","LRMIPSZ1",66,0) D DT^LRX "RTN","LRMIPSZ1",67,0) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) "RTN","LRMIPSZ1",68,0) D PT^LRX "RTN","LRMIPSZ1",69,0) S:$G(VAIN(3)) DOB=$P(VADM(3),U) S LRPATLOC=$P(LRLLT,U,8) "RTN","LRMIPSZ1",70,0) S (LRADM,LRADX)="" "RTN","LRMIPSZ1",71,0) I +$G(LRDPF)=2,'$G(VAERR) S LRADM=$P(VAIN(7),U,2),LRADX=VAIN(9) "RTN","LRMIPSZ1",72,0) S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"") "RTN","LRMIPSZ1",73,0) S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:"") "RTN","LRMIPSZ1",74,0) S Y=LRTK D D^LRU S LRTK=Y "RTN","LRMIPSZ1",75,0) S Y=LRRC D D^LRU S LRRC=Y "RTN","LRMIPSZ1",76,0) S X=$P(LRLLT,U,7) D DOC^LRX "RTN","LRMIPSZ1",77,0) ; "RTN","LRMIPSZ1",78,0) K ^TMP("LR",$J,"T"),LRTSTS "RTN","LRMIPSZ1",79,0) ; "RTN","LRMIPSZ1",80,0) S (LRBRR,LRTESTCOMPLE)=0 "RTN","LRMIPSZ1",81,0) F S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1 D EN1 "RTN","LRMIPSZ1",82,0) I 'LRPRINT,LRONETST Q "RTN","LRMIPSZ1",83,0) ; "RTN","LRMIPSZ1",84,0) ; "RTN","LRMIPSZ1",85,0) D HDR2^LRMIPSU(.LRPRNTED,.LRABORT,.LRPGDATA) "RTN","LRMIPSZ1",86,0) S LREND=LRABORT "RTN","LRMIPSZ1",87,0) Q:LRABORT "RTN","LRMIPSZ1",88,0) ; display audit log "RTN","LRMIPSZ1",89,0) D BANNER^LRMIAU2(.LRABORT,.LRPGDATA) "RTN","LRMIPSZ1",90,0) S LREND=LRABORT "RTN","LRMIPSZ1",91,0) Q:LRABORT "RTN","LRMIPSZ1",92,0) ; "RTN","LRMIPSZ1",93,0) I $D(^TMP("LR",$J,"T")) D Q:LRABORT "RTN","LRMIPSZ1",94,0) . N J,LRX,LRY,X,Y "RTN","LRMIPSZ1",95,0) . W !?2,"Test(s) ordered:" "RTN","LRMIPSZ1",96,0) . S J=0 "RTN","LRMIPSZ1",97,0) . F S J=$O(^TMP("LR",$J,"T",J)) Q:J="" D Q:LRABORT "RTN","LRMIPSZ1",98,0) . . S X=^TMP("LR",$J,"T",J) "RTN","LRMIPSZ1",99,0) . . S LRX=$P(X,"^") "RTN","LRMIPSZ1",100,0) . . I LRTESTCOMPLE S LRX=$$LJ^XLFSTR(LRX,30,".") "RTN","LRMIPSZ1",101,0) . . W ?19,LRX "RTN","LRMIPSZ1",102,0) . . I '$P(X,U,2) W ! D NP Q "RTN","LRMIPSZ1",103,0) . . S Y=$P(X,U,2) "RTN","LRMIPSZ1",104,0) . . ; LR*5.2*520 and LR*5.2*536 "RTN","LRMIPSZ1",105,0) . . S LRDISP=$P(X,U,3) "RTN","LRMIPSZ1",106,0) . . D D^LRU S LRY=$S(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y "RTN","LRMIPSZ1",107,0) . . I (19+$L(LRX)+$L(LRY))>IOM W ! "RTN","LRMIPSZ1",108,0) . . W ?50,LRY,! D NP "RTN","LRMIPSZ1",109,0) ; "RTN","LRMIPSZ1",110,0) K ^TMP("LR",$J,"T"),LRTSTS W:LRHC ! "RTN","LRMIPSZ1",111,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14)) D Q:LRABORT ; "RTN","LRMIPSZ1",112,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",113,0) . D ANTI^LRMIPSZ2 "RTN","LRMIPSZ1",114,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",115,0) ; "RTN","LRMIPSZ1",116,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1)) D Q:LRABORT ; "RTN","LRMIPSZ1",117,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",118,0) . D BACT^LRMIPSZ2 Q:LREND "RTN","LRMIPSZ1",119,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",120,0) . D REFS^LRMIPSU Q:LREND "RTN","LRMIPSZ1",121,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",122,0) ; "RTN","LRMIPSZ1",123,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31)) D Q:LRABORT ; "RTN","LRMIPSZ1",124,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",125,0) . D STER^LRMIPSZ3 "RTN","LRMIPSZ1",126,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",127,0) ; "RTN","LRMIPSZ1",128,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5)) D Q:LRABORT Q:LREND ; "RTN","LRMIPSZ1",129,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",130,0) . D PARA^LRMIPSZ3 "RTN","LRMIPSZ1",131,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",132,0) . D REFS^LRMIPSU "RTN","LRMIPSZ1",133,0) . Q:LREND "RTN","LRMIPSZ1",134,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",135,0) ; "RTN","LRMIPSZ1",136,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16)) D Q:LREND Q:LRABORT ; "RTN","LRMIPSZ1",137,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",138,0) . D VIR^LRMIPSZ3 "RTN","LRMIPSZ1",139,0) . D REFS^LRMIPSU Q:LREND Q:LRABORT ; "RTN","LRMIPSZ1",140,0) ; "RTN","LRMIPSZ1",141,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)) D Q:LREND Q:LRABORT ; "RTN","LRMIPSZ1",142,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",143,0) . D TB^LRMIPSZ4 "RTN","LRMIPSZ1",144,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",145,0) . D REFS^LRMIPSU "RTN","LRMIPSZ1",146,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",147,0) ; "RTN","LRMIPSZ1",148,0) I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,8)) D Q:LREND Q:LRABORT ; "RTN","LRMIPSZ1",149,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",150,0) . D FUNG^LRMIPSZ4 "RTN","LRMIPSZ1",151,0) . D NP Q:LRABORT "RTN","LRMIPSZ1",152,0) . D REFS^LRMIPSU "RTN","LRMIPSZ1",153,0) . Q:LREND Q:LRABORT "RTN","LRMIPSZ1",154,0) ; "RTN","LRMIPSZ1",155,0) Q:LRABORT "RTN","LRMIPSZ1",156,0) ; "RTN","LRMIPSZ1",157,0) ; Print any performing labs listing "RTN","LRMIPSZ1",158,0) I $G(LRMODE)'="LDSI" D PPL "RTN","LRMIPSZ1",159,0) ; "RTN","LRMIPSZ1",160,0) ; Write last footer if needed "RTN","LRMIPSZ1",161,0) I 'LRABORT,'$G(LRPGDATA("WFTR")) D ; "RTN","LRMIPSZ1",162,0) . I $G(LRPGDATA("FTR"))="" Q "RTN","LRMIPSZ1",163,0) . I $E($G(IOST),1,2)'="C-" D ; "RTN","LRMIPSZ1",164,0) . . N I,BM "RTN","LRMIPSZ1",165,0) . . S BM=$G(LRPGDATA("BM")) "RTN","LRMIPSZ1",166,0) . . F I=$Y+1:1:($G(IOSL,60)-BM-1) W ! "RTN","LRMIPSZ1",167,0) . X LRPGDATA("FTR") "RTN","LRMIPSZ1",168,0) ; "RTN","LRMIPSZ1",169,0) I 'LRABORT D ; "RTN","LRMIPSZ1",170,0) . N PAD,STR,I,II "RTN","LRMIPSZ1",171,0) . S X=" End of Report ",PAD="+ ",STR="" "RTN","LRMIPSZ1",172,0) . S I=IOM-($L(X)*3),I=I/4/$L(PAD) "RTN","LRMIPSZ1",173,0) . F II=1:1:3 S STR=STR_$$REPEAT^XLFSTR(PAD,I)_X "RTN","LRMIPSZ1",174,0) . S STR=STR_$$REPEAT^XLFSTR(PAD,I) "RTN","LRMIPSZ1",175,0) . W !,$$CJ^XLFSTR(STR,IOM) "RTN","LRMIPSZ1",176,0) . F I=$Y+1:1:($G(IOSL,60)-$G(LRPGDATA("BM"))-1) W ! "RTN","LRMIPSZ1",177,0) . S (LRABORT,LREND)=$$MORE^LRUTIL($$PROMPT^LRMIPSU(),0) "RTN","LRMIPSZ1",178,0) . ; LRMLTRPT indicates multi report (set in SENDUP^LRMIPLOG) "RTN","LRMIPSZ1",179,0) . I $G(LRMLTRPT),$E($G(IOST),1,2)="P-",$G(IOF)'="" W @IOF "RTN","LRMIPSZ1",180,0) ; "RTN","LRMIPSZ1",181,0) Q "RTN","LRMIPSZ1",182,0) ; "RTN","LRMIPSZ1",183,0) ; "RTN","LRMIPSZ1",184,0) EN1 ; "RTN","LRMIPSZ1",185,0) ; LR*5.2*520 Set disposition to LRDISP "RTN","LRMIPSZ1",186,0) S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5),LRDISP=$P(^(0),U,6) "RTN","LRMIPSZ1",187,0) Q:'$L($P($G(^LAB(60,LRTS,0)),U,3)) "RTN","LRMIPSZ1",188,0) I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q "RTN","LRMIPSZ1",189,0) ; "RTN","LRMIPSZ1",190,0) ; Set flag that at least one test is completed "RTN","LRMIPSZ1",191,0) I LRTS(1) S LRTESTCOMPLE=1 "RTN","LRMIPSZ1",192,0) ; "RTN","LRMIPSZ1",193,0) S:LRTS=LRONETST LRPRINT=1 "RTN","LRMIPSZ1",194,0) S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test"),^TMP("LR",$J,"T",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)_U_LRDISP "RTN","LRMIPSZ1",195,0) Q "RTN","LRMIPSZ1",196,0) ; "RTN","LRMIPSZ1",197,0) ; "RTN","LRMIPSZ1",198,0) NP ; "RTN","LRMIPSZ1",199,0) ; Convenience method "RTN","LRMIPSZ1",200,0) ; Some methods in these report routines may be called by a different parent so need to handle this if needed. "RTN","LRMIPSZ1",201,0) I '$D(LRABORT) S LRABORT=0 "RTN","LRMIPSZ1",202,0) Q:'$D(LRPGDATA) "RTN","LRMIPSZ1",203,0) D NP^LRUTIL(.LRABORT,.LRPGDATA) "RTN","LRMIPSZ1",204,0) S LRPG=$G(LRPGDATA("PGNUM"),1) "RTN","LRMIPSZ1",205,0) ; "RTN","LRMIPSZ1",206,0) ; backward compatability (for SENDUP^LRMIPLOG) "RTN","LRMIPSZ1",207,0) S LREND=LRABORT "RTN","LRMIPSZ1",208,0) Q "RTN","LRMIPSZ1",209,0) ; "RTN","LRMIPSZ1",210,0) ; "RTN","LRMIPSZ1",211,0) PPL ; Print any performing laboratories "RTN","LRMIPSZ1",212,0) ; "RTN","LRMIPSZ1",213,0) N LRPL,LRI,LRX,LRY "RTN","LRMIPSZ1",214,0) ; "RTN","LRMIPSZ1",215,0) D RETLST^LRRPL(.LRPL,LRDFN,"MI",LRIDT,0) "RTN","LRMIPSZ1",216,0) I $G(LRPL)<1 Q "RTN","LRMIPSZ1",217,0) ; "RTN","LRMIPSZ1",218,0) ; Start new page if space on existing page too small to display a significant portion of labs "RTN","LRMIPSZ1",219,0) S LRY=IOSL-$Y S:LRY<1 LRY=1 "RTN","LRMIPSZ1",220,0) I (LRPL/LRY)>1 D "RTN","LRMIPSZ1",221,0) . F LRI=$Y+1:1:($G(IOSL,60)-$G(LRPGDATA("BM"))-1) W ! "RTN","LRMIPSZ1",222,0) . D NP "RTN","LRMIPSZ1",223,0) E S LRX="=--" W !!,$$REPEAT^XLFSTR(LRX,IOM/$L(LRX)) "RTN","LRMIPSZ1",224,0) ; "RTN","LRMIPSZ1",225,0) W !,"Performing Laboratory:",! "RTN","LRMIPSZ1",226,0) S LRI=0 "RTN","LRMIPSZ1",227,0) F S LRI=$O(LRPL(LRI)) Q:'LRI D Q:LRABORT "RTN","LRMIPSZ1",228,0) . W !,LRPL(LRI) "RTN","LRMIPSZ1",229,0) . D NP "RTN","LRMIPSZ1",230,0) . I 'LRABORT,LRPGDATA("NP") W !,"Performing Laboratory (cont'd):",! "RTN","LRMIPSZ1",231,0) ; "RTN","LRMIPSZ1",232,0) I 'LRABORT W ! "RTN","LRMIPSZ1",233,0) ; "RTN","LRMIPSZ1",234,0) Q "RTN","LRWRKINC") 0^2^B113702611^B75427718 "RTN","LRWRKINC",1,0) LRWRKINC ;SLC/DCM/CJS-INCOMPLETE STATUS REPORT ;2/19/91 11:47 "RTN","LRWRKINC",2,0) ;;5.2;LAB SERVICE;**153,201,221,453,536**;Sep 27, 1994;Build 18 "RTN","LRWRKINC",3,0) EN ; "RTN","LRWRKINC",4,0) K ^TMP($J),^TMP("LR",$J),^TMP("LRWRKINC",$J) "RTN","LRWRKINC",5,0) K %ZIS,DIC "RTN","LRWRKINC",6,0) S Y=$$NOW^XLFDT D DD^LRX S LRDT=Y "RTN","LRWRKINC",7,0) S (LRCNT,LRCUTOFF,LREND,LREXD,LREXTST,LRNOCNTL,LREXNREQ)=0,LRSORTBY=1 "RTN","LRWRKINC",8,0) S DIC="^LRO(68,",DIC(0)="AEMOQZ" "RTN","LRWRKINC",9,0) F D Q:$G(LRAA)<1!(LREND) "RTN","LRWRKINC",10,0) . N LAST,LRAD,LRAN,LRFAN,LRLAN,LRWDTL,LRSTAR,LRUSEAA,X,Y "RTN","LRWRKINC",11,0) . D ^DIC "RTN","LRWRKINC",12,0) . I $D(DUOUT) S LREND=1 Q "RTN","LRWRKINC",13,0) . S LRAA=+Y,LRAA(0)=$G(Y(0)) "RTN","LRWRKINC",14,0) . I LRAA<1 Q "RTN","LRWRKINC",15,0) . D CHKAA^LRWRKIN1 "RTN","LRWRKINC",16,0) . I LREND Q "RTN","LRWRKINC",17,0) . I '$L(LRUSEAA) D PHD Q:LREND "RTN","LRWRKINC",18,0) . S LRCNT=LRCNT+1,^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,0)=LRAA(0) "RTN","LRWRKINC",19,0) . I $L(LRUSEAA) D "RTN","LRWRKINC",20,0) . . N X "RTN","LRWRKINC",21,0) . . S X=$P($G(^LRO(68,LRUSEAA,0)),"^")_"^"_LRUSEAA "RTN","LRWRKINC",22,0) . . S ^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,1)=^TMP("LRWRKINC",$J,$P(LRUSEAA,"^",1,2),$P(LRUSEAA,"^",3),1) "RTN","LRWRKINC",23,0) . E S ^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,1)=$G(LRAD)_"^"_$G(LRFAN)_"^"_$G(LRLAN)_"^"_$G(LRSTAR)_"^"_$G(LAST)_"^"_$G(LRWDTL) "RTN","LRWRKINC",24,0) . W ! "RTN","LRWRKINC",25,0) I LREND!('$D(^TMP("LRWRKINC",$J))) D LREND^LRWRKIN1 Q "RTN","LRWRKINC",26,0) K DIC "RTN","LRWRKINC",27,0) N DIR,DIRUT,DTOUT,DUOUT "RTN","LRWRKINC",28,0) I LRCNT>1 D "RTN","LRWRKINC",29,0) . S DIR(0)="SO^1:ACCESSION AREA;2:TEST NAME",DIR("A")="Sort Report By",DIR("B")=1 "RTN","LRWRKINC",30,0) . S DIR("?",1)="ACCESSION AREA will separate tests by accession area, then by test name." "RTN","LRWRKINC",31,0) . S DIR("?")="TEST NAME will list tests alphabetically without regard to accession area." "RTN","LRWRKINC",32,0) . D ^DIR "RTN","LRWRKINC",33,0) . I $D(DIRUT) S LREND=1 Q "RTN","LRWRKINC",34,0) . S LRSORTBY=+Y "RTN","LRWRKINC",35,0) I LREND D LREND^LRWRKIN1 Q "RTN","LRWRKINC",36,0) S DIR(0)="YO",DIR("A")="Specify detailed sort criteria",DIR("B")="NO" "RTN","LRWRKINC",37,0) S DIR("?",1)="Answer 'YES' if you WANT to specify detailed criteria." "RTN","LRWRKINC",38,0) S DIR("?",2)="Examples are excluding controls, specifying a lab arrival cut-off time," "RTN","LRWRKINC",39,0) S DIR("?",3)="selecting or excluding specific tests, or excluding non-required tests." "RTN","LRWRKINC",40,0) S DIR("?")="Answer 'NO' if you DO NOT want to specify detailed criteria." "RTN","LRWRKINC",41,0) D ^DIR "RTN","LRWRKINC",42,0) I $D(DIRUT) D LREND^LRWRKIN1 Q "RTN","LRWRKINC",43,0) I Y=1 D "RTN","LRWRKINC",44,0) . K DIR "RTN","LRWRKINC",45,0) . S DIR(0)="DO^::EXT",DIR("A")="Lab Arrival Cut-off" "RTN","LRWRKINC",46,0) . S DIR("?",1)="Entering a date/time will exclude uncollected specimens and" "RTN","LRWRKINC",47,0) . S DIR("?")="specimens with a lab arrival time after the time specified." "RTN","LRWRKINC",48,0) . D ^DIR "RTN","LRWRKINC",49,0) . I $D(DUOUT)!($D(DTOUT)) Q "RTN","LRWRKINC",50,0) . I Y>0 S LRCUTOFF=+Y "RTN","LRWRKINC",51,0) . K DIR "RTN","LRWRKINC",52,0) . S DIR(0)="YO",DIR("A")="Do you want to exclude controls",DIR("B")="YES" "RTN","LRWRKINC",53,0) . S DIR("?",1)="Answer 'NO' if you WANT accessions for LAB CONTROLS included on" "RTN","LRWRKINC",54,0) . S DIR("?")="the report. 'YES' if you DO NOT want accessions for LAB CONTROLS." "RTN","LRWRKINC",55,0) . D ^DIR "RTN","LRWRKINC",56,0) . I $D(DIRUT) Q "RTN","LRWRKINC",57,0) . S LRNOCNTL=+Y "RTN","LRWRKINC",58,0) . K DIR "RTN","LRWRKINC",59,0) . S DIR(0)="YO",DIR("A")="Do you want a specific test",DIR("B")="NO" "RTN","LRWRKINC",60,0) . D ^DIR "RTN","LRWRKINC",61,0) . I $D(DIRUT) Q "RTN","LRWRKINC",62,0) . I Y=1 D "RTN","LRWRKINC",63,0) . . N I,LRY "RTN","LRWRKINC",64,0) . . K DIR "RTN","LRWRKINC",65,0) . . S DIR(0)="YO",DIR("A")="Check tests on panels also",DIR("B")="YES" "RTN","LRWRKINC",66,0) . . S DIR("?",1)="If you select a panel test do you want to also check" "RTN","LRWRKINC",67,0) . . S DIR("?")="the tests that make up the panel for an incomplete status." "RTN","LRWRKINC",68,0) . . D ^DIR "RTN","LRWRKINC",69,0) . . I $D(DIRUT) Q "RTN","LRWRKINC",70,0) . . S LRY=+Y "RTN","LRWRKINC",71,0) . . N DIC "RTN","LRWRKINC",72,0) . . S DIC="^LAB(60,",DIC(0)="AEFOQZ" "RTN","LRWRKINC",73,0) . . F D Q:+Y<1 "RTN","LRWRKINC",74,0) . . . N LRTEST,LRTSTS "RTN","LRWRKINC",75,0) . . . D ^DIC Q:+Y<1 "RTN","LRWRKINC",76,0) . . . S ^TMP("LR",$J,"T",+Y)=Y(0) "RTN","LRWRKINC",77,0) . . . I LRY S LRTEST=+Y,LREXPD="D LREXPD^LRWRKINC" D ^LREXPD "RTN","LRWRKINC",78,0) . I $D(DIRUT) Q "RTN","LRWRKINC",79,0) . K DIR "RTN","LRWRKINC",80,0) . S DIR(0)="YO" "RTN","LRWRKINC",81,0) . S DIR("A")="Do you want to exclude a specific test",DIR("B")="NO" "RTN","LRWRKINC",82,0) . D ^DIR "RTN","LRWRKINC",83,0) . I $D(DIRUT) Q "RTN","LRWRKINC",84,0) . I Y=1 D "RTN","LRWRKINC",85,0) . . N DIC "RTN","LRWRKINC",86,0) . . S DIC="^LAB(60,",DIC(0)="AEFOQ",DIC("S")="I '$D(^TMP(""LR"",$J,""T"",Y))" "RTN","LRWRKINC",87,0) . . F D ^DIC Q:+Y<1 S LREXTST(+Y)="",LREXTST=1 "RTN","LRWRKINC",88,0) . K DIR "RTN","LRWRKINC",89,0) . S DIR(0)="YO",DIR("A")="Exclude non-required tests",DIR("B")="YES" "RTN","LRWRKINC",90,0) . S DIR("?",1)="Answer 'NO' if you WANT incomplete non-required test included on" "RTN","LRWRKINC",91,0) . S DIR("?")="the report. 'YES' if you DO NOT want non-required tests." "RTN","LRWRKINC",92,0) . D ^DIR "RTN","LRWRKINC",93,0) . I $D(DIRUT) Q "RTN","LRWRKINC",94,0) . S LREXNREQ=+Y "RTN","LRWRKINC",95,0) I $D(DIRUT) D LREND^LRWRKIN1 Q "RTN","LRWRKINC",96,0) S DIR(0)="YO",DIR("A")="Do you want an extended display",DIR("B")="NO" "RTN","LRWRKINC",97,0) S DIR("?")="Extended display will show UID and other referral information" "RTN","LRWRKINC",98,0) D ^DIR "RTN","LRWRKINC",99,0) I $D(DIRUT) D LREND^LRWRKIN1 Q "RTN","LRWRKINC",100,0) S LREXD=+Y "RTN","LRWRKINC",101,0) S %ZIS="Q" D ^%ZIS "RTN","LRWRKINC",102,0) I POP D LREND^LRWRKIN1 Q "RTN","LRWRKINC",103,0) I $D(IO("Q")) D Q "RTN","LRWRKINC",104,0) . S ZTRTN="DQ^LRWRKINC",ZTDESC="Lab incomplete test list",ZTSAVE("LR*")="" "RTN","LRWRKINC",105,0) . S ZTSAVE("^TMP(""LRWRKINC"",$J,")="" "RTN","LRWRKINC",106,0) . I $D(^TMP("LR",$J,"T")) S ZTSAVE("^TMP(""LR"",$J,""T"",")="" "RTN","LRWRKINC",107,0) . D ^%ZTLOAD,^%ZISC "RTN","LRWRKINC",108,0) . W !,"Request ",$S($G(ZTSK):"Queued - Task #"_ZTSK,1:"NOT Queued") "RTN","LRWRKINC",109,0) . D LREND^LRWRKIN1 "RTN","LRWRKINC",110,0) ; "RTN","LRWRKINC",111,0) DQ ; "RTN","LRWRKINC",112,0) U IO "RTN","LRWRKINC",113,0) ;LR*5.2*536: Variable LRMI* variables in next line indicate Microbiology accession "RTN","LRWRKINC",114,0) N LRMIFLG,LRMIARX,LRMIPND "RTN","LRWRKINC",115,0) S (LRAA,LRINDEX,LRPAGE)=0,(LRX,LRY)="" "RTN","LRWRKINC",116,0) F S LRX=$O(^TMP("LRWRKINC",$J,LRX)) Q:LRX="" D "RTN","LRWRKINC",117,0) . N LRZ "RTN","LRWRKINC",118,0) . S LRZ=0 "RTN","LRWRKINC",119,0) . F S LRZ=$O(^TMP("LRWRKINC",$J,LRX,LRZ)) Q:'LRZ D "RTN","LRWRKINC",120,0) . . N LRFAN,LRLAN,LRSTAR,LRLAST,LRY "RTN","LRWRKINC",121,0) . . F I=0,1 S LRZ(I)=$G(^TMP("LRWRKINC",$J,LRX,LRZ,I)) "RTN","LRWRKINC",122,0) . . S LRFAN=$P(LRZ(1),"^",2),LRLAN=$P(LRZ(1),"^",3),LRSTAR=$P(LRZ(1),"^",4),LRLAST=$P(LRZ(1),"^",5) "RTN","LRWRKINC",123,0) . . I LRSTAR,LRLAST S LRY="From Date: "_$$FMTE^XLFDT(LRSTAR,"5DZ")_" To: "_$$FMTE^XLFDT(LRLAST,"5DZ") "RTN","LRWRKINC",124,0) . . E S LRY=" For Date: "_$$FMTE^XLFDT(LRLAST,"5DZ")_" From: "_LRFAN_" To: "_LRLAN "RTN","LRWRKINC",125,0) . . S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)=$$LJ^XLFSTR($E($P(LRZ(0),"^"),1,20),22)_LRY "RTN","LRWRKINC",126,0) S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)=$S(LRINDEX>1:"Sorted by "_$S(LRSORTBY=1:"Accession Area",1:"Test Name")_"; ",1:"")_"Controls Excluded: "_$S(LRNOCNTL:"YES",1:"NO")_"; Specific Tests: "_$S($D(^TMP("LR",$J,"T")):"YES",1:"NO") "RTN","LRWRKINC",127,0) S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)="Exclude Specific Tests: "_$S(LREXTST:"YES",1:"NO")_"; Required Tests Only: "_$S(LREXNREQ:"YES",1:"NO") "RTN","LRWRKINC",128,0) I LRCUTOFF S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)="For Tests Received Before: "_$$FMTE^XLFDT(LRCUTOFF,"5MZ") "RTN","LRWRKINC",129,0) D HED^LRWRKIN1 D URG^LRX "RTN","LRWRKINC",130,0) S LRX="" "RTN","LRWRKINC",131,0) F S LRX=$O(^TMP("LRWRKINC",$J,LRX)) Q:LRX="" D "RTN","LRWRKINC",132,0) . S LRZ=0 "RTN","LRWRKINC",133,0) . F S LRZ=$O(^TMP("LRWRKINC",$J,LRX,LRZ)) Q:'LRZ D "RTN","LRWRKINC",134,0) . . I LRSORTBY=1 S LRAA("NAME")=$P(LRX,"^") "RTN","LRWRKINC",135,0) . . S X=^TMP("LRWRKINC",$J,LRX,LRZ,1) "RTN","LRWRKINC",136,0) . . S LRAA=$P(LRX,"^",2),LRAD=$P(X,"^"),LRFAN=$P(X,"^",2),LRLAN=$P(X,"^",3),LRSTAR=$P(X,"^",4),LAST=$P(X,"^",5),LRWDTL=$P(X,"^",6) "RTN","LRWRKINC",137,0) . . N LRX,LRZ "RTN","LRWRKINC",138,0) . . F S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD<1!(LRAD>LAST) D "RTN","LRWRKINC",139,0) . . . I $G(LRSTAR) D AC Q "RTN","LRWRKINC",140,0) . . . S LRAN=LRFAN-1 "RTN","LRWRKINC",141,0) . . . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LRLAN) D "RTN","LRWRKINC",142,0) . . . . S LREND=0 "RTN","LRWRKINC",143,0) . . . . D TD Q:LREND "RTN","LRWRKINC",144,0) . . . . I 'LRVERVER D LST1^LRWRKIN1,TESTS "RTN","LRWRKINC",145,0) D X^LRWRKIN1 "RTN","LRWRKINC",146,0) I LREND D LREND^LRWRKIN1 Q "RTN","LRWRKINC",147,0) D EQUALS^LRX D WAIT^LRWRKIN1:$E(IOST,1,2)="C-" "RTN","LRWRKINC",148,0) D LREND^LRWRKIN1 "RTN","LRWRKINC",149,0) Q "RTN","LRWRKINC",150,0) ; "RTN","LRWRKINC",151,0) TD ; "RTN","LRWRKINC",152,0) N LRMIAREA,LRDFNX,LRIDTX,LRTST68 "RTN","LRWRKINC",153,0) K LRMIARX,LRMIPND "RTN","LRWRKINC",154,0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 Q "RTN","LRWRKINC",155,0) I LRNOCNTL,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)=62.3 S LREND=1 Q "RTN","LRWRKINC",156,0) S LRVERVER=1,(I,LRMIFLG)=0 "RTN","LRWRKINC",157,0) F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 I $D(^(I,0)) S LRVERVER=(LRVERVER&$P(^(0),U,5)) "RTN","LRWRKINC",158,0) ;LR*5.2*536 - if "RPT DATE APPROVED" has not been populated for Microbiology accessions, "RTN","LRWRKINC",159,0) ; display accession on the Incomplete list "RTN","LRWRKINC",160,0) ; (considered combining logic below with lines above, but decided to keep "RTN","LRWRKINC",161,0) ; Microbiology logic separate in case further changes are needed.) "RTN","LRWRKINC",162,0) I $P(^LRO(68,LRAA,0),U,2)="MI" D "RTN","LRWRKINC",163,0) . S LRDFNX=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U) "RTN","LRWRKINC",164,0) . S LRIDTX=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5) "RTN","LRWRKINC",165,0) . ;Subscripts: 1 = Bacteriology; 5=Parasitology; 8=Mycology; 11=TB; 16=Virology "RTN","LRWRKINC",166,0) . I LRIDTX>1 F LRMIAREA=1,5,8,11,16 D "RTN","LRWRKINC",167,0) . . ;using a different flag for Micro so that this change will only affect Micro "RTN","LRWRKINC",168,0) . . ;in the TESTS subsection of this routine "RTN","LRWRKINC",169,0) . . ;LRMIFLG = "[area] RPT DATE APPROVED" is not populated "RTN","LRWRKINC",170,0) . . I $D(^LR(LRDFNX,"MI",LRIDTX,LRMIAREA)),$P(^(LRMIAREA),U)="" D "RTN","LRWRKINC",171,0) . . . S LRVERVER=0,LRMIFLG=1 "RTN","LRWRKINC",172,0) . . . S LRMIARX(LRMIAREA)="" "RTN","LRWRKINC",173,0) . Q:'$D(LRMIARX) "RTN","LRWRKINC",174,0) . ;determine which tests on the accession are defined for the pending Microbiology "RTN","LRWRKINC",175,0) . ;area subscript "RTN","LRWRKINC",176,0) . S LRTST68=0 "RTN","LRWRKINC",177,0) . F S LRTST68=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTST68)) Q:LRTST68<.5 D "RTN","LRWRKINC",178,0) . . N LREXCODE "RTN","LRWRKINC",179,0) . . S LREXCODE=$P($G(^LAB(60,LRTST68,0)),"^",14) "RTN","LRWRKINC",180,0) . . I LREXCODE]"" S LREXCODE=$G(^LAB(62.07,LREXCODE,.1)) "RTN","LRWRKINC",181,0) . . ;Logic below is the same as the logic in result verification routine LRMIEDZ2 which "RTN","LRWRKINC",182,0) . . ;determines which Microbiology area is defined for a Microbiology test "RTN","LRWRKINC",183,0) . . S LRMIAREA=$S(LREXCODE["11.5":1,LREXCODE["23":11,LREXCODE["19":8,LREXCODE["15":5,LREXCODE["34":16,1:"") "RTN","LRWRKINC",184,0) . . ;setting an array because more than one test on the accession might be defined for the "RTN","LRWRKINC",185,0) . . ;Microbiology area "RTN","LRWRKINC",186,0) . . I LRMIAREA]"",$D(LRMIARX(LRMIAREA)) S LRMIPND(LRTST68)="" "RTN","LRWRKINC",187,0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) S LREND=1 "RTN","LRWRKINC",188,0) Q "RTN","LRWRKINC",189,0) ; "RTN","LRWRKINC",190,0) TESTS Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) "RTN","LRWRKINC",191,0) N LRI "RTN","LRWRKINC",192,0) S LRI=0 "RTN","LRWRKINC",193,0) F S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:LRI<.5 D "RTN","LRWRKINC",194,0) . N LR60,LRURG,LRTSTN "RTN","LRWRKINC",195,0) . S LRI(0)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0)),LRURG=+$P(LRI(0),U,2) "RTN","LRWRKINC",196,0) . S LR60=+LRI(0) "RTN","LRWRKINC",197,0) . I $D(^TMP("LR",$J,"T")),'$D(^TMP("LR",$J,"T",LR60)) Q ; Not specific test "RTN","LRWRKINC",198,0) . I LREXTST,$D(LREXTST(LR60)) Q ; Exclude specific test "RTN","LRWRKINC",199,0) . ;LR*5.2*536: "RTN","LRWRKINC",200,0) . ;LRMIFLG of 1 indicates this is a pending Microbiology accession even though "RTN","LRWRKINC",201,0) . ;a "complete" date has been set at LRI(0),U,5) by the prompt "[test name] completed:" "RTN","LRWRKINC",202,0) . ;(i.e. the "[area] RPT DATE APPROVED:" prompt has not been answered. "RTN","LRWRKINC",203,0) . I $P(LRI(0),U,5),'$G(LRMIFLG) Q "RTN","LRWRKINC",204,0) . ;LR*5.2*536: This is a Microbiology pending accession but the test being evaluated "RTN","LRWRKINC",205,0) . ; is not pending. (There may be more than one Micro test on an accession.) "RTN","LRWRKINC",206,0) . ;The check for LRI(0) is necessary because the area subscript may not yet exist in file 63. "RTN","LRWRKINC",207,0) . I $G(LRMIFLG),'$D(LRMIPND(LR60)),$P(LRI(0),U,5) Q "RTN","LRWRKINC",208,0) . I LRCUTOFF,'LRDLA Q ; Uncollected "RTN","LRWRKINC",209,0) . I LRCUTOFF,LRCUTOFF1&(LRTK\1>LAST)) D "RTN","LRWRKINC",241,0) . S LRAN=0 "RTN","LRWRKINC",242,0) . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN)) Q:'LRAN D "RTN","LRWRKINC",243,0) . . S LREND=0 "RTN","LRWRKINC",244,0) . . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 Q "RTN","LRWRKINC",245,0) . . D TD Q:LREND "RTN","LRWRKINC",246,0) . . ;I LRUNC!('LRVERVER) D LST,TESTS "RTN","LRWRKINC",247,0) . . I 'LRVERVER D LST1^LRWRKIN1,TESTS "RTN","LRWRKINC",248,0) Q "RTN","LRWRKINC",249,0) ; "RTN","LRWRKINC",250,0) % R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G % "RTN","LRWRKINC",251,0) Q "RTN","LRWRKINC",252,0) ; "RTN","LRWRKINC",253,0) LREXPD ;Include panel test in list when selecting specific tests "RTN","LRWRKINC",254,0) I $G(S1(+$G(S1))) S ^TMP("LR",$J,"T",S1(S1))=^LAB(60,S1(S1),0) "RTN","LRWRKINC",255,0) Q "RTN","LRWRKLST") 0^6^B78191861^B65810954 "RTN","LRWRKLST",1,0) LRWRKLST ;DALOI/STAFF - LONG ACCESSION LIST ;02/28/12 19:21 "RTN","LRWRKLST",2,0) ;;5.2;LAB SERVICE;**1,17,38,153,185,221,268,362,350,536**;Sep 27, 1994;Build 18 "RTN","LRWRKLST",3,0) ; "RTN","LRWRKLST",4,0) N LRDICS "RTN","LRWRKLST",5,0) ; "RTN","LRWRKLST",6,0) ; Save and restore DIC("S") if micro long form accession option (LRMIACC1). "RTN","LRWRKLST",7,0) I $D(DIC("S")) S LRDICS=DIC("S") "RTN","LRWRKLST",8,0) D LREND "RTN","LRWRKLST",9,0) I $D(LRDICS) S DIC("S")=LRDICS "RTN","LRWRKLST",10,0) ; "RTN","LRWRKLST",11,0) S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ") "RTN","LRWRKLST",12,0) ; "RTN","LRWRKLST",13,0) S LREND=0 "RTN","LRWRKLST",14,0) S DIC="^LRO(68,",DIC(0)="AEMOQ" "RTN","LRWRKLST",15,0) D ^DIC S LRAA=+Y,LRNAME=$P(Y,U,2) "RTN","LRWRKLST",16,0) I LRAA<1 D LREND Q "RTN","LRWRKLST",17,0) ; "RTN","LRWRKLST",18,0) ; Ask if list by date rather than accession number "RTN","LRWRKLST",19,0) I $P(^LRO(68,LRAA,0),U,3)="Y" D STAR^LRWU3 S LRLAST=$G(LAST) "RTN","LRWRKLST",20,0) I LREND D LREND Q "RTN","LRWRKLST",21,0) ; List by accession number "RTN","LRWRKLST",22,0) I '$D(LRSTAR) D PHD "RTN","LRWRKLST",23,0) I LREND D LREND Q "RTN","LRWRKLST",24,0) ; "RTN","LRWRKLST",25,0) W ; from LRVER, LRVR "RTN","LRWRKLST",26,0) ; Added to protect "%*" variables from %ZTLOAD corruption "RTN","LRWRKLST",27,0) N %,%A,%A0,%B,%B1,%B2,%B3,%BA,%BU,%C,%D1,%D2,%DT,%E,%G,%H,%I,%J "RTN","LRWRKLST",28,0) N %J1,%K,%M,%N,%P,%S,%T,%W,%W0,%X,%Y "RTN","LRWRKLST",29,0) N A0,C,D,DD,DDH,DDQ,DDSV,DG,DH,DIC,DIFLD,DIR,DIRO,DIROUT,DIRUT "RTN","LRWRKLST",30,0) N DIX,DIY,DISYS,DO,DP,DQ,DTOUT,DU,DZ,X1,XQH "RTN","LRWRKLST",31,0) ; "RTN","LRWRKLST",32,0) I '$D(^LRO(68,LRAA,1,LRAD,1,0)),'$D(LRSTAR) D LREND Q "RTN","LRWRKLST",33,0) ; "RTN","LRWRKLST",34,0) S (LRUNC,LRTSE)=0 "RTN","LRWRKLST",35,0) S:'$D(LRNAME) LRNAME=$P(^LRO(68,LRAA,0),U,1) "RTN","LRWRKLST",36,0) ; "RTN","LRWRKLST",37,0) S DIR(0)="YO",DIR("A")="Do you want a specific test",DIR("B")="NO" "RTN","LRWRKLST",38,0) D ^DIR "RTN","LRWRKLST",39,0) I $D(DIRUT) D LREND Q "RTN","LRWRKLST",40,0) I Y=1 D "RTN","LRWRKLST",41,0) . N DIC,X,Y "RTN","LRWRKLST",42,0) . S DIC="^LAB(60,",DIC(0)="AEZOQ" "RTN","LRWRKLST",43,0) . D ^DIC "RTN","LRWRKLST",44,0) . I Y>0 S LRTSE=+Y "RTN","LRWRKLST",45,0) ; "RTN","LRWRKLST",46,0) K DIR "RTN","LRWRKLST",47,0) S DIR(0)="YO",DIR("A")="Do you want only incomplete entries",DIR("B")="YES" "RTN","LRWRKLST",48,0) D ^DIR "RTN","LRWRKLST",49,0) I $D(DIRUT) D LREND Q "RTN","LRWRKLST",50,0) S LRUNC=Y "RTN","LRWRKLST",51,0) ; "RTN","LRWRKLST",52,0) S %ZIS="Q" D ^%ZIS "RTN","LRWRKLST",53,0) I POP D ^%ZISC,LREND Q "RTN","LRWRKLST",54,0) ; "RTN","LRWRKLST",55,0) ; Queue report via Taskman "RTN","LRWRKLST",56,0) I $D(IO("Q")) D Q "RTN","LRWRKLST",57,0) . N ZTDESC,ZTSK,ZTRTN,ZTIO,ZTSAVE,%T "RTN","LRWRKLST",58,0) . S ZTRTN="ENT^LRWRKLST",ZTDESC="Long form accession list",ZTSAVE("LR*")="" "RTN","LRWRKLST",59,0) . D ^%ZTLOAD,^%ZISC "RTN","LRWRKLST",60,0) . W !,"Task ",$S($G(ZTSK):ZTSK,1:"NOT")," Queued" "RTN","LRWRKLST",61,0) . D LREND K IO("Q") "RTN","LRWRKLST",62,0) ; "RTN","LRWRKLST",63,0) ENT ; "RTN","LRWRKLST",64,0) ; "RTN","LRWRKLST",65,0) N LRTST,LRMIPND "RTN","LRWRKLST",66,0) ; "RTN","LRWRKLST",67,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","LRWRKLST",68,0) S (LREND,LRSTOP)=0 "RTN","LRWRKLST",69,0) ; "RTN","LRWRKLST",70,0) ; "RTN","LRWRKLST",71,0) U IO "RTN","LRWRKLST",72,0) D HED,URG^LRX "RTN","LRWRKLST",73,0) ; "RTN","LRWRKLST",74,0) ; Process by accession date "RTN","LRWRKLST",75,0) I '$D(LRSTAR) D "RTN","LRWRKLST",76,0) . S LRAN=LRFAN-1 "RTN","LRWRKLST",77,0) . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LRLAN) D Q:LRSTOP "RTN","LRWRKLST",78,0) . . S LREND=0 D TD "RTN","LRWRKLST",79,0) . . I LREND Q "RTN","LRWRKLST",80,0) . . D LST,TESTS "RTN","LRWRKLST",81,0) ; "RTN","LRWRKLST",82,0) ; Process by date received in lab - yearly accession area "RTN","LRWRKLST",83,0) I $D(LRSTAR) D "RTN","LRWRKLST",84,0) . F S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD<1!(LRAD>LRWDTL) D AC Q:LRSTOP "RTN","LRWRKLST",85,0) ; "RTN","LRWRKLST",86,0) D ^%ZISC,LREND "RTN","LRWRKLST",87,0) Q "RTN","LRWRKLST",88,0) ; "RTN","LRWRKLST",89,0) ; "RTN","LRWRKLST",90,0) TD ; Check tests on accession to determine if meets criteria to display. "RTN","LRWRKLST",91,0) ; If incomplete only (LRUNC=1) and complete date then skip "RTN","LRWRKLST",92,0) ; If not specific test selected (LRTSE=file #60 ien) then skip "RTN","LRWRKLST",93,0) ; Otherwise set LRTST array with file #60 ien. "RTN","LRWRKLST",94,0) ; "RTN","LRWRKLST",95,0) K LRTST,LRMIPND "RTN","LRWRKLST",96,0) ; "RTN","LRWRKLST",97,0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 Q "RTN","LRWRKLST",98,0) S LRSN=+$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5),LRDAT=+$P(^(0),U,4) "RTN","LRWRKLST",99,0) S LRI=0 "RTN","LRWRKLST",100,0) F S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:LRI<.5 D "RTN","LRWRKLST",101,0) . I LRTSE,LRTSE'=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0) Q "RTN","LRWRKLST",102,0) . ;LR*5.2*536 added line below "RTN","LRWRKLST",103,0) . I $P(^LRO(68,LRAA,0),U,2)="MI",$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0),"^",5) D MICRO "RTN","LRWRKLST",104,0) . I LRUNC,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0),"^",5) Q "RTN","LRWRKLST",105,0) . S LRTST(LRI)="" "RTN","LRWRKLST",106,0) ; "RTN","LRWRKLST",107,0) I '$D(LRTST) S LREND=1 "RTN","LRWRKLST",108,0) Q "RTN","LRWRKLST",109,0) ; "RTN","LRWRKLST",110,0) MICRO ;further evaluation for Microbiology test "RTN","LRWRKLST",111,0) N LRDFNX,LRIDTX,LREXCODE,LRMIAREA "RTN","LRWRKLST",112,0) S LRDFNX=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U) "RTN","LRWRKLST",113,0) S LRIDTX=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5) "RTN","LRWRKLST",114,0) S LREXCODE=$P($G(^LAB(60,LRI,0)),"^",14) "RTN","LRWRKLST",115,0) Q:'LREXCODE "RTN","LRWRKLST",116,0) S LREXCODE=$G(^LAB(62.07,LREXCODE,.1)) "RTN","LRWRKLST",117,0) ;Logic below is the same as the logic in result verification "RTN","LRWRKLST",118,0) ;routine LRMIEDZ2 which determines which Microbiology area is "RTN","LRWRKLST",119,0) ;defined for a Microbiology test "RTN","LRWRKLST",120,0) S LRMIAREA=$S(LREXCODE["11.5":1,LREXCODE["23":11,LREXCODE["19":8,LREXCODE["15":5,LREXCODE["34":16,1:"") "RTN","LRWRKLST",121,0) ;If the [area] RPT DATE APPROVED field is null, display this test as "pending" "RTN","LRWRKLST",122,0) I $D(^LR(LRDFNX,"MI",LRIDTX,LRMIAREA)),$P(^(LRMIAREA),U)="" D "RTN","LRWRKLST",123,0) . ;Include on report as a pending test if user specific only incompletes "RTN","LRWRKLST",124,0) . I LRUNC S LRTST(LRI)="" "RTN","LRWRKLST",125,0) . ;flag as a pending test for section TS2 "RTN","LRWRKLST",126,0) . S LRMIPND(LRI)="" "RTN","LRWRKLST",127,0) Q "RTN","LRWRKLST",128,0) ; "RTN","LRWRKLST",129,0) TESTS ; "RTN","LRWRKLST",130,0) N S1,S2 "RTN","LRWRKLST",131,0) ; "RTN","LRWRKLST",132,0) D CHKPAGE^LRWRKLS1 "RTN","LRWRKLST",133,0) Q:LRSTOP!LREND "RTN","LRWRKLST",134,0) ; "RTN","LRWRKLST",135,0) Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) "RTN","LRWRKLST",136,0) ; "RTN","LRWRKLST",137,0) S LRSPEC=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)),LRSAMP=$S(LRSPEC:$P(^(0),U,2),1:"") "RTN","LRWRKLST",138,0) S S1=$P($G(^LAB(61,+LRSPEC,0)),U,1) "RTN","LRWRKLST",139,0) S S2=$P($G(^LAB(62,+LRSAMP,0)),U,1) "RTN","LRWRKLST",140,0) ; "RTN","LRWRKLST",141,0) W !," SAMPLE: ",S1_$S(S1'=S2:" "_S2,1:"") "RTN","LRWRKLST",142,0) S LN=LN+1 "RTN","LRWRKLST",143,0) ; "RTN","LRWRKLST",144,0) S LRLO69=$G(^LRO(69,LRDAT,1,LRSN,0)) "RTN","LRWRKLST",145,0) I LRLO69'="",$D(^LRO(69,LRDAT,1,LRSN,1)),$L($P(^(1),U,6)) W !,$P(^(1),U,6) S LN=LN+1 "RTN","LRWRKLST",146,0) ; "RTN","LRWRKLST",147,0) K LRNAC "RTN","LRWRKLST",148,0) S LRI=0 "RTN","LRWRKLST",149,0) F S LRI=$O(LRTST(LRI)) Q:'LRI D TS2 "RTN","LRWRKLST",150,0) ; "RTN","LRWRKLST",151,0) I '$D(LRNAC),$L($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,4)) D "RTN","LRWRKLST",152,0) . W !,"ALL COMPLETED",!! "RTN","LRWRKLST",153,0) . S LN=LN+3 "RTN","LRWRKLST",154,0) Q "RTN","LRWRKLST",155,0) ; "RTN","LRWRKLST",156,0) ; "RTN","LRWRKLST",157,0) TS2 ; "RTN","LRWRKLST",158,0) ; "RTN","LRWRKLST",159,0) D CHKPAGE^LRWRKLS1 "RTN","LRWRKLST",160,0) Q:LRSTOP!LREND "RTN","LRWRKLST",161,0) ; "RTN","LRWRKLST",162,0) S LRXXX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0)),LRURG=+$P(LRXXX,U,2) "RTN","LRWRKLST",163,0) W !," TEST: ",$P($G(^LAB(60,+LRXXX,0),"deleted test"),"^") "RTN","LRWRKLST",164,0) S LN=LN+1 "RTN","LRWRKLST",165,0) ; "RTN","LRWRKLST",166,0) W ?40,$S($D(LRURG(LRURG)):LRURG(LRURG),1:"") "RTN","LRWRKLST",167,0) I $P(LRXXX,U,3)'="" W ?55," LIST: ",$P($G(^LRO(68.2,+$P(LRXXX,U,3),0)),U,1)," ",$P($P(LRXXX,U,3),";",2,3) "RTN","LRWRKLST",168,0) ; "RTN","LRWRKLST",169,0) I $D(^LRO(69,LRDAT,1,LRSN,2,"B",LRI)) D "RTN","LRWRKLST",170,0) . N I,X "RTN","LRWRKLST",171,0) . S X=$O(^LRO(69,LRDAT,1,LRSN,2,"B",LRI,0)) "RTN","LRWRKLST",172,0) . I X,$O(^LRO(69,LRDAT,1,LRSN,2,X,1,0)) D "RTN","LRWRKLST",173,0) . . S I=0 "RTN","LRWRKLST",174,0) . . F S I=$O(^LRO(69,LRDAT,1,LRSN,2,X,1,I)) Q:I<1 W !?3,": "_^(I,0) "RTN","LRWRKLST",175,0) ; "RTN","LRWRKLST",176,0) D REF "RTN","LRWRKLST",177,0) ; "RTN","LRWRKLST",178,0) ;LR*5.2*536 - add check of LRMIPND for pending Microbiology test "RTN","LRWRKLST",179,0) I $P(LRXXX,U,5),'$D(LRMIPND(LRI)) W !," COMPLETED: ",$$FMTE^XLFDT($P(LRXXX,U,5),"MZ") S LN=LN+1 "RTN","LRWRKLST",180,0) E S LRNAC="" "RTN","LRWRKLST",181,0) Q "RTN","LRWRKLST",182,0) ; "RTN","LRWRKLST",183,0) ; "RTN","LRWRKLST",184,0) REF ; if referred test, display status and manifest "RTN","LRWRKLST",185,0) ; "RTN","LRWRKLST",186,0) N LRDFN,LRDN,LREVNT,LRIDT,LRIENS,LRMAN,LRSCFG,LRSS,LRUID,LRY "RTN","LRWRKLST",187,0) ; "RTN","LRWRKLST",188,0) S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") Q:LRUID="" "RTN","LRWRKLST",189,0) S LRMAN=$P(LRXXX,"^",10),LRSCFG="" "RTN","LRWRKLST",190,0) I LRMAN D "RTN","LRWRKLST",191,0) . S LRSCFG=$P($G(^LAHM(62.8,LRMAN,0)),"^",2) "RTN","LRWRKLST",192,0) . I LRSCFG S LRSCFG(0)=$G(^LAHM(62.9,LRSCFG,0),"Unknown/deleted") "RTN","LRWRKLST",193,0) . S LRMAN=$P($G(^LAHM(62.8,LRMAN,0)),"^") "RTN","LRWRKLST",194,0) S LREVNT=$$STATUS^LREVENT(LRUID,+LRXXX,LRMAN) "RTN","LRWRKLST",195,0) I LREVNT'="" D "RTN","LRWRKLST",196,0) . W !,?4,"REFERRAL STATUS..: "_$P(LREVNT,"^")_" ("_$P(LREVNT,"^",2)_")" "RTN","LRWRKLST",197,0) . W !,?4,"SHIPPING MANIFEST: "_$P(LREVNT,"^",3) "RTN","LRWRKLST",198,0) . S LN=LN+2 "RTN","LRWRKLST",199,0) . I LRSCFG D "RTN","LRWRKLST",200,0) . . W " using shipping config "_$P(LRSCFG(0),"^") "RTN","LRWRKLST",201,0) . . W !,?4,"SHIPPED TO.......: "_$P($$NS^XUAF4($P(LRSCFG(0),"^",3)),"^") "RTN","LRWRKLST",202,0) . . S LN=LN+1 "RTN","LRWRKLST",203,0) ; "RTN","LRWRKLST",204,0) ; Display external order info (placer/filler) if any. "RTN","LRWRKLST",205,0) S LRDFN=+LRDX "RTN","LRWRKLST",206,0) S LRY=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) "RTN","LRWRKLST",207,0) S LRIDT=$P(LRY,"^",5),LRSS=$P($G(^LRO(68,LRAA,0)),"^",2) "RTN","LRWRKLST",208,0) S LRDN=0,LRTEST=+LRXXX "RTN","LRWRKLST",209,0) I LRSS="CH" D LR60DN(.LRDN,LRTEST,.LRTST) "RTN","LRWRKLST",210,0) ; "RTN","LRWRKLST",211,0) S LRDN=0 "RTN","LRWRKLST",212,0) F S LRDN=$O(LRDN(LRDN)) Q:LRDN<1 D "RTN","LRWRKLST",213,0) . S LRIENS=LRDFN_","_LRSS_","_LRIDT_","_LRDN "RTN","LRWRKLST",214,0) . F LRTYPE=3,4 I $D(^LR(LRDFN,"EPR","AD",LRIENS,LRTYPE)) D "RTN","LRWRKLST",215,0) . . N LRDATA,LRON,LRREF,LRJ "RTN","LRWRKLST",216,0) . . S LRJ=$O(^LR(LRDFN,"EPR","AD",LRIENS,LRTYPE,0)),LRREF=LRJ_","_LRDFN_"," "RTN","LRWRKLST",217,0) . . D GETDATA^LRUEPR(.LRDATA,LRREF) "RTN","LRWRKLST",218,0) . . S LRON=$G(LRDATA(63.00013,LRREF,1,"I")),LRON(0)="Unknown" "RTN","LRWRKLST",219,0) . . I LRON="" Q "RTN","LRWRKLST",220,0) . . I $P($G(LRDATA(63.00013,LRREF,.03,"I")),";",2)="DIC(4," S LRON(0)=$P($$NS^XUAF4(+LRDATA(63.00013,LRREF,.03,"I")),"^") "RTN","LRWRKLST",221,0) . . W !,?4,LRON(0)_$S(LRTYPE=3:" placer",1:" filler")_" order # "_LRON "RTN","LRWRKLST",222,0) ; "RTN","LRWRKLST",223,0) Q "RTN","LRWRKLST",224,0) ; "RTN","LRWRKLST",225,0) ; "RTN","LRWRKLST",226,0) PHD ; "RTN","LRWRKLST",227,0) Q:LREND "RTN","LRWRKLST",228,0) S LREND=0,U="^" "RTN","LRWRKLST",229,0) D ADATE^LRWU Q:LREND "RTN","LRWRKLST",230,0) D LRAN^LRWU3 "RTN","LRWRKLST",231,0) Q "RTN","LRWRKLST",232,0) ; "RTN","LRWRKLST",233,0) LST ; "RTN","LRWRKLST",234,0) D HED:($E(IOST)="P"&($Y+11>IOSL)),LST1^LRWRKLS1 "RTN","LRWRKLST",235,0) Q "RTN","LRWRKLST",236,0) ; "RTN","LRWRKLST",237,0) HED ; "RTN","LRWRKLST",238,0) W @IOF,!,"LONG FORM",?30,"NOT FOR WARD USE",! "RTN","LRWRKLST",239,0) W "Accession Area: ",LRNAME,?40,LRDT,!! "RTN","LRWRKLST",240,0) S LN=4 "RTN","LRWRKLST",241,0) Q "RTN","LRWRKLST",242,0) ; "RTN","LRWRKLST",243,0) AC ; "RTN","LRWRKLST",244,0) I LRSTOP!LREND Q "RTN","LRWRKLST",245,0) ; "RTN","LRWRKLST",246,0) S LRTK=LRSTAR-.00001 "RTN","LRWRKLST",247,0) F S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK)) Q:LRTK<1!(LRTK\1>LRLAST) D Q:LRSTOP "RTN","LRWRKLST",248,0) . S LRAN=0 "RTN","LRWRKLST",249,0) . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN)) Q:LRAN<1!(LRSTOP) D "RTN","LRWRKLST",250,0) . . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q "RTN","LRWRKLST",251,0) . . S LREND=0 D TD "RTN","LRWRKLST",252,0) . . I LREND Q "RTN","LRWRKLST",253,0) . . D LST,TESTS "RTN","LRWRKLST",254,0) Q "RTN","LRWRKLST",255,0) ; "RTN","LRWRKLST",256,0) ; "RTN","LRWRKLST",257,0) LREND ; "RTN","LRWRKLST",258,0) D KVAR^VADPT "RTN","LRWRKLST",259,0) K %,%DT,%ZIS "RTN","LRWRKLST",260,0) K LN,LRA,AGE,DFN,DIC,DIR,DIRUT,DOB,DTOUT,DUOUT,K,LAST "RTN","LRWRKLST",261,0) K LRACC,LRDLA,LRDLC,LRDX,LRI,LRLO69,LRSAMP,LRSPEC "RTN","LRWRKLST",262,0) K LRURG,LRWRD,LRACO,DIC,LRUNC,LRDAT,LRAA,LRAD "RTN","LRWRKLST",263,0) K LRNAC,LRAN,LRCE,LRDPF,LRSN,LRDTO,LRLAST,LRPRAC,LRSTAR,LRXXX "RTN","LRWRKLST",264,0) K LRB,LRLAN,LRDT,LREND,LRFAN,LRIX,LRNAME,LRTSE,LRTST "RTN","LRWRKLST",265,0) K LRDFN,LREDT,LRLLOC,LRSDT,LRTK,LRWDTL,POP,LRSTOP "RTN","LRWRKLST",266,0) K PNM,SEX,SSN,X,X1,X2,Y,Z,ZTSK "RTN","LRWRKLST",267,0) Q "RTN","LRWRKLST",268,0) ; "RTN","LRWRKLST",269,0) ; "RTN","LRWRKLST",270,0) EN ; "RTN","LRWRKLST",271,0) SINGLE ; "RTN","LRWRKLST",272,0) ; "RTN","LRWRKLST",273,0) N LRAA,LRACC,LRAD,LRAN,LREND,LRSTOP,LRTSE,LRUNC,LRURG "RTN","LRWRKLST",274,0) ; "RTN","LRWRKLST",275,0) D URG^LRX "RTN","LRWRKLST",276,0) ; "RTN","LRWRKLST",277,0) F D Q:LREND!LRSTOP "RTN","LRWRKLST",278,0) . S (LREND,LRUNC,LRSTOP,LRTSE)=0 "RTN","LRWRKLST",279,0) . S LRACC="" D ^LRWU4 "RTN","LRWRKLST",280,0) . I LRAN<1 S LREND=1 Q "RTN","LRWRKLST",281,0) . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Doesn't exist." Q "RTN","LRWRKLST",282,0) . D TD,LST1^LRWRKLS1,TESTS "RTN","LRWRKLST",283,0) . W ! "RTN","LRWRKLST",284,0) ; "RTN","LRWRKLST",285,0) D LREND "RTN","LRWRKLST",286,0) Q "RTN","LRWRKLST",287,0) ; "RTN","LRWRKLST",288,0) ; "RTN","LRWRKLST",289,0) LR60DN(LRDN,LR60,LRTST) ; Retreive CH subscript dataname for a test "RTN","LRWRKLST",290,0) N LRX,LRY "RTN","LRWRKLST",291,0) ; "RTN","LRWRKLST",292,0) S LRX=$P($G(^LAB(60,LR60,.2)),"^") "RTN","LRWRKLST",293,0) I LRX>0 S LRDN(LRX)="" Q "RTN","LRWRKLST",294,0) ; "RTN","LRWRKLST",295,0) ; Expand and check panel tests "RTN","LRWRKLST",296,0) S LRY=0 "RTN","LRWRKLST",297,0) F S LRY=$O(^LAB(60,LR60,2,LRY)) Q:LRY<1 D "RTN","LRWRKLST",298,0) . S LRY(0)=$P($G(^LAB(60,LR60,2,LRY,0)),"^") "RTN","LRWRKLST",299,0) . I LRY(0)<1 Q "RTN","LRWRKLST",300,0) . I $D(LRTST(LRY(0))) Q ; test on panel also on accession as individual test "RTN","LRWRKLST",301,0) . D LR60DN(.LRDN,LRY(0)) "RTN","LRWRKLST",302,0) ; "RTN","LRWRKLST",303,0) Q "VER") 8.0^22.2 "BLD",11744,6) ^442 **END** **END**