LR7OGM ;VA/DALOI/STAFF- Interim report rpc memo ;7/1/09 07:28
;;5.2;LAB SERVICE;**1027,1031,1032**;NOV 01, 1997;Build 146
;
;;VA LR Patche(s): 187,220,312,286,395
;
TEST ; test use only
N TESTS,I K TESTS,^TMP("LR7OGX",$J)
;S TESTS(548)=548
; F I=1:1:10 I $D(^LAB(60,I,0)) S TESTS(I)=I
; D SELECT(16,3090730,2700202,.TESTS,1,0)
;
; ------- BEGIN IHS/MSC/MKK - LR*5.2*1032
Q:'$$IHSSELCT()
D SELECT(DFN,LRLDT,LRSDT,.TESTS,1,1)
; ------- END IHS/MSC/MKK - LR*5.2*1032
;
S I=0 F S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
K ^TMP("LR7OGX",$J)
Q
;
; ------- BEGIN IHS/MSC/MKK - LR*5.2*1032
IHSSELCT() ; EP - IHS Selection process
D B^LRU
I LRSDT<1!(LRLDT<1) Q $$BADSTUFF("Invalid Date(s).")
;
D ^XBFMK
S DIR(0)="P^2:E"
D ^DIR
I +$G(Y)<1 Q $$BADSTUFF("No/Invalid Entry.")
;
NEW LRDFN,PNM
;
S DFN=+Y,PNM=$P(Y,"^",2)
S LRDFN=+$$GET1^DIQ(2,DFN,"LABORATORY REFERENCE","I")
I LRDFN<1 Q $$BADSTUFF("No LRDFN for DFN:"_DFN_".")
;
; Get ALL the patient's "CH" & "MI" tests from 63
NEW DN,F60IEN,LRAA,LRAD,LRAN,LRSS,LRAS,LRAT,LRIDT
;
S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D
. S DN=1 F S DN=$O(^LR(LRDFN,"CH",LRIDT,DN)) Q:DN<1 D
.. S F60IEN=+$O(^LAB(60,"C","CH;"_DN_";1",0))
.. S:F60IEN TESTS(F60IEN)=F60IEN
;
S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1 D
. S LRAS=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",6)
. Q:$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
. S LRAT=0 F S LRAT=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRAT)) Q:LRAT<1 D
.. S F60IEN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRAT,0))
.. S:F60IEN TESTS(F60IEN)=F60IEN
;
Q 1
;
BADSTUFF(STR) ; EP
W !,?4,STR," Routine Ends."
D PRESSKEY^BLRGMENU(9)
Q 0
; ------- END IHS/MSC/MKK - LR*5.2*1032
;
INTERIM(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
N FORMAT,MICROCHK,TESTS K TESTS
S (FORMAT,MICROCHK)=""
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
Q
;
INTERIMG(ROOT,DFN,SDATE,DIR,FORMAT) ; from ORWLRR
N MICROCHK,TESTS K TESTS
S MICROCHK=1,FORMAT=$G(FORMAT,1)
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
D SELECT(DFN,SDATE,DIR,.TESTS,FORMAT,MICROCHK) ;
Q
;
INTERIMS(ROOT,DFN,SDATE,EDATE,TESTLIST) ; from ORWLRR
N FORMAT,MICROCHK,NUM,TESTS K TESTS
S (FORMAT,MICROCHK)=""
S NUM=0 F S NUM=$O(TESTLIST(NUM)) Q:NUM<1 S TESTS(+TESTLIST(NUM))=""
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
Q
;
MICRO(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
N FORMAT,MICROCHK,TESTS K TESTS
S FORMAT="",MICROCHK=-1
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
Q
;
SELECT(DFN,SDATE,EDATE,TESTS,FORMAT,MICROCHK) ;
; get patient info, and expand tests
; route setup chem and/or micro data
; 9th piece of output indicates FORMAT, when set, seems to get used when evaluating next result
; (2: CH subscript, 3: MI subscript, else 1 or "")
N AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,SKIP,EDT,FOK,I,IDT,LRCAN,LRDFN,MICROSUB,MNIDT,OUTCNT,PNM,ROUTE,SEX,SDT,NEWOLD
K MICROSUB
K ^TMP("LR7OG",$J),^TMP("LR7OGX",$J,"OUTPUT"),^TMP("LRPLS",$J)
S OUTCNT=1,DONE=0,SKIP=0
D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
I '$G(LRDFN) Q
D NEWOLD^LR7OGMU(.NEWOLD,DFN)
S ^TMP("LR7OG",$J,"G")=DFN_U_PNM_U_LRDFN_U_AGE_U_SEX_"^8"
S ALL=$S($O(TESTS(0)):0,1:1)
I 'ALL D TESTSGET^LR7OGU(.TESTS,.MICROSUB)
S DIRECT=1
I FORMAT S DIRECT=EDATE,EDATE=2700101
S EDATE=EDATE\1
S (IDT,SDT)=9999999-SDATE,EDT=9999999-EDATE
I FORMAT>1 S FOK=0 D I FOK Q
. I DIRECT=1 D Q
.. I FORMAT=2 D Q
... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
... I SKIP S SKIP=0 Q
... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
... S FOK=1
.. I FORMAT=3 D Q
... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
. I DIRECT=-1 D Q
.. I FORMAT=2 D Q
... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
.. I FORMAT=3 D Q
... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
... I SKIP S SKIP=0 Q
... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
... S FOK=1
I ALL S ASK="BOTH"
E I $O(MICROSUB(0)) D
. S ASK="MI" I $O(^TMP("LR7OG",$J,"TMP",0)) S ASK="BOTH"
E S ASK="CH"
S I=IDT,CNIDT=0 F S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I S CNIDT=I Q
S I=IDT,MNIDT=0 F S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I S MNIDT=I Q
S AVAIL="NONE"
I CNIDT,CNIDT'>EDT D
. S AVAIL="CH" I MNIDT,MNIDT'>EDT S AVAIL="BOTH"
E I MNIDT,MNIDT'>EDT S AVAIL="MI"
I DIRECT=-1 S AVAIL="BOTH"
S ROUTE="NONE"
I ASK="BOTH" S ROUTE=AVAIL
I ASK="CH",AVAIL="CH"!(AVAIL="BOTH") S ROUTE="CH"
I ASK="MI",AVAIL="MI"!(AVAIL="BOTH") S ROUTE="MI"
I MICROCHK=-1 S ROUTE="MI"
I ROUTE="NONE" D Q
. K ^TMP("LR7OG",$J)
;
I ROUTE="CH" D Q
. F S IDT=$O(^LR(LRDFN,"CH",IDT),DIRECT) Q:IDT<1 Q:IDT>EDT D Q:DONE
.. D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
.. I SKIP S SKIP=0
. I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
. K ^TMP("LR7OG",$J),^TMP("LRPLS",$J)
;
I ROUTE="MI" D Q
. F S IDT=$O(^LR(LRDFN,"MI",IDT),DIRECT) Q:IDT<1 Q:IDT>EDT D Q:DONE
.. D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
.. I SKIP S SKIP=0
. K ^TMP("LR7OG",$J)
F D Q:DONE
. S I=IDT,CNIDT=0 F S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I S CNIDT=I Q
. S I=IDT,MNIDT=0 F S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I S MNIDT=I Q
. I 'CNIDT,'MNIDT S DONE=1 Q
. D I IDT>EDT S DONE=1 Q
.. I CNIDT=MNIDT D Q ; both chem and micro at this date/time
... S IDT=CNIDT
... I IDT'>EDT D
.... I FORMAT D Q
..... I SDT=(9999999-2700101)!(DIRECT=-1) D Q
...... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
...... I SKIP S SKIP=0 D Q
....... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
....... I SKIP S SKIP=0 Q
....... I $P(NEWOLD,"^",1),$P(NEWOLD,"^",1)'=IDT S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3 Q
....... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
...... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
..... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
..... I SKIP S SKIP=0 D Q
...... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
...... I SKIP S SKIP=0 Q
...... I $P(NEWOLD,"^",1),$P(NEWOLD,"^",1)'=IDT S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3 Q
...... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
..... I $P(NEWOLD,"^",1),$P(NEWOLD,"^",1)'=IDT S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2 Q
..... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
.... I MICROCHK'=1 D Q:DONE
..... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
..... I SKIP S SKIP=0 Q
..... I FORMAT S MICROCHK=1
.... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
.... I SKIP S SKIP=0 Q
.. I 'MNIDT D Q ; no micro since this date/time, only chem at this date/time
... S IDT=CNIDT
... I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
... I SKIP S SKIP=0 Q
.. I 'CNIDT D Q ; no chem since this date/time, only micro at this date/time
... S IDT=MNIDT
... I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
... I SKIP S SKIP=0 Q
.. I (DIRECT=1&(CNIDT<MNIDT))!(DIRECT=-1&(CNIDT>MNIDT)) D Q ;chem and micro data, chem is more recent
... S IDT=CNIDT
... I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
... I SKIP S SKIP=0 Q
.. S IDT=MNIDT
.. I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
.. I SKIP S SKIP=0 Q
;
I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
;
K ^TMP("LR7OG",$J),^TMP("LRPLS",$J)
Q
LR7OGM ;VA/DALOI/STAFF- Interim report rpc memo ;7/1/09 07:28
+1 ;;5.2;LAB SERVICE;**1027,1031,1032**;NOV 01, 1997;Build 146
+2 ;
+3 ;;VA LR Patche(s): 187,220,312,286,395
+4 ;
TEST ; test use only
+1 NEW TESTS,I
KILL TESTS,^TMP("LR7OGX",$JOB)
+2 ;S TESTS(548)=548
+3 ; F I=1:1:10 I $D(^LAB(60,I,0)) S TESTS(I)=I
+4 ; D SELECT(16,3090730,2700202,.TESTS,1,0)
+5 ;
+6 ; ------- BEGIN IHS/MSC/MKK - LR*5.2*1032
+7 IF '$$IHSSELCT()
QUIT
+8 DO SELECT(DFN,LRLDT,LRSDT,.TESTS,1,1)
+9 ; ------- END IHS/MSC/MKK - LR*5.2*1032
+10 ;
+11 SET I=0
FOR
SET I=$ORDER(^TMP("LR7OGX",$JOB,"OUTPUT",I))
IF I<1
QUIT
WRITE !,^(I)
+12 KILL ^TMP("LR7OGX",$JOB)
+13 QUIT
+14 ;
+15 ; ------- BEGIN IHS/MSC/MKK - LR*5.2*1032
IHSSELCT() ; EP - IHS Selection process
+1 DO B^LRU
+2 IF LRSDT<1!(LRLDT<1)
QUIT $$BADSTUFF("Invalid Date(s).")
+3 ;
+4 DO ^XBFMK
+5 SET DIR(0)="P^2:E"
+6 DO ^DIR
+7 IF +$GET(Y)<1
QUIT $$BADSTUFF("No/Invalid Entry.")
+8 ;
+9 NEW LRDFN,PNM
+10 ;
+11 SET DFN=+Y
SET PNM=$PIECE(Y,"^",2)
+12 SET LRDFN=+$$GET1^DIQ(2,DFN,"LABORATORY REFERENCE","I")
+13 IF LRDFN<1
QUIT $$BADSTUFF("No LRDFN for DFN:"_DFN_".")
+14 ;
+15 ; Get ALL the patient's "CH" & "MI" tests from 63
+16 NEW DN,F60IEN,LRAA,LRAD,LRAN,LRSS,LRAS,LRAT,LRIDT
+17 ;
+18 SET LRIDT=0
FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
IF LRIDT<1
QUIT
Begin DoDot:1
+19 SET DN=1
FOR
SET DN=$ORDER(^LR(LRDFN,"CH",LRIDT,DN))
IF DN<1
QUIT
Begin DoDot:2
+20 SET F60IEN=+$ORDER(^LAB(60,"C","CH;"_DN_";1",0))
+21 IF F60IEN
SET TESTS(F60IEN)=F60IEN
End DoDot:2
End DoDot:1
+22 ;
+23 SET LRIDT=0
FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
IF LRIDT<1
QUIT
Begin DoDot:1
+24 SET LRAS=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,0)),"^",6)
+25 IF $$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
QUIT
+26 SET LRAT=0
FOR
SET LRAT=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRAT))
IF LRAT<1
QUIT
Begin DoDot:2
+27 SET F60IEN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRAT,0))
+28 IF F60IEN
SET TESTS(F60IEN)=F60IEN
End DoDot:2
End DoDot:1
+29 ;
+30 QUIT 1
+31 ;
BADSTUFF(STR) ; EP
+1 WRITE !,?4,STR," Routine Ends."
+2 DO PRESSKEY^BLRGMENU(9)
+3 QUIT 0
+4 ; ------- END IHS/MSC/MKK - LR*5.2*1032
+5 ;
INTERIM(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
+1 NEW FORMAT,MICROCHK,TESTS
KILL TESTS
+2 SET (FORMAT,MICROCHK)=""
+3 SET ROOT=$NAME(^TMP("LR7OGX",$JOB,"OUTPUT"))
+4 ;
DO SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK)
+5 QUIT
+6 ;
INTERIMG(ROOT,DFN,SDATE,DIR,FORMAT) ; from ORWLRR
+1 NEW MICROCHK,TESTS
KILL TESTS
+2 SET MICROCHK=1
SET FORMAT=$GET(FORMAT,1)
+3 SET ROOT=$NAME(^TMP("LR7OGX",$JOB,"OUTPUT"))
+4 ;
DO SELECT(DFN,SDATE,DIR,.TESTS,FORMAT,MICROCHK)
+5 QUIT
+6 ;
INTERIMS(ROOT,DFN,SDATE,EDATE,TESTLIST) ; from ORWLRR
+1 NEW FORMAT,MICROCHK,NUM,TESTS
KILL TESTS
+2 SET (FORMAT,MICROCHK)=""
+3 SET NUM=0
FOR
SET NUM=$ORDER(TESTLIST(NUM))
IF NUM<1
QUIT
SET TESTS(+TESTLIST(NUM))=""
+4 SET ROOT=$NAME(^TMP("LR7OGX",$JOB,"OUTPUT"))
+5 ;
DO SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK)
+6 QUIT
+7 ;
MICRO(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
+1 NEW FORMAT,MICROCHK,TESTS
KILL TESTS
+2 SET FORMAT=""
SET MICROCHK=-1
+3 SET ROOT=$NAME(^TMP("LR7OGX",$JOB,"OUTPUT"))
+4 ;
DO SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK)
+5 QUIT
+6 ;
SELECT(DFN,SDATE,EDATE,TESTS,FORMAT,MICROCHK) ;
+1 ; get patient info, and expand tests
+2 ; route setup chem and/or micro data
+3 ; 9th piece of output indicates FORMAT, when set, seems to get used when evaluating next result
+4 ; (2: CH subscript, 3: MI subscript, else 1 or "")
+5 NEW AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,SKIP,EDT,FOK,I,IDT,LRCAN,LRDFN,MICROSUB,MNIDT,OUTCNT,PNM,ROUTE,SEX,SDT,NEWOLD
+6 KILL MICROSUB
+7 KILL ^TMP("LR7OG",$JOB),^TMP("LR7OGX",$JOB,"OUTPUT"),^TMP("LRPLS",$JOB)
+8 SET OUTCNT=1
SET DONE=0
SET SKIP=0
+9 DO DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
+10 IF '$GET(LRDFN)
QUIT
+11 DO NEWOLD^LR7OGMU(.NEWOLD,DFN)
+12 SET ^TMP("LR7OG",$JOB,"G")=DFN_U_PNM_U_LRDFN_U_AGE_U_SEX_"^8"
+13 SET ALL=$SELECT($ORDER(TESTS(0)):0,1:1)
+14 IF 'ALL
DO TESTSGET^LR7OGU(.TESTS,.MICROSUB)
+15 SET DIRECT=1
+16 IF FORMAT
SET DIRECT=EDATE
SET EDATE=2700101
+17 SET EDATE=EDATE\1
+18 SET (IDT,SDT)=9999999-SDATE
SET EDT=9999999-EDATE
+19 IF FORMAT>1
SET FOK=0
Begin DoDot:1
+20 IF DIRECT=1
Begin DoDot:2
+21 IF FORMAT=2
Begin DoDot:3
+22 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+23 IF SKIP
SET SKIP=0
QUIT
+24 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
+25 SET FOK=1
End DoDot:3
QUIT
+26 IF FORMAT=3
Begin DoDot:3
+27 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:3
QUIT
End DoDot:2
QUIT
+28 IF DIRECT=-1
Begin DoDot:2
+29 IF FORMAT=2
Begin DoDot:3
+30 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:3
QUIT
+31 IF FORMAT=3
Begin DoDot:3
+32 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+33 IF SKIP
SET SKIP=0
QUIT
+34 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
+35 SET FOK=1
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
IF FOK
QUIT
+36 IF ALL
SET ASK="BOTH"
+37 IF '$TEST
IF $ORDER(MICROSUB(0))
Begin DoDot:1
+38 SET ASK="MI"
IF $ORDER(^TMP("LR7OG",$JOB,"TMP",0))
SET ASK="BOTH"
End DoDot:1
+39 IF '$TEST
SET ASK="CH"
+40 SET I=IDT
SET CNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"CH",I),DIRECT)
IF 'I
QUIT
SET CNIDT=I
QUIT
+41 SET I=IDT
SET MNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"MI",I),DIRECT)
IF 'I
QUIT
SET MNIDT=I
QUIT
+42 SET AVAIL="NONE"
+43 IF CNIDT
IF CNIDT'>EDT
Begin DoDot:1
+44 SET AVAIL="CH"
IF MNIDT
IF MNIDT'>EDT
SET AVAIL="BOTH"
End DoDot:1
+45 IF '$TEST
IF MNIDT
IF MNIDT'>EDT
SET AVAIL="MI"
+46 IF DIRECT=-1
SET AVAIL="BOTH"
+47 SET ROUTE="NONE"
+48 IF ASK="BOTH"
SET ROUTE=AVAIL
+49 IF ASK="CH"
IF AVAIL="CH"!(AVAIL="BOTH")
SET ROUTE="CH"
+50 IF ASK="MI"
IF AVAIL="MI"!(AVAIL="BOTH")
SET ROUTE="MI"
+51 IF MICROCHK=-1
SET ROUTE="MI"
+52 IF ROUTE="NONE"
Begin DoDot:1
+53 KILL ^TMP("LR7OG",$JOB)
End DoDot:1
QUIT
+54 ;
+55 IF ROUTE="CH"
Begin DoDot:1
+56 FOR
SET IDT=$ORDER(^LR(LRDFN,"CH",IDT),DIRECT)
IF IDT<1
QUIT
IF IDT>EDT
QUIT
Begin DoDot:2
+57 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+58 IF SKIP
SET SKIP=0
End DoDot:2
IF DONE
QUIT
+59 IF 'FORMAT
IF $DATA(^TMP("LRPLS",$JOB))
DO PLS^LR7OGMP
+60 KILL ^TMP("LR7OG",$JOB),^TMP("LRPLS",$JOB)
End DoDot:1
QUIT
+61 ;
+62 IF ROUTE="MI"
Begin DoDot:1
+63 FOR
SET IDT=$ORDER(^LR(LRDFN,"MI",IDT),DIRECT)
IF IDT<1
QUIT
IF IDT>EDT
QUIT
Begin DoDot:2
+64 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+65 IF SKIP
SET SKIP=0
End DoDot:2
IF DONE
QUIT
+66 KILL ^TMP("LR7OG",$JOB)
End DoDot:1
QUIT
+67 FOR
Begin DoDot:1
+68 SET I=IDT
SET CNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"CH",I),DIRECT)
IF 'I
QUIT
SET CNIDT=I
QUIT
+69 SET I=IDT
SET MNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"MI",I),DIRECT)
IF 'I
QUIT
SET MNIDT=I
QUIT
+70 IF 'CNIDT
IF 'MNIDT
SET DONE=1
QUIT
+71 Begin DoDot:2
+72 ; both chem and micro at this date/time
IF CNIDT=MNIDT
Begin DoDot:3
+73 SET IDT=CNIDT
+74 IF IDT'>EDT
Begin DoDot:4
+75 IF FORMAT
Begin DoDot:5
+76 IF SDT=(9999999-2700101)!(DIRECT=-1)
Begin DoDot:6
+77 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+78 IF SKIP
SET SKIP=0
Begin DoDot:7
+79 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+80 IF SKIP
SET SKIP=0
QUIT
+81 IF $PIECE(NEWOLD,"^",1)
IF $PIECE(NEWOLD,"^",1)'=IDT
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
QUIT
+82 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:7
QUIT
+83 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
End DoDot:6
QUIT
+84 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+85 IF SKIP
SET SKIP=0
Begin DoDot:6
+86 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+87 IF SKIP
SET SKIP=0
QUIT
+88 IF $PIECE(NEWOLD,"^",1)
IF $PIECE(NEWOLD,"^",1)'=IDT
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
QUIT
+89 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:6
QUIT
+90 IF $PIECE(NEWOLD,"^",1)
IF $PIECE(NEWOLD,"^",1)'=IDT
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
QUIT
+91 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
End DoDot:5
QUIT
+92 IF MICROCHK'=1
Begin DoDot:5
+93 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+94 IF SKIP
SET SKIP=0
QUIT
+95 IF FORMAT
SET MICROCHK=1
End DoDot:5
IF DONE
QUIT
+96 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+97 IF SKIP
SET SKIP=0
QUIT
End DoDot:4
End DoDot:3
QUIT
+98 ; no micro since this date/time, only chem at this date/time
IF 'MNIDT
Begin DoDot:3
+99 SET IDT=CNIDT
+100 IF IDT'>EDT
DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+101 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+102 ; no chem since this date/time, only micro at this date/time
IF 'CNIDT
Begin DoDot:3
+103 SET IDT=MNIDT
+104 IF IDT'>EDT
DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+105 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+106 ;chem and micro data, chem is more recent
IF (DIRECT=1&(CNIDT<MNIDT))!(DIRECT=-1&(CNIDT>MNIDT))
Begin DoDot:3
+107 SET IDT=CNIDT
+108 IF IDT'>EDT
DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+109 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+110 SET IDT=MNIDT
+111 IF IDT'>EDT
DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+112 IF SKIP
SET SKIP=0
QUIT
End DoDot:2
IF IDT>EDT
SET DONE=1
QUIT
End DoDot:1
IF DONE
QUIT
+113 ;
+114 IF 'FORMAT
IF $DATA(^TMP("LRPLS",$JOB))
DO PLS^LR7OGMP
+115 ;
+116 KILL ^TMP("LR7OG",$JOB),^TMP("LRPLS",$JOB)
+117 QUIT
