source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAE.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.6 KB
Line 
1GMTSRAE ; SLC/JER,KER HIN/GJC Selected Radiology Extract ; 04/19/2002
2 ;;2.7;Health Summary;**14,25,30,37,40,47,49,51**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3125 ^RADPT( file 70
6 ; DBIA 501 ^RARPT( file 74, fields 5, 200, 300 and 400
7 ; DBIA 3417 ^RA(72, file 72, field 3 pending
8 ; DBIA 502 ^RAMIS(71, file 71, field 9
9 ; DBIA 10015 EN^DIQ1
10 ; DBIA 2056 $$GET1^DIQ (files 71, 72, and 74)
11 ; DBIA 2056 GETS^DIQ (file 70, subfile 70.03)
12 ; DBIA 1995 $$CPT^ICPTCOD
13 ; DBIA 10103 $$DT^XLFDT
14 ; DBIA 10104 $$UP^XLFSTR
15 ; DBIA 1996 $$MOD^ICPTMOD
16 ; DBIA 10011 ^DIWP
17 ;
18MAINSEL(MODE,TEST) ; Entry for Selection Items
19 N GMTSIDT,GMTSIDT2,GMTSCNT,GMTSPN,GMTSMAX K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
20 S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
21 S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
22 F S GMTSIDT=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX) D
23 . Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0)) N GMTS7002,GMTSPSET,GMTSXSET
24 . S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
25 . S GMTSXSET=+$P(GMTS7002,"^",5)
26 . S GMTSPN=0 F S GMTSPN=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT,GMTSPN)) Q:GMTSPN'>0!(GMTSCNT=GMTSMAX) D
27 . . S GMTSCNT=GMTSCNT+1 D GET
28 Q
29MAIN(MODE) ; Main Entry
30 N GMTSIDT,GMTSCNT,GMTSPN,GMTSMAX
31 K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
32 S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
33 S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
34 F S GMTSIDT=$O(^RADPT(DFN,"DT",GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX) D
35 . Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0)) N GMTS7002,GMTSPSET,GMTSXSET
36 . S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
37 . S GMTSXSET=+$P(GMTS7002,"^",5)
38 . S GMTSPN=0 F S GMTSPN=$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN)) Q:GMTSPN'>0!(+GMTSCNT'<GMTSMAX) D
39 . . S GMTSCNT=GMTSCNT+1 D GET
40 Q
41 ;
42GET ; Gets data associated with study and sets global array
43 ; ^TMP("RAE",$J, where:
44 ;
45 ; GMTSIDT = inverse exam date/time
46 ; GMTSPN = Case IEN
47 ;
48 ; ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)= <exam date> ^
49 ; <procedure> ^ <exam status> ^ <report status> ^
50 ; <prim interpret resident> ^ <prim interpret staff> ^
51 ; <CPT code> ^ <technologist> ^ <case number> ^
52 ; < exam status order >
53 ;
54 ; ^TMP("RAE",$J,GMTSIDT,"EXAMSET") Indicates if all
55 ; exams for this date/time are part of an exam set
56 ;
57 ; ^TMP("RAE",$J,GMTSIDT,"PRINTSET") Indicates if all
58 ; exams for this exam set share the same report
59 ;
60 ; Only if the report is verified -OR- released will
61 ; these nodes be set
62 ;
63 ; ^TMP("RAE",$J,IDT,PN,"D",seq #) = Dx codes
64 ; Sequence # = 1 Primary Dx
65 ; Sequence # > 1 Secondary Dx
66 ; ^TMP("RAE",$J,IDT,PN,"H",line #)= Clinical History line #
67 ; ^TMP("RAE",$J,IDT,PN,"I",line #)= Impression Text line #
68 ; ^TMP("RAE",$J,IDT,PN,"R",line #)= Report Text line #
69 ;
70 N DA,DIC,DIQ,%,D0,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DN,DR
71 N I,J,Y,Z,GMTSCPT,GMTSED,GMTSCN,GMTSRP,GMTSRPI,GMTSST,GMTSPTR
72 N GMTSTA,GMTSTAI,GMTSI,GMTSRAD,GMTSRRAD,GMTSSRAD,GMTSTC,GMTSSTO
73 N GMTSRA27 S GMTSRA27=$$PROK^GMTSU("RAUTL9",27)
74 S GMTSED=+$P(GMTS7002,"^")
75 S:GMTSXSET&('$D(^TMP("RAE",$J,GMTSIDT,"EXAMSET"))) ^TMP("RAE",$J,GMTSIDT,"EXAMSET")=""
76 ; Get
77 ; Exam Date $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",1)
78 ; Exam Set $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",5)
79 ; Case Number 70.03 .01 GMTSCN
80 ; Procedure 70.03 2 GMTSRP/GMTSRPI
81 ; Exam Status 70.03 3 GMTSST
82 ; Prim Interpret Resident 70.03 12 GMTSRRAD
83 ; Prim Diagnostic Code 70.03 13 GMTSDX
84 ; Prim Interpreting Staff 70.03 15 GMTSSRAD
85 ; Report Text 70.03 17
86 ; Member of Set 70.03 25
87 ; Exam Status Order 72 3 GMTSSTO
88 ;
89 S DIC="^RADPT("_DFN_",""DT"","_GMTSIDT_",""P"",",DA=GMTSPN,DIQ="GMTSRAD("
90 S DIQ(0)="IE",DR=".01;2;3;12;13;15;17;25" D TECH
91 D EN^DIQ1
92 S GMTSCN=$G(GMTSRAD(70.03,GMTSPN,.01,"E"))
93 S GMTSRP=$G(GMTSRAD(70.03,GMTSPN,2,"E"))
94 S GMTSRPI=$G(GMTSRAD(70.03,GMTSPN,2,"I"))
95 S GMTSST=$G(GMTSRAD(70.03,GMTSPN,3,"E"))
96 S GMTSSTO=$G(GMTSRAD(70.03,GMTSPN,3,"I"))
97 S GMTSSTO=$$GET1^DIQ(72,+GMTSSTO,3,"I")
98 I GMTSTC S GMTSTC(0)=$E($G(GMTSRAD(70.12,GMTSTC,.01,"E")),1,18)
99 S GMTSRRAD=$E($G(GMTSRAD(70.03,GMTSPN,12,"E")),1,18)
100 S GMTSSRAD=$E($G(GMTSRAD(70.03,GMTSPN,15,"E")),1,18)
101 S GMTSPTR=$G(GMTSRAD(70.03,GMTSPN,17,"I"))
102 ; Exam Set/Report
103 ;
104 ; If GMTSPSET = "" single exam
105 ; If GMTSPSET = 1 exam set, single report
106 ; If GMTSPSET = 2 exam set, combined report
107 ;
108 S GMTSPSET=$G(GMTSRAD(70.03,GMTSPN,25,"I"))
109 D PMOD,CMOD I +GMTSPTR>0 S DIC="^RARPT(",DA=GMTSPTR,DIQ="GMTSRAD(",DIQ(0)="IE",DR="5" D EN^DIQ1
110 S GMTSTA=$G(GMTSRAD(74,+GMTSPTR,5,"E"))
111 S GMTSTAI=$G(GMTSRAD(74,+GMTSPTR,5,"I"))
112 I $L(GMTSTAI),("VR"[$E(GMTSTAI)) D GETDX(GMTSPN_","_GMTSIDT_","_DFN_",")
113 S GMTSCPT=$$GET1^DIQ(71,+GMTSRPI,9,"I")
114 S GMTSCPT=$S(+GMTSCPT>0:$P($$CPT^ICPTCOD(+GMTSCPT),"^",2),1:"")
115 S ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)=GMTSED_U_GMTSRP_U_GMTSST_U_GMTSTA_U_GMTSRRAD_U_GMTSSRAD_U_GMTSCPT_U_$G(GMTSTC(0))_U_GMTSCN_U_$G(GMTSSTO)
116 S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0 D
117 . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
118 S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0 D
119 . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
120 S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI'>0 D
121 . Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"M"))) Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"N"))) N I S I=+($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)))+1
122 . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",I)=$G(GMTSRAD(70.3135,GMTSI,.01,"M"))_"^"_$$UP^XLFSTR($G(GMTSRAD(70.3135,GMTSI,.01,"N")))_"^"_$G(GMTSRAD(70.3135,GMTSI,.01,"N")),^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)=I
123 ; Only verified reports can be printed
124 I GMTSTAI'="V",($E(IOST)="P") D Q
125 . S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
126 ; Only verified & Released/Unverified can viewed
127 I $S(GMTSTAI="V":0,GMTSTAI="R":0,1:1) D Q
128 . S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
129 Q:$D(^TMP("RAE",$J,GMTSIDT,"PRINTSET"))
130 D GETIMP D:$G(MODE)=2 GETHIS,GETADD,GETREP
131 S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
132 Q
133 ;
134GETIMP ; Gets Radiologist's Impression
135 N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,300,,"GMTST")
136 K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
137 I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
138 K ^UTILITY($J,"W"),GMTST Q
139 ;
140GETHIS ; Gets Clinical History (#70/#74)
141 N X,GMTSLN
142 I +($G(GMTSRA27))>0 S X=$$GET1^DIQ(70.03,(GMTSPN_","_GMTSIDT_","_DFN_","),400,,"GMTST")
143 I +($G(GMTSRA27))'>0 S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
144 K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
145 I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"H",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
146 K ^UTILITY($J,"W"),GMTST Q
147 Q
148GETADD ; Gets Additional Clinical History (#74)
149 Q:+($G(GMTSRA27))'>0 N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
150 K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
151 I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) D
152 . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"A",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
153 K ^UTILITY($J,"W"),GMTST Q
154GETREP ; Gets Radiologist's Report
155 N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,200,,"GMTST")
156 K ^UTILITY($J,"W") N X,I S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
157 I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"R",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
158 K ^UTILITY($J,"W"),GMTST Q
159PMOD ; Procedure Modifiers
160 N GMTS,GMTSI S GMTS=$G(DIC) Q:'$L(DIC) S GMTSI=+($G(DA)) Q:+GMTSI=0
161 N DIC,DA,DR S DIC=GMTS_GMTSI_",""M"","
162 S DA=0 F S DA=$O(@(DIC_DA_")")) Q:+DA'>0 S DR=".01" D
163 . D EN^DIQ1
164 Q
165CMOD ; CPT Modifiers
166 N GMTS,GMTSI,GMTSC,GMTSCM,GMTSCN S GMTS=$G(DIC) Q:'$L(DIC) S GMTSI=+($G(DA)) Q:+GMTSI=0
167 S DT=$$DT^XLFDT,U="^" N DIC,DA,DR S DIC=GMTS_GMTSI_",""CMOD"","
168 S DA=0 F S DA=$O(@(DIC_DA_")")) Q:+DA'>0 S DR=".01" D EN^DIQ1
169 S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI=0 D
170 . S GMTSC=$G(GMTSRAD(70.3135,GMTSI,.01,"I")) Q:+GMTSC=0
171 . S GMTSCM=$$MOD^ICPTMOD(GMTSC,"I",)
172 . S GMTSCN=$P(GMTSCM,"^",3),GMTSCM=$P(GMTSCM,"^",2)
173 . S GMTSRAD(70.3135,GMTSI,.01,"M")=GMTSCM
174 . S GMTSRAD(70.3135,GMTSI,.01,"N")=$$EN2^GMTSUMX(GMTSCN)
175 Q
176TECH ; Technician
177 S GMTSTC=+$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN,"TC",0))
178 I GMTSTC S DR=$G(DR)_";175",DR(70.12)=.01,DA(70.12)=GMTSTC F Q:$E(DR,1)'=";" S DR=$E(DR,2,$L(DR))
179 Q
180FORMAT ; Calls ^DIWP to format each line of text
181 N DIWL,DIWR,DIWF S DIWL=3,DIWR=($S(MODE=1:76,1:80))
182 D ^DIWP Q
183 ;
184GETDX(GMTSIEN) ; Set the data node with diagnostic code info.
185 ;
186 ; Input: GMTSIEN = Case IEN_","_exam date_","_DFN_","
187 ; Output: ^TMP("RAE",$J,GMTSIDT,GMTSPN,"D",seq #) = Dx codes
188 ;
189 ; Sequence # = 1 Primary Dx
190 ; Sequence # > 1 Secondary Dx
191 S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",1)=$G(GMTSRAD(70.03,$P(GMTSIEN,","),13,"E"))
192 N GMTSI,GMTSII,GMTSDX S GMTSI=1 D GETS^DIQ(70.03,GMTSIEN,"13.1*","E","GMTSDX")
193 S GMTSII="" F S GMTSII=$O(GMTSDX(70.14,GMTSII)) Q:GMTSII="" D
194 . S GMTSI=GMTSI+1 S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",GMTSI)=$G(GMTSDX(70.14,GMTSII,.01,"E"))
195 Q
Note: See TracBrowser for help on using the repository browser.