- 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
