source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7PC3.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1RAO7PC3 ;HISC/SWM&CRT-Procedure Call utilities. ;7/30/01 10:28
2 ;;5.0;Radiology/Nuclear Medicine;**16,26,27**;Mar 16, 1998
3 ;; api to return entire report (same as auto e-mail's)
4EN3(X) ; Return narrative text for exam(s)
5 ; Input:
6 ; X-> Exam id in one of two forms:
7 ; 1) Pat. DFN^inv. exam date^Case IEN
8 ; Retrieves a single report for a single exam
9 ; 2) Pat. DFN^inv. exam date^
10 ; Retrieves all reports for a set of exams ordered on one order
11 ;
12 ; Note: Input delimiter can be any of the following: ^~\&;-
13 ; a delimiter may be a single space i.e, " "
14 ;
15 ; Output:
16 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name)=report status^
17 ; abnormal alert^CPRS Order ien
18 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name,n)=line n of rpt
19 ; ^TMP($J,"RAE3",Patient IEN,"PRINT_SET")=null (IF this is a printset)
20 ; ^TMP($J,"RAE3",Patient IEN,"ORD")=name of ordered procedure for
21 ; examsets and printsets
22 ; ^TMP($J,"RAE3",Patient IEN,"ORD",case IEN)=name of ordered procedure
23 ; for that case; not part of an examset or printset
24 ;
25 ;
26 K ^TMP($J,"RAE3"),^TMP($J,"RA AUTOE")
27 K RAU S RAU=$$DEL^RAO7PC1(X) I RAU="" K RAU Q
28 Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT
29 N RACIEN,RADFN,RAINVXDT,RAPSET,RAUTOE,Y S RAPSET=0
30 S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3)
31 K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2)
32 I RACIEN D CASE(RACIEN) Q
33 S Y=0
34 F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D
35 . D CASE(Y) S RAPSET=0
36 . Q
37 Q
38EN30(RAOIFN) ; Return narrative text for exam(s).
39 ; To be used with the EN3 entry point above.
40 ;
41 ; Input: RAOIFN -> the ien of Rad/Nuc Med Order
42 ;
43 Q:'RAOIFN ; order passed in as 0 or null
44 Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order
45 Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order
46 N RADFN,RADTI,RACNI,RAXSET
47 S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN
48 S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI
49 S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1
50 I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code
51 ; the following code is executed for non-exam set examinations
52 S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI
53 D EN3(RADFN_"^"_RADTI_"^"_RACNI)
54 Q
55CASE(Y) ;
56 N N,RABNOR,RACASE,RACIEN,RADIAG,RAEXAM,RAINCLUD,RAOPRC,RAORD,BLANK
57 N RAMSG,RAPDIAG,RAPROC,RARDE,RARPT,RARPTST,RASPACE,SKIP,X,ZZRADFN,X0,X1,X2,RASIGVES
58 ;
59 S RACIEN=Y,$P(BLANK," ",80)=""
60 S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,0)) Q:RAEXAM(0)']""
61 S RACASE=$P(RAEXAM(0),"^")
62 S:$P(RAEXAM(0),"^",25)=2 RAPSET=1
63 S:RAPSET=1 ^TMP($J,"RAE3",RADFN,"PRINT_SET")=""
64 S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0))
65 S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown")
66 S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0))
67 S RAORD(7)=$P(RAORD(0),"^",7)
68 S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0))
69 S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown")
70 S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0))
71 S RARPT=+$P(RAEXAM(0),"^",17)
72 S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$P(RARPT(0),"^",5)
73 S RASIGVES="" I RARPTST="V",$P(RARPT(0),U,10)]"",$P(RARPT(0),U,9)]"" S X2=RARPT,X1=$P(RARPT(0),U,9),X=$P(RARPT(0),U,10) D DE^XUSHSHP S:X]"" RASIGVES="/ES/"_X
74 S RARDE=$$GET1^DIQ(74,RARPT_",",8,"E")
75 ; View whole report if Rad User or status is R or V.
76 D CHKUSR^RAUTL2 S RAINCLUD=RAMSG
77 S RAINCLUD=$S(RAMSG:1,RARPTST="V":1,RARPTST="R":1,1:0)
78 S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR=""
79 ;
80 I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD")=RAOPRC
81 I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD",RACIEN)=RAOPRC
82 ;
83 I RAPSET'<0 D
84 .S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="^"_RABNOR_"^"_RAORD(7)
85 .S $P(^TMP($J,"RAE3",RADFN,RACIEN,RAPROC),"^")=$$RPTST
86 S:RAPSET<0 ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)=""
87 S:RAPSET=1 RAPSET=-1
88 ;
89 ; Setup variables then call ^RARTR to create Rad Report on ^TMP nodes
90 ; 2 stages: INIT^RARTR creates header info, PRT1^RARTR for the report
91 ; (save RADFN as RARTR kills it at the end)
92 ;
93 S RAUTOE=1,ZZRADFN=RADFN,RAACNT=0
94 S X="^"_RADFN_"^"_(9999999.9999-RAINVXDT)_"^"_RACASE_"^"_RARPTST
95 ;
96 D INIT^RARTR
97 S (RAFFLF,RAORIOF)=$G(IOF)
98 I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q
99 ;
100 S RAVERF=0
101 I $$RPTST="No Report" D
102 .S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,"DT",RAINVXDT,0),"^",3)
103 .S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:"")
104 D PRT1^RARTR
105 S RADFN=ZZRADFN
106 Q:'$D(^TMP($J,"RA AUTOE"))
107 ;
108 ; Now manipulate ^TMP($J,"RA AUTOE" and save as ^TMP($J,"RAE3"
109 ; Step 1: Change Case Number to Exam Date
110 ; Step 2: Remove Impression, Report & Diagnostic Codes if not
111 ; Released or Verified
112 ; Also remove "Att Phys" and "Pri Phys"
113 ; Step 3: Change Status to Report Status & add Reported Date
114 ; Step 4: If No Report then get Clin History from file #70.
115 ; ** WITH PATCH 27 - NO LONGER NEED TO DO STEP 4 **
116 ;
117STEP1 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1)=$P(^TMP($J,"RA AUTOE",1),"Case: ")
118 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1.5)="Exm Date: "_$$GET1^DIQ(70.02,RAINVXDT_","_RADFN_",",.01,"E")
119 ;
120STEP2 K SKIP S N=1 F S N=$O(^TMP($J,"RA AUTOE",N)) Q:N="" D
121 . S X0=^TMP($J,"RA AUTOE",N),X1=$E(X0,1,10)
122 . I (X1="Att Phys: ")!(X1="Pri Phys: ") D
123 .. S ^TMP($J,"RA AUTOE",N)=$E(BLANK,1,41)_$E(X0,42,$L(X0))
124 .. Q
125 .;I $$RPTST="No Report",($E(^TMP($J,"RA AUTOE",N),1,21)=" Clinical History:") D STEP4
126 .I $E(^TMP($J,"RA AUTOE",N),1,12)=" Report: " D STEP3 Q:$$RPTST="No Report"
127 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,15)=" Impression:" D
128 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
129 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,28)=" Primary Diagnostic Code:" D
130 ..S SKIP=1 S ^TMP($J,"RA AUTOE",N)=$E(^TMP($J,"RA AUTOE",N),1,28)
131 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,31)=" Secondary Diagnostic Codes:" D
132 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
133 .I $E(^TMP($J,"RA AUTOE",N),1,27)="Primary Interpreting Staff:" K SKIP
134 .I $D(SKIP) S SKIP=SKIP+1
135 .I $G(SKIP)<3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N)=^TMP($J,"RA AUTOE",N)
136 .Q
137 ;
138XIT K ^TMP($J,"RA AUTOE")
139 Q
140 ;
141STEP3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=" Report Status: "_$$RPTST
142 I $$RPTST="No Report" S N="^" Q
143 S $P(RASPACE," ",46)=""
144 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=^(N-0.4)_$E(RASPACE,1,46-$L(^(N-0.4)))_"Date Reported: "_RARDE
145 I RARPTST="V" D
146 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.3)=RASPACE_" Date Verified: "_$P($$GET1^DIQ(74,+$P(RAEXAM(0),"^",17),7),"@")
147 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.2)=" Verifier E-Sig:"_RASIGVES
148 . Q
149 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.1)=""
150 S ^TMP($J,"RA AUTOE",N)=" Report:"
151 I 'RAINCLUD S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
152 Q
153 ;
154STEP4 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",0)) D
155 .N RAI,RAIN,Z S (RAI,Z)=0,RAIN=N_".000"
156 .F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z)) Q:Z'>0 D
157 ..S RAI=RAI+1
158 ..S RAIN=$E(RAIN,1,$L(RAIN)-$L(RAI))_RAI
159 ..S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,RAIN)=" "_$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z,0))
160 Q
161 ;
162RPTST() ; Return Full Report Status
163 Q $S(RARPTST="V":"Verified",RARPTST="R":"Released/Not Verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report")
164 ;
Note: See TracBrowser for help on using the repository browser.