source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7PC1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 8.0 KB
Line 
1RAO7PC1 ;HISC/GJC,SS-Procedure Call utilities. ;12/9/02 08:41
2 ;;5.0;Radiology/Nuclear Medicine;**1,16,18,26,36,45,75**;Mar 16, 1998;Build 4
3 ;
4EN1(RADFN,RABDT,RAEDT,RAEXN,RACINC) ;
5 ;
6 ; DBIA#2043 - Return list of exams within date range
7 ;
8 ; ** See routines RAO7PC1A and RAO7PC2 for additional comments **
9 ; ** and output node descriptions **
10 ;
11 ; Input: RADFN-> Patient IEN RABDT-> beginning date
12 ; RAEDT-> ending date RAEXN-> max # of exams
13 ; RACINC-> include cancelled exams? (1 if yes, default no)
14 ;
15 ; Output:
16 ; ^TMP($J,"RAE1",Patient IEN,Exam ID)=Procedure name^Case number^
17 ; Report status^Abnormal alert flag^Report ien^
18 ; Exam status order #~Exam status name^
19 ; Imaging location name^Imaging type abbr~
20 ; Imaging type name^abnormal results flag^CPT Code
21 ; ^CPRS Order ien^Images exist flag
22 ;
23 ;if there are one or more CPT modifiers:
24 ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",n)=CPT Mod^CPT Mod Name
25 ; n+1)=CPT Mod^CPT Mod Name
26 ;
27 ;if CPRS asks to display parent procs, and case is descendent of parent:
28 ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CPRS")=memb of set^parent prc name
29 ;
30 ; Note: It is possible for the ^TMP global data returned to contain
31 ; 'No Report' and a Report file ien for the same exam. This is
32 ; because Imaging can create a report stub in the Report file,
33 ; but no report interpretation exists and no status is assigned
34 ; to the report record.
35 ;
36 ; Exam ID: exam date/time (inverse) concatenated with the case IEN
37 ; Abnormal alert flag: Y or blank
38 ; Abnormal results flag: Y or blank, may be turned on even if
39 ; abnormal alert flag is not
40 ;
41 Q:'RADFN!('RABDT)!('RAEDT)
42 N RAEXNP S RAEXNP=RAEXN ;save original value of RAEXN
43 ; if last char RAEXNP has "P", then count max no. by parent and
44 ; single, not by individual cases
45 S RACINC=+$G(RACINC)
46 Q:RABDT>RAEDT ; quit if ending date before beginning date
47 K ^TMP($J,"RAE1") S RAEXN=+$G(RAEXN)
48 S:$P(RABDT,".",2) RABDT=RABDT\1 S:$P(RAEDT,".",2) RAEDT=RAEDT\1
49 N RABNOR,RACNST,RACNT,RACPT,RACSE,RADIAG,RAIBDT,RAIEDT,RAILOC,RAITY
50 N RANO,RAPRC,RAREX,RARPT,RARPTST
51 N RAXAM,RAXID,RAXIT,RAXSTAT,RABNORMR,RASHOCAN
52 S RACNST=9999999.9999
53 S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001)
54 S (RACNT,RAXIT)=0
55 F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D Q:RAXIT
56 . D SETDATA^RAO7PC1A ; obtain exam data, set ^TMP($J,"RAE1",Patient IEN,Exam ID)
57 . Q
58 Q
59EN2(RADFN) ;
60 ;
61 ; DBIA#2012 - Return last 7 days of non-cancelled exams
62 ;
63 ; Input: RADFN-> Patient IEN
64 ;
65 ; Output:
66 ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^
67 ; report status^imaging location IEN^imaging location name^
68 ; contrast medium or media used
69 ; Note: Single characters in parenthesis indicate contrast
70 ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic;
71 ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin;
72 ; (B)=Barium; (M)=unspecified contrast media
73 ;
74 ; Exam ID: exam date/time (inverse) concatenated with the case IEN
75 ;
76 Q:'RADFN D EN2^RAO7PC1A Q
77 ;
78EN3(X) ; DBIA#2265 - Return narrative text for exam(s)
79 ; Input:
80 ; X-> Exam id in one of two forms:
81 ; 1) Pat. DFN^inv. exam date^Case IEN
82 ; Retrieves a single report for a single exam
83 ; 2) Pat. DFN^inv. exam date^
84 ; Retrieves all reports for a set of exams ordered on one order
85 ;
86 ; Note: Input delimiter can be any of the following: ^~\&;-
87 ; a delimiter may be a single space i.e, " "
88 ;
89 ; Output:
90 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name)=report status^
91 ; abnormal alert flag^CPRS Order ien^amended report?
92 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"CM",n)=contrast
93 ; media used during exam (internal)^contrast media used during exam
94 ; (external)
95 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"D",n)=diagnostic
96 ; code (n=1, this is the primary code)
97 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"H",n)=clin history
98 ; (a line of text)
99 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"I",n)=impression
100 ; (a line of text)
101 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"M",n)=modifier
102 ; (external format)
103 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"P")=primary
104 ; interpreting staff IEN^primary interpreting resident IEN^date
105 ; report entered
106 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"R",n)=report
107 ; (a line of text)
108 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"RFS")=REASON
109 ; FOR STUDY; the reason the study was conducted (a line of text)
110 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"V",n)=verifier IEN
111 ; ^signature block name
112 ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"TCOM",1)=techno-
113 ; logist comment (a line of text)
114 ; ^TMP($J,"RAE2",Patient IEN,"PRINT_SET")=null (IFF this is a printset)
115 ; ^TMP($J,"RAE2",Patient IEN,"ORD")=name of ordered procedure for
116 ; examsets and printsets
117 ; ^TMP($J,"RAE2",Patient IEN,"ORD",case IEN)=name of ordered procedure
118 ; for that case; not part of an examset or printset
119 ;
120 K RAU,^TMP($J,"RAE2") S RAU=$$DEL(X)
121 I RAU="" K RAU Q
122 Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT
123 N RACIEN,RADFN,RAINVXDT,RAPSET,Y S RAPSET=0
124 S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3)
125 K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2)
126SS I RACIEN D CASE^RAO7PC2(RACIEN) D SVTCOM^RAUTL11(RADFN,RAINVXDT,RACIEN) Q ;P18 mod by SS
127 S Y=0
128 F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D
129 . D CASE^RAO7PC2(Y)
130 . D SVTCOM^RAUTL11(RADFN,RAINVXDT,Y) ;P18 save TCOM in ^TMP
131 . S RAPSET=0 ;P18 modified
132 . Q
133 Q
134 ;
135EN30(RAOIFN) ; DBIA#2266 - Return narrative text for exam(s). To be used
136 ; with the EN3 entry point above.
137 ; Input: RAOIFN -> the ien of Rad/Nuc Med Order
138 Q:'RAOIFN ; order passed in as 0 or null
139 Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order
140 Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order
141 N RADFN,RADTI,RACNI,RAXSET
142 S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN
143 S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI
144 S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1
145 I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code
146 ; the following code is executed for non-exam set examinations
147 S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI
148 D EN3(RADFN_"^"_RADTI_"^"_RACNI)
149 Q
150EN4(RABBRV,RAARY) ; Return Imaging Locations
151 ; Input: RABBRV-> Abbreviation for I-Type RAARY-> data storage array
152 ;
153 ; Output:
154 ; array name(location IEN)=File 79.1 IEN^File 44 name^division IEN
155 ; ^division name
156 ;
157 Q:RABBRV']"" ; quit no I-Type abbreviation
158 Q:RAARY']"" ; quit no data storage array
159 N RADIV,RAITY,RALOC,RAX
160 S RAITY=+$O(^RA(79.2,"C",RABBRV,0)) Q:'RAITY
161 S RAX=0 F S RAX=$O(^RA(79.1,"BIMG",RAITY,RAX)) Q:RAX'>0 D
162 . S RADIV(79)=$G(^RA(79.1,RAX,"DIV"))
163 . S RALOC(0)=$G(^RA(79.1,RAX,0))
164 . Q:$P(RALOC(0),"^",19)]"" ;inactive DT present, can't be a future DT
165 . S RALOC=$P($G(^SC(+RALOC(0),0)),U)
166 . S RALOC=$S(RALOC]"":RALOC,1:"Unknown")
167 . S RADIV=+$P($G(^RA(79,+RADIV(79),0)),U),RADIV(4)=$G(^DIC(4,RADIV,0))
168 . S RADIV=$S($P(RADIV(4),U)]"":$P(RADIV(4),U),1:"Unknown")
169 . S @(RAARY_"("_RAX_")")=RAX_U_RALOC_U_+RADIV(79)_U_RADIV
170 . Q
171 Q
172CASE(RAOIFN,RARRAY) ; Return the case numbers and the total number of
173 ; case numbers associated with a particular order.
174 ; Input: RAOIFN-order ien (75.1)
175 ; RARRAY-data storage (local array)
176 ; Return: RATTL-n^x where n is the number of cases in the array
177 ; x=PRINTSET if a single report covers many cases.
178 ; -1 if error (invalid order ien)
179 ; -2 no registered case to date -OR- case(s) cancelled
180 ; If -1 or -2, second piece of RATTL gives the reason
181 ; RARRAY-local data array, array_name(case #)
182 N RATTL S RATTL="" D CASE^RAO7PC1A
183 Q RATTL
184DEL(X) ; Determine the delimiter used to seperate the data
185 ; Input: 'X'-> data seperated by a delimiter (first & second pieces
186 ; will follow null)
187 N Y,Z
188 F Y="^","~","\","&",";","-"," " S Z=$F(X,Y) I +Z Q
189 Q $S(+Z>0:Y,1:"") ; pass back the delimiter used, or null if not found
Note: See TracBrowser for help on using the repository browser.