source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGM.m@ 1258

Last change on this file since 1258 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1LR7OGM ;DALOI/STAFF- Interim report rpc memo ;Aug 16, 2004
2 ;;5.2;LAB SERVICE;**187,220,312,286**;Sep 27, 1994
3 ;
4TEST ; test use only
5 N TESTS,I K TESTS,^TMP("LR7OGX",$J)
6 ;S TESTS(548)=548
7 ;F I=1:1:10 I $D(^LAB(60,I,0)) S TESTS(I)=I
8 D SELECT(2,2970202,2920202,.TESTS,0,-1)
9 S I=0 F S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
10 K ^TMP("LR7OGX",$J)
11 Q
12 ;
13INTERIM(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
14 N FORMAT,MICROCHK,TESTS K TESTS
15 S (FORMAT,MICROCHK)=""
16 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
17 D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
18 Q
19 ;
20INTERIMG(ROOT,DFN,SDATE,DIR,FORMAT) ; from ORWLRR
21 N MICROCHK,TESTS K TESTS
22 S MICROCHK=1,FORMAT=$G(FORMAT,1)
23 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
24 D SELECT(DFN,SDATE,DIR,.TESTS,FORMAT,MICROCHK) ;
25 Q
26 ;
27INTERIMS(ROOT,DFN,SDATE,EDATE,TESTLIST) ; from ORWLRR
28 N FORMAT,MICROCHK,NUM,TESTS K TESTS
29 S (FORMAT,MICROCHK)=""
30 S NUM=0 F S NUM=$O(TESTLIST(NUM)) Q:NUM<1 S TESTS(+TESTLIST(NUM))=""
31 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
32 D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
33 Q
34 ;
35MICRO(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
36 N FORMAT,MICROCHK,TESTS K TESTS
37 S FORMAT="",MICROCHK=-1
38 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
39 D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
40 Q
41 ;
42SELECT(DFN,SDATE,EDATE,TESTS,FORMAT,MICROCHK) ;
43 ; get patient info, and expand tests
44 ; route setup chem and/or micro data
45 ; 9th piece of output indicates format (2: CH of CH/MI exact date/time, 3: MI of CH/MI, else 1 or "")
46 N AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,EDT,FOK,I,IDT,LRDFN,MICROSUB,MNIDT,OUTCNT,PNM,ROUTE,SEX,SDT K MICROSUB
47 K ^TMP("LR7OG",$J),^TMP("LR7OGX",$J,"OUTPUT"),^TMP("LRPLS",$J)
48 S OUTCNT=1,DONE=0
49 D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
50 I '$G(LRDFN) Q
51 S ^TMP("LR7OG",$J,"G")=DFN_U_PNM_U_LRDFN_U_AGE_U_SEX_"^8"
52 S ALL=$S($O(TESTS(0)):0,1:1)
53 I 'ALL D TESTSGET^LR7OGU(.TESTS,.MICROSUB)
54 S DIRECT=1
55 I FORMAT S DIRECT=EDATE,EDATE=2700101
56 S EDATE=EDATE\1
57 S (IDT,SDT)=9999999-SDATE,EDT=9999999-EDATE
58 I FORMAT>1 S FOK=0 D I FOK Q
59 . I DIRECT=1 D Q
60 .. I FORMAT=2 D Q
61 ... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE)
62 ... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
63 ... S FOK=1
64 .. I FORMAT=3 D Q
65 ... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
66 . I DIRECT=-1 D Q
67 .. I FORMAT=2 D Q
68 ... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
69 .. I FORMAT=3 D Q
70 ... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE)
71 ... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
72 ... S FOK=1
73 I ALL S ASK="BOTH"
74 E I $O(MICROSUB(0)) D
75 . S ASK="MI" I $O(^TMP("LR7OG",$J,"TMP",0)) S ASK="BOTH"
76 E S ASK="CH"
77 S I=IDT,CNIDT=0 F S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I I $P($G(^(I,0)),"^",3) S CNIDT=I Q
78 S I=IDT,MNIDT=0 F S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I S MNIDT=I Q
79 S AVAIL="NONE"
80 I CNIDT,CNIDT'>EDT D
81 . S AVAIL="CH" I MNIDT,MNIDT'>EDT S AVAIL="BOTH"
82 E I MNIDT,MNIDT'>EDT S AVAIL="MI"
83 I DIRECT=-1 S AVAIL="BOTH"
84 S ROUTE="NONE"
85 I ASK="BOTH" S ROUTE=AVAIL
86 I ASK="CH",AVAIL="CH"!(AVAIL="BOTH") S ROUTE="CH"
87 I ASK="MI",AVAIL="MI"!(AVAIL="BOTH") S ROUTE="MI"
88 I MICROCHK=-1 S ROUTE="MI"
89 I ROUTE="NONE" D Q
90 . K ^TMP("LR7OG",$J)
91 ;
92 I ROUTE="CH" D Q
93 . F S IDT=$O(^LR(LRDFN,"CH",IDT),DIRECT) Q:IDT<1 Q:IDT>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE) Q:DONE
94 . I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
95 . K ^TMP("LR7OG",$J),^TMP("LRPLS",$J)
96 ;
97 I ROUTE="MI" D Q
98 . F S IDT=$O(^LR(LRDFN,"MI",IDT),DIRECT) Q:IDT<1 Q:IDT>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE) Q:DONE
99 . K ^TMP("LR7OG",$J)
100 F D Q:DONE
101 . S I=IDT,CNIDT=0 F S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I I $P($G(^(I,0)),"^",3) S CNIDT=I Q
102 . S I=IDT,MNIDT=0 F S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I S MNIDT=I Q
103 . I 'CNIDT,'MNIDT S DONE=1 Q
104 . D I IDT>EDT S DONE=1 Q
105 .. I CNIDT=MNIDT D Q ; both chem and micro at this date/time
106 ... S IDT=CNIDT
107 ... I IDT'>EDT D
108 .... I FORMAT D Q
109 ..... I SDT=(9999999-2700101)!(DIRECT=-1) D Q
110 ...... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE)
111 ...... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
112 ..... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE)
113 ..... S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
114 .... I MICROCHK'=1 D Q:DONE
115 ..... D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE)
116 ..... I FORMAT S MICROCHK=1
117 .... D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE)
118 .. I 'MNIDT D Q ; no micro since this date/time, only chem at this date/time
119 ... S IDT=CNIDT
120 ... I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE)
121 .. I 'CNIDT D Q ; no chem since this date/time, only micro at this date/time
122 ... S IDT=MNIDT
123 ... I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE)
124 .. I (DIRECT=1&(CNIDT<MNIDT))!(DIRECT=-1&(CNIDT>MNIDT)) D Q ;chem and micro data, chem is more recent
125 ... S IDT=CNIDT
126 ... I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE)
127 .. S IDT=MNIDT
128 .. I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE)
129 ;
130 I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
131 ;
132 K ^TMP("LR7OG",$J),^TMP("LRPLS",$J)
133 Q
Note: See TracBrowser for help on using the repository browser.