close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGG.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGG.m@ 691

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

revised back to 6/30/08 version
File size: 5.9 KB
RevLine 
1LR7OGG ;DALOI/STAFF- Interim report rpc grid ; Feb 9, 2005
2 ;;5.2;LAB SERVICE;**187,290**;Sep 27, 1994
3 ;
4TEST ; test use only
5 N CNT,I K ^TMP("LR7OGX",$J)
6 S ^TMP("LR7OGX",$J,"INPUT",1)="2^2970202^2920202"
7 S CNT=1
8 ;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
9 F I=7,173,9,1 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
10 D GRIDDATA
11 S I=0 F S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
12 K ^TMP("LR7OGX",$J)
13 Q
14 ;
15GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
16 N CNT,NUM
17 K ^TMP("LR7OGX",$J,"INPUT"),^("OUTPUT")
18 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
19 S ^TMP("LR7OGX",$J,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
20 S CNT=1,NUM=0 F S NUM=$O(TESTS(NUM)) Q:NUM<1 D
21 .S CNT=CNT+1
22 .S ^TMP("LR7OGX",$J,"INPUT",CNT)=+TESTS(NUM)
23 D GRIDDATA
24 Q
25 ;
26GRIDDATA ;
27 ; input format
28 ; ^TMP("LR7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
29 ; ^TMP("LR7OGX",$J,"INPUT",#)=test# (tests displayed in this order)
30 ; (these tests should, be atomic, subscript - ch, type - both or output)
31 ;
32 S ^TMP("LR7OGX",$J,"OUTPUT",1)="0^0^0^1"
33 N ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,EDATE,EDT,FLAG,IDT
34 N LINE,LRCW,LRDFN,LRX,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
35 K ^TMP("LR7OG",$J)
36 S DFN=+^TMP("LR7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4)
37 D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
38 Q:'DFN Q:'SDATE Q:'EDATE Q:'LRDFN
39 S OUTCNT=1,(ADCNT,ADSEQ,ATCNT,ATSEQ,COMCNT,DATACNT,DATESEQ,TESTSEQ,TCNT)=0
40 S NUM=1
41 F S NUM=$O(^TMP("LR7OGX",$J,"INPUT",NUM)) Q:NUM<1 S TESTNUM=+^(NUM) D
42 . S TESTZERO=$G(^LAB(60,TESTNUM,0))
43 . S CHSUB=$P($P(TESTZERO,U,5),";",2)
44 . I 'CHSUB Q
45 . S TESTNAME=$P($G(^LAB(60,TESTNUM,.1)),U),PRNTCODE=$P($G(^(.1)),U,3)
46 . I TESTNAME="" S TESTNAME=$P(TESTZERO,U)
47 . S TESTSEQ=TESTSEQ+1
48 . S LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
49 . S ^TMP("LR7OG",$J,"TEST",CHSUB)=LINE
50 . S OUTCNT=OUTCNT+1
51 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
52 S ^TMP("LR7OGX",$J,"OUTPUT",1)=TESTSEQ
53 S EDATE=EDATE\1
54 S IDT=9999999-SDATE,EDT=9999999-EDATE
55 F S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT<1 Q:IDT>EDT D
56 . S ZERO=^LR(LRDFN,"CH",IDT,0)
57 . I '$P(ZERO,U,3) Q
58 . S CDT=+ZERO,SPEC=+$P(ZERO,U,5),SPECNAME=$P($G(^LAB(61,SPEC,0)),U),COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
59 . I ONLYSPEC,SPEC'=ONLYSPEC Q
60 . S CHSUB=1
61 . F S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB="" D
62 . . I '$D(^TMP("LR7OG",$J,"TEST",CHSUB)) Q
63 . . I '$D(^TMP("LR7OG",$J,"DATE",IDT)) S ^(IDT)="" D
64 . . . S DATESEQ=DATESEQ+1
65 . . . S OUTCNT=OUTCNT+1
66 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
67 . . . I COMMENT'="" D
68 . . . . S COMCNT=COMCNT+1
69 . . . . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
70 . . . . S NUM=0
71 . . . . F S NUM=$O(^LR(LRDFN,"CH",IDT,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
72 . . . . . S COMCNT=COMCNT+1
73 . . . . . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=LINE
74 . . . . S COMCNT=COMCNT+1
75 . . . . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=""
76 . . S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IDT,CHSUB,"")
77 . . S RESULT=$P(LRX,"^"),FLAG=$P(LRX,U,2)
78 . . S PRNTCODE=$P(^TMP("LR7OG",$J,"TEST",CHSUB),U,4)
79 . . I PRNTCODE'="" S X=RESULT,LRCW=8 S @("RESULT="_PRNTCODE)
80 . . E S RESULT=$J(RESULT,8)
81 . . S RESULT=$$STRIP^LR7OGU(RESULT)
82 . . I FLAG'="" D
83 . . . S ABTLINE=^TMP("LR7OG",$J,"TEST",CHSUB)
84 . . . I '$D(^TMP("LR7OG",$J,"ABTSEQ",+ABTLINE)) S ^(+ABTLINE)=U_$P(ABTLINE,U,2,3)
85 . . . I '$D(^TMP("LR7OG",$J,"ABDSEQ",IDT)) S ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
86 . . . S ^TMP("LR7OG",$J,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
87 . . S TESTSEQ=+^TMP("LR7OG",$J,"TEST",CHSUB)
88 . . S DATACNT=DATACNT+1
89 . . S ^TMP("LR7OG",$J,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
90 . . D TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
91 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
92 S DATACNT=0
93 F S DATACNT=$O(^TMP("LR7OG",$J,"DATA",DATACNT)) Q:DATACNT<1 S LINE=^(DATACNT) D
94 . S OUTCNT=OUTCNT+1,^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
95 S OUTCNT=OUTCNT+1,ABLINE=OUTCNT
96 S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^0^0"
97 ;
98 S (ABTCNT,ATSEQ)=0
99 F S ATSEQ=$O(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)) Q:ATSEQ<1 D
100 . S ABTCNT=ABTCNT+1
101 . S $P(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ),U)=ABTCNT
102 . S OUTCNT=OUTCNT+1
103 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
104 ;
105 S (ABDCNT,ADSEQ)=0
106 F S ADSEQ=$O(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)) Q:ADSEQ<1 D
107 . S ABDCNT=ABDCNT+1
108 . S $P(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ),U)=ABDCNT
109 . S OUTCNT=OUTCNT+1
110 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
111 ;
112 S (ABCNT,ADSEQ)=0
113 F S ADSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ)) Q:ADSEQ<1 D
114 . S ADCNT=+^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
115 . S ATSEQ=0
116 . F S ATSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)) Q:ATSEQ<1 D
117 . . S ATCNT=+^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
118 . . S ABCNT=ABCNT+1
119 . . S OUTCNT=OUTCNT+1
120 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)
121 ;
122 S ^TMP("LR7OGX",$J,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
123 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4)=OUTCNT
124 S TESTSEQ=0
125 F S TESTSEQ=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ)) Q:TESTSEQ<1 D
126 . S SPEC=0
127 . F S SPEC=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q:SPEC<1 S LINE=^(SPEC) D
128 . . S OUTCNT=OUTCNT+1
129 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
130 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,5)=OUTCNT
131 ;
132 S NUM=0
133 F S NUM=$O(^TMP("LR7OG",$J,"COMMENT",NUM)) Q:NUM<1 S LINE=^(NUM) D
134 . S OUTCNT=OUTCNT+1
135 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
136 K ^TMP("LR7OG",$J)
137 Q
138 ;
139 ;
140TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
141 N RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
142 S TESTSEQ=+$P(^TMP("LR7OG",$J,"TEST",CHSUB),U),TESTNUM=+$P(^(CHSUB),U,2),TESTNAME=$P(^(CHSUB),U,3)
143 I $D(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q
144 D URANGE^LR7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
145 S ^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$P(RANGE," - ")_U_$P($P(RANGE," - ",2)," (")
146 Q
Note: See TracBrowser for help on using the repository browser.