source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM1.m@ 868

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ; Mar 11, 2003
2 ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994
3 ;
4LRIDT ; from LR7OSUM
5 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) I $D(^(LRIDT,0)) S X=^(0),CT1=CT1+1 D LRIIDT
6 Q
7 ;
8LRIIDT ;
9 S (LRIIDT,LRVIDT)=$P(X,U,1),LRSUB=1,LRTNN=1,LRSPM=$P(X,U,5),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6)
10 Q:'$L(LRVDT)
11 D LRSUB
12 Q
13 ;
14 ;
15LRSUB ;
16 N LRTRES
17 S LRSUB=1
18 F S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1 D
19 . S X=^LR(LRDFN,"CH",LRIDT,LRSUB)
20 . S LRTRES=$$TSTRES^LRRPU(LRDFN,"CH",LRIDT,LRSUB,"")
21 . D SUB1
22 Q
23SUB1 ;
24 S LRTSTVAL=$P(X,U,1),X1=$P(X,U,2)
25 S LRNOFL="",LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
26 Q:LRTST=""
27 Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
28 I '$D(^LAB(64.5,"AC",LRSUB)) D MISC Q
29 K LRNON
30 D LRMH
31 I '$D(LRNON) D MISC
32 Q
33 ;
34LRMH ;
35 S LRMH=0
36 F S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:LRMH<1 D LRSH
37 Q
38 ;
39LRSH ;
40 S LRSH=0
41 F S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:LRSH<1 D TST
42 Q
43 ;
44TST ;
45 S LRTSTS=0
46 F S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS S LRSPM1=^(LRTSTS) D TST1
47 Q
48 ;
49 ;
50TST1 ;
51 Q:LRSPM'=LRSPM1
52SBSET ;
53 S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1
54 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD($P(LRTF,"^"))))
55 ;
56 ;** LRTE=Total minor headings
57 ;** LRMHN=Major heading name^TE^Lab performing tests
58 ;** LRTF=Minor header^Profile specimen^Total tests^Type of display
59 ;
60 S LRIIDT=LRVIDT
61 S:'$D(^TMP($J,LRDFN,LRMH)) ^(LRMH)=LRMHN
62 S:'$D(^TMP($J,LRDFN,LRMH,LRSH))!($D(^(LRSH))=10) ^(LRSH)=LRTF_U
63 S:'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,0)) ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT
64 ;
65LRTSTVAL ;
66 ;
67 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,LRTSTS)=$P(LRTRES,"^")_"^"_$P(LRTRES,"^",2)
68 S X=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
69 I $L(X) S ^TMP("LRT",$J,X)=$P(LRTF,"^")
70 I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",0)) D TEXT
71 D CHKUN
72 I $O(^LAB(60,LRTST,1,LRSPM,1,0)),'$D(^TMP($J,"EVAL",LRTST,LRSPM)) D
73 . S ^TMP($J,"EVAL",LRTST,LRSPM)=""
74 . N I,L,X,TST
75 . S I=0,TST=$S($L($P($G(^LAB(60,LRTST,.1)),"^")):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
76 . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Evaluation for "_TST_":"
77 . F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=X
78 Q
79 ;
80 ;
81MISC ;
82 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
83 S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
84 Q:LRTST=""
85 Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
86 S LRTOP=LRSPM
87 ;
88 S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM
89 ;S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=LRTSTVAL_U_LRSPM_U_LRTST_U_X1_U_LRSUB
90 S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6)
91 ;
92 S X=$S($D(^LAB(60,LRTST,.1)):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^")),^TMP("LRT",$J,X)="MISCELLANEOUS TESTS"
93 ;
94 ; Grab specimen comments
95 I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) D
96 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)="",L=0
97 . F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
98 ;
99 ; Grab test interpretation
100 I $O(^LAB(60,LRTST,1,LRSPM,1,0)) D
101 . N I,L,X,TST
102 . S I=0,TST=$S($L($P($G(^LAB(60,LRTST,.1)),"^")):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
103 . S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)=""
104 . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
105 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Evaluation for "_TST_":"
106 . F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=X
107 ;
108 S LRTNN=LRTNN+1
109 Q
110 ;
111 ;
112TEXT ;
113 S LRYESCOM=0
114 S M=0
115 F S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:M<1!(LRYESCOM) F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM S:$E(^(0),N)'[$C(32) LRYESCOM=1
116 Q:'LRYESCOM
117 S L=0
118 F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
119 Q
120 ;
121 ;
122MICRO ;from LR7OSUM
123 Q:'$D(^LR(LRDFN,"MI"))
124 N MICROCNT
125 S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
126 S (LRONESPC,LRONETST)="",LREND=0,MICROCNT=GCNT+1
127 I $O(^LR(LRDFN,"MI",0)) S ^TMP("LRH",$J,"MICROBIOLOGY")=MICROCNT
128 S LRWRDVEW="",LRSB=0,LRIDT=LRIN
129 F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) S LRNLOC=LRLLOC,CT1=CT1+1 D EN1^LR7OSMZ0 S LRLLOC=LRNLOC
130 I GCNT'>MICROCNT K ^TMP("LRH",$J,"MICROBIOLOGY")
131 K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
132 Q
133 ;
134 ;
135CHKUN ; Check units and normals with cumulative report values
136 ; Add comment if these differ from file #64.5 values
137 ;
138 N I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST
139 S LRX=$G(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS)),LRFLAG=0
140 S TST=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
141 S LRY="*** For test "_TST
142 ; Check units - if different generate comment
143 I $$UP^XLFSTR($P(LRX,"^",7))'=$$UP^XLFSTR($P(LRTRES,"^",5)) S LRY=LRY_" Units: "_$P(LRTRES,"^",5),LRFLAG=1
144 ;
145 ; Check normals - if different generate comment
146 S @("LRLO="_$S($P(LRX,"^",2)'="":$P(LRX,"^",2),$P(LRX,"^",11)'="":$P(LRX,"^",11),1:""""""))
147 ;
148 S @("LRHI="_$S($P(LRX,"^",3)'="":$P(LRX,"^",3),$P(LRX,"^",12)'="":$P(LRX,"^",12),1:""""""))
149 I LRLO'=$P(LRTRES,"^",3)!(LRHI'=$P(LRTRES,"^",4)) D
150 . I LRFLAG S LRY=LRY_" and"
151 . S LRY=LRY_" Normals: "_$P(LRTRES,"^",3)_"-"_$P(LRTRES,"^",4),LRFLAG=1
152 ;
153 I 'LRFLAG Q
154 ;
155 S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
156 S LRY=LRY_" ***",^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
157 Q
Note: See TracBrowser for help on using the repository browser.