source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM1.m@ 724

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ;10/10/07 11:51
2 ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994;Build 2
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 S TST=$P($G(^LAB(60,LRTST,.1)),"^")
94 I TST="" S TST=$P(^LAB(60,LRTST,0),"^")
95 S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
96 ;
97 ; Grab specimen comments
98 I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) D
99 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)="",L=0
100 . 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)
101 ;
102 ; Grab test interpretation
103 I $O(^LAB(60,LRTST,1,LRSPM,1,0)) D
104 . N I,L,X,TST
105 . S I=0,TST=$S($L($P($G(^LAB(60,LRTST,.1)),"^")):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
106 . S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)=""
107 . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
108 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Evaluation for "_TST_":"
109 . 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
110 ;
111 S LRTNN=LRTNN+1
112 Q
113 ;
114 ;
115TEXT ;
116 S LRYESCOM=0
117 S M=0
118 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
119 Q:'LRYESCOM
120 S L=0
121 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)
122 Q
123 ;
124 ;
125MICRO ;from LR7OSUM
126 Q:'$D(^LR(LRDFN,"MI"))
127 N MICROCNT
128 S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
129 S (LRONESPC,LRONETST)="",LREND=0,MICROCNT=GCNT+1
130 I $O(^LR(LRDFN,"MI",0)) S ^TMP("LRH",$J,"MICROBIOLOGY")=MICROCNT
131 S LRWRDVEW="",LRSB=0,LRIDT=LRIN
132 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
133 I GCNT'>MICROCNT K ^TMP("LRH",$J,"MICROBIOLOGY")
134 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
135 Q
136 ;
137 ;
138CHKUN ; Check units and normals with cumulative report values
139 ; Add comment if these differ from file #64.5 values
140 ;
141 N I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST
142 S LRX=$G(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS)),LRFLAG=0
143 S TST=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
144 S LRY="*** For test "_TST
145 ; Check units - if different generate comment
146 I $$UP^XLFSTR($P(LRX,"^",7))'=$$UP^XLFSTR($P(LRTRES,"^",5)) S LRY=LRY_" Units: "_$P(LRTRES,"^",5),LRFLAG=1
147 ;
148 ; Check normals - if different generate comment
149 S @("LRLO="_$S($P(LRX,"^",2)'="":$P(LRX,"^",2),$P(LRX,"^",11)'="":$P(LRX,"^",11),1:""""""))
150 ;
151 S @("LRHI="_$S($P(LRX,"^",3)'="":$P(LRX,"^",3),$P(LRX,"^",12)'="":$P(LRX,"^",12),1:""""""))
152 I LRLO'=$P(LRTRES,"^",3)!(LRHI'=$P(LRTRES,"^",4)) D
153 . I LRFLAG S LRY=LRY_" and"
154 . S LRY=LRY_" Normals: "_$P(LRTRES,"^",3)_"-"_$P(LRTRES,"^",4),LRFLAG=1
155 ;
156 I 'LRFLAG Q
157 ;
158 S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
159 S LRY=LRY_" ***",^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
160 Q
Note: See TracBrowser for help on using the repository browser.