LR7OGM ;DALOI/STAFF- Interim report rpc memo ;11/19/09 17:38
;;5.2;LAB SERVICE;**187,220,312,286,395,350,523**;Sep 27, 1994;Build 4
;Per VHA Directive 2004-038, this routine should not be modified
;
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)
S I=0 F S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
K ^TMP("LR7OGX",$J)
Q
;
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 (2: CH of CH/MI exact date/time, 3: MI of CH/MI, else 1 or "")
N AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,EDT,FOK,I,IDT,LRCAN,LRDFN,MICROSUB,MNIDT,NEWOLD,OUTCNT,PNM,ROUTE,SEX,SDT,SKIP
K MICROSUB
K ^TMP("LR7OG",$J),^TMP("LR7OGX",$J,"OUTPUT"),^TMP("LRPLS",$J)
S OUTCNT=1,(DONE,SKIP)=0
D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
I '$G(LRDFN) Q
D NEWOLD^LR7OGMU(.NEWOLD,DFN)
;LR*523 Make NEWOLD date format match IDT format - reverse date
S $P(NEWOLD,U)=9999999-$P(NEWOLD,U),$P(NEWOLD,U,2)=9999999-$P(NEWOLD,U,2)
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)
;
; Print "printed at" header on start of report.
I 'FORMAT,$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OGMP
;
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 Q
. 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 Q
. 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,U),$P(NEWOLD,U)'=IDT D Q
. . . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
. . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
. . . . . . ;LR 523 Check if a CH test at same date/time is displayable
. . . . . . ; necessary to correctly enable/disable NEXT button
. . . . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,4,.DONE,.SKIP)
. . . . . . I SKIP S SKIP=0,$P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=($S(DIRECT=-1:1,1:2)) Q
. . . . . . 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,U),$P(NEWOLD,U)'=IDT D Q
. . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
. . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
. . . . . I $P(NEWOLD,U),$P(NEWOLD,U)'=IDT D Q
. . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
. . . . . 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),^TMP("LRPLS-ADDR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGM 7007 printed Oct 16, 2024@18:05:54 Page 2
LR7OGM ;DALOI/STAFF- Interim report rpc memo ;11/19/09 17:38
+1 ;;5.2;LAB SERVICE;**187,220,312,286,395,350,523**;Sep 27, 1994;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
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 DO SELECT(16,3090730,2700202,.TESTS,1,0)
+5 SET I=0
FOR
SET I=$ORDER(^TMP("LR7OGX",$JOB,"OUTPUT",I))
if I<1
QUIT
WRITE !,^(I)
+6 KILL ^TMP("LR7OGX",$JOB)
+7 QUIT
+8 ;
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 (2: CH of CH/MI exact date/time, 3: MI of CH/MI, else 1 or "")
+4 NEW AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,EDT,FOK,I,IDT,LRCAN,LRDFN,MICROSUB,MNIDT,NEWOLD,OUTCNT,PNM,ROUTE,SEX,SDT,SKIP
+5 KILL MICROSUB
+6 KILL ^TMP("LR7OG",$JOB),^TMP("LR7OGX",$JOB,"OUTPUT"),^TMP("LRPLS",$JOB)
+7 SET OUTCNT=1
SET (DONE,SKIP)=0
+8 DO DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
+9 IF '$GET(LRDFN)
QUIT
+10 DO NEWOLD^LR7OGMU(.NEWOLD,DFN)
+11 ;LR*523 Make NEWOLD date format match IDT format - reverse date
+12 SET $PIECE(NEWOLD,U)=9999999-$PIECE(NEWOLD,U)
SET $PIECE(NEWOLD,U,2)=9999999-$PIECE(NEWOLD,U,2)
+13 SET ^TMP("LR7OG",$JOB,"G")=DFN_U_PNM_U_LRDFN_U_AGE_U_SEX_"^8"
+14 SET ALL=$SELECT($ORDER(TESTS(0)):0,1:1)
+15 IF 'ALL
DO TESTSGET^LR7OGU(.TESTS,.MICROSUB)
+16 SET DIRECT=1
+17 IF FORMAT
SET DIRECT=EDATE
SET EDATE=2700101
+18 SET EDATE=EDATE\1
+19 SET (IDT,SDT)=9999999-SDATE
SET EDT=9999999-EDATE
+20 IF FORMAT>1
SET FOK=0
Begin DoDot:1
+21 IF DIRECT=1
Begin DoDot:2
+22 IF FORMAT=2
Begin DoDot:3
+23 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+24 IF SKIP
SET SKIP=0
QUIT
+25 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
+26 SET FOK=1
End DoDot:3
QUIT
+27 IF FORMAT=3
Begin DoDot:3
+28 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:3
QUIT
End DoDot:2
QUIT
+29 IF DIRECT=-1
Begin DoDot:2
+30 IF FORMAT=2
Begin DoDot:3
+31 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:3
QUIT
+32 IF FORMAT=3
Begin DoDot:3
+33 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+34 IF SKIP
SET SKIP=0
QUIT
+35 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
+36 SET FOK=1
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
IF FOK
QUIT
+37 IF ALL
SET ASK="BOTH"
+38 IF '$TEST
IF $ORDER(MICROSUB(0))
Begin DoDot:1
+39 SET ASK="MI"
IF $ORDER(^TMP("LR7OG",$JOB,"TMP",0))
SET ASK="BOTH"
End DoDot:1
+40 IF '$TEST
SET ASK="CH"
+41 SET I=IDT
SET CNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"CH",I),DIRECT)
if 'I
QUIT
SET CNIDT=I
QUIT
+42 SET I=IDT
SET MNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"MI",I),DIRECT)
if 'I
QUIT
SET MNIDT=I
QUIT
+43 SET AVAIL="NONE"
+44 IF CNIDT
IF CNIDT'>EDT
Begin DoDot:1
+45 SET AVAIL="CH"
IF MNIDT
IF MNIDT'>EDT
SET AVAIL="BOTH"
End DoDot:1
+46 IF '$TEST
IF MNIDT
IF MNIDT'>EDT
SET AVAIL="MI"
+47 IF DIRECT=-1
SET AVAIL="BOTH"
+48 SET ROUTE="NONE"
+49 IF ASK="BOTH"
SET ROUTE=AVAIL
+50 IF ASK="CH"
IF AVAIL="CH"!(AVAIL="BOTH")
SET ROUTE="CH"
+51 IF ASK="MI"
IF AVAIL="MI"!(AVAIL="BOTH")
SET ROUTE="MI"
+52 IF MICROCHK=-1
SET ROUTE="MI"
+53 IF ROUTE="NONE"
Begin DoDot:1
+54 KILL ^TMP("LR7OG",$JOB)
End DoDot:1
QUIT
+55 ;
+56 ; Print "printed at" header on start of report.
+57 IF 'FORMAT
IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
DO PFAC^LR7OGMP
+58 ;
+59 IF ROUTE="CH"
Begin DoDot:1
+60 FOR
SET IDT=$ORDER(^LR(LRDFN,"CH",IDT),DIRECT)
if IDT<1
QUIT
if IDT>EDT
QUIT
Begin DoDot:2
+61 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+62 IF SKIP
SET SKIP=0
QUIT
End DoDot:2
if DONE
QUIT
+63 IF 'FORMAT
IF $DATA(^TMP("LRPLS",$JOB))
DO PLS^LR7OGMP
+64 KILL ^TMP("LR7OG",$JOB),^TMP("LRPLS",$JOB)
End DoDot:1
QUIT
+65 ;
+66 IF ROUTE="MI"
Begin DoDot:1
+67 FOR
SET IDT=$ORDER(^LR(LRDFN,"MI",IDT),DIRECT)
if IDT<1
QUIT
if IDT>EDT
QUIT
Begin DoDot:2
+68 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+69 IF SKIP
SET SKIP=0
QUIT
End DoDot:2
if DONE
QUIT
+70 KILL ^TMP("LR7OG",$JOB)
End DoDot:1
QUIT
+71 FOR
Begin DoDot:1
+72 SET I=IDT
SET CNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"CH",I),DIRECT)
if 'I
QUIT
SET CNIDT=I
QUIT
+73 SET I=IDT
SET MNIDT=0
FOR
SET I=$ORDER(^LR(LRDFN,"MI",I),DIRECT)
if 'I
QUIT
SET MNIDT=I
QUIT
+74 IF 'CNIDT
IF 'MNIDT
SET DONE=1
QUIT
+75 Begin DoDot:2
+76 ; both chem and micro at this date/time
IF CNIDT=MNIDT
Begin DoDot:3
+77 SET IDT=CNIDT
+78 IF IDT'>EDT
Begin DoDot:4
+79 IF FORMAT
Begin DoDot:5
+80 IF SDT=(9999999-2700101)!(DIRECT=-1)
Begin DoDot:6
+81 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+82 IF SKIP
SET SKIP=0
Begin DoDot:7
+83 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+84 IF SKIP
SET SKIP=0
QUIT
+85 IF $PIECE(NEWOLD,U)
IF $PIECE(NEWOLD,U)'=IDT
Begin DoDot:8
+86 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
End DoDot:8
QUIT
+87 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:7
QUIT
+88 ;LR 523 Check if a CH test at same date/time is displayable
+89 ; necessary to correctly enable/disable NEXT button
+90 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,4,.DONE,.SKIP)
+91 IF SKIP
SET SKIP=0
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=($SELECT(DIRECT=-1:1,1:2))
QUIT
+92 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
End DoDot:6
QUIT
+93 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+94 IF SKIP
SET SKIP=0
Begin DoDot:6
+95 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+96 IF SKIP
SET SKIP=0
QUIT
+97 IF $PIECE(NEWOLD,U)
IF $PIECE(NEWOLD,U)'=IDT
Begin DoDot:7
+98 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=3
End DoDot:7
QUIT
+99 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=1
End DoDot:6
QUIT
+100 IF $PIECE(NEWOLD,U)
IF $PIECE(NEWOLD,U)'=IDT
Begin DoDot:6
+101 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
End DoDot:6
QUIT
+102 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,9)=2
End DoDot:5
QUIT
+103 IF MICROCHK'=1
Begin DoDot:5
+104 DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+105 IF SKIP
SET SKIP=0
QUIT
+106 IF FORMAT
SET MICROCHK=1
End DoDot:5
if DONE
QUIT
+107 DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+108 IF SKIP
SET SKIP=0
QUIT
End DoDot:4
End DoDot:3
QUIT
+109 ; no micro since this date/time, only chem at this date/time
IF 'MNIDT
Begin DoDot:3
+110 SET IDT=CNIDT
+111 IF IDT'>EDT
DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+112 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+113 ; no chem since this date/time, only micro at this date/time
IF 'CNIDT
Begin DoDot:3
+114 SET IDT=MNIDT
+115 IF IDT'>EDT
DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+116 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+117 ;chem and micro data, chem is more recent
IF (DIRECT=1&(CNIDT<MNIDT))!(DIRECT=-1&(CNIDT>MNIDT))
Begin DoDot:3
+118 SET IDT=CNIDT
+119 IF IDT'>EDT
DO CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+120 IF SKIP
SET SKIP=0
QUIT
End DoDot:3
QUIT
+121 SET IDT=MNIDT
+122 IF IDT'>EDT
DO MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
+123 IF SKIP
SET SKIP=0
QUIT
End DoDot:2
IF IDT>EDT
SET DONE=1
QUIT
End DoDot:1
if DONE
QUIT
+124 ;
+125 IF 'FORMAT
IF $DATA(^TMP("LRPLS",$JOB))
DO PLS^LR7OGMP
+126 ;
+127 KILL ^TMP("LR7OG",$JOB),^TMP("LRPLS",$JOB),^TMP("LRPLS-ADDR",$JOB)
+128 QUIT
