source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RART1.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1RART1 ;HISC/GJC,SWM-Reporting Menu (Part 2) ;11/18/97 13:34
2 ;;5.0;Radiology/Nuclear Medicine;**8,16,15,21,23,27,34**;Mar 16, 1998
3 ;Print Report By Patient has been moved to 4^RART2!
4 ;these sections are moved to ^RART3 : QRPT, PHYS, MODSET, OUT1
5CHK I 'RARPT!('$D(^RARPT(+RARPT,0))) W !?3,$C(7),"No report filed for case number ",RACN,"." K RARPT Q
6 I $D(RADFT),$P(^RARPT(+RARPT,0),"^",5)'["D" W !?3,$C(7),"Report for case number ",RACN," is not in a 'draft' status." K RARPT Q
7 I '$D(RADFT),$P(^RARPT(+RARPT,0),"^",5)["D" W !?3,$C(7),"Report filed for case number ",RACN," but not available for printing." K RARPT Q
8 Q
9 ;
105 ;;Draft Report (Reprint)
11 D SETVARS Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY)) S RADFT="" G 4^RART2
12 ;
136 ;;Display a Report By Patient
14 W ! S DIC(0)="AEMQ" D ^RADPA G Q6:Y<0 S RADFN=+Y,RAHEAD="**** Patient's Exams ****",RAF1=1,RAREPORT=1 D ^RAPTLU G Q6:X="^" G 6:'$D(RADUP)
15 I X=1 R X:3
16OERR ;entry from RA OERR PROFILE protocol
17 F RAI=0:0 S RAI=$O(RADUP(RAI)) Q:RAI'>0 S Y=^TMP($J,"RAEX",RAI) D 61,DISP Q:X="^"
18 K RADUP,RAI,RAJ,X,^TMP($J,"RAEX") Q:$D(ORVP) G 6
1961 F RAJ=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",RAJ)=$P(Y,"^",RAJ)
20 S Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) Q
21 ;
22OERR1 ;Entry Point for Alert Follow-Up Action for OE/RR
23 Q:'$D(XQADATA)!('$D(XQAID)) S (RARPT,Y)=XQADATA D RASET^RAUTL2
24 S:Y Y(0)=Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"Unknown"),RAPRC=$S($D(^RAMIS(71,+$P(Y(0),"^",2),0)):$P(^(0),"^"),1:"Unknown")
25 S RALERTS="" D DISP K:X="^" XQAID,XQAKILL
26 I $D(XQAID) S DFN=$P(XQAID,",",2) D DELETE^XQALERT
27 K RALERTS
28 Q
29 ;
30DISP I RARPT,($D(RAPBRPT)),($P($G(^RARPT(+RARPT,0)),"^",5)="V") D Q
31 . ; This code will not allow a user to re-edit a verified report.
32 . ; In this case, two or more possible users signed on to the same
33 . ; Imaging location, asked to verify the reports of the same
34 . ; Interpreting Radiology/Nuclear Medicine Physician.
35 . ; For the 'On-line Verifying of Reports' option only!
36 . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
37 . ; removed X from N so rtn RARTVER would quit if caret entered
38 . W !!?10,"Since the time you selected this group of reports,",!?10,$P($G(^VA(200,+$P(^RARPT(+RARPT,0),"^",9),0)),U)," has verified the report for "
39 . W !?10,$P($G(^DPT(+$P(^RARPT(+RARPT,0),"^",2),0)),U)," case #",$P(^RARPT(+RARPT,0),"^"),".",$C(7)
40 . S Y=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):$P($P(^(RARPT),"/",2),U,3),$D(RARPTX(+$G(RPTX))):$P($P(RARPTX(+$G(RPTX)),"/",2),U,3),1:"")
41 . I $D(^RAMIS(71,+Y,0)) W !?10,"Procedure ",$P(^(0),U)
42 . W ! K DIR S DIR(0)="E" D ^DIR S RAVFIED=1
43 . Q
44 D HOME^%ZIS S OREND=1
45 I 'RARPT!('$D(^RARPT(+RARPT,0))) D G Q6
46 . W !?3,$C(7),"No report filed for case number",$S($D(RACN):" "_RACN,1:""),"."
47 . R X:3 ; D:$$IMAGE^RARIC1 DISPF^MAGRIC ;don't call MAG 111300
48 . Q
49 S RAST=$P(^RARPT(+RARPT,0),"^",5)
50 I '$D(RARTVER),(RAST=""!(RAST["D")) D G Q6
51 . W !?3,$C(7),"Report filed for case number ",RACN," but not available for display."
52 . R X:3 ; D:$$IMAGE^RARIC1 DISPF^MAGRIC ;don't call MAG 111300
53 . Q
54DISP1 I $S('$D(ORACTION):1,ORACTION'=8:1,'$D(X):0,X="T":1,1:0) W @IOF
55 W !,RANME," (",$$SSN^RAUTL,")",?41,"Case No. ",?57,": ",$P($G(^RARPT(RARPT,0)),"^")," @",$E(RADATE,$L(RADATE)-4,$L(RADATE))
56 W !,$E(RAPRC,1,40) I +$G(^RARPT(RARPT,"T")) W ?41,"Transcriptionist",?57,": ",$E($P($G(^VA(200,+^RARPT(RARPT,"T"),0)),"^"),1,20)
57 N R3 S R3=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RACNI),0))
58 W !,"Req. Phys : ",$E($P($G(^VA(200,+$P(R3,"^",14),0)),"^"),1,25)
59 S RAPREVER=+$P($G(^RARPT(RARPT,0)),"^",13) W ?41,"Pre-verified",?57,": ",$S($D(^VA(200,RAPREVER,0)):$E($P($G(^VA(200,RAPREVER,0)),"^"),1,24),1:"NO") K RAPREVER
60 D PHYS^RART3
61 I $D(RAPBRPT),(RAST="PD") D
62 . W !,"**Prob Text: "
63 . I $G(^RARPT(+RARPT,"P"))]"" D
64 .. S X=$G(^RARPT(+RARPT,"P"))
65 .. D OUTTEXT^RAUTL9(X,"",10,70,13,"","!")
66 .. Q
67 . Q
68 W !,$$REPEAT^XLFSTR("=",79)
69 I $O(^RARPT(RARPT,1,0)) D MODSET^RART3
70 I '$O(^RARPT(RARPT,1,0)) D
71 . D MODS^RAUTL2,OUT1^RART3
72 . I +$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",28) S X=$$RDIO1^RARTUTL1(+$P(^(0),"^",28))
73 . Q:$L($G(X)) ; 'X' should be 'null' to continue
74 . S:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) X=$$PHARM1^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
75 . Q
76 Q:$G(X)="P" G DISP1:$G(X)="T",Q6:$G(X)="^"
77 I +$O(^RARPT(RARPT,"ERR",0)) W !?10,$$AMENRPT^RARTR2(),!
78 ;
79 ; Print the clinical history from file 70
80 I +$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",0)) D
81 . K ^UTILITY($J,"W"),^(1) S X="",DIWL=3,DIWF="|WC75"
82 . W !?3,"Clinical History:"
83 . S RAP="H" D WRITEHX(RAP)
84 . Q
85 Q:$G(X)="P" G DISP1:$G(X)="T",Q6:$G(X)="^"
86 ;
87 ; Print the additional report clinical history if defined and
88 ; different than the order clinical history.
89 I +$O(^RARPT(RARPT,"H",0)) D
90 . D CHKDUPHX Q:RADUPHX ; Duplicate history
91 . K ^UTILITY($J,"W"),^(1) S X="",DIWL=3,DIWF="|WC75"
92 . W !?3,"Additional Clinical History:"
93 . S RAP="AH" D WRITEHX(RAP)
94 ;
95 ; Print Report and Impression text
96 F RAP="R","I" D Q:X="^"!(X="P")!(X="T")
97 . K ^UTILITY($J,"W"),^(1) S X="",DIWL=3,DIWF="|WC75"
98 . W !?3,$S(RAP="R":"Report:",1:"Impression:") W:RAP="R" ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),U,2))
99 . W:RAP="R"&($E(RAST)="P") $C(7)
100 . D WRITE
101 . Q
102 Q:X="P" G DISP1:X="T",Q6:X="^"
103 ; I $$IMAGE^RARIC1() D DISPF^MAGRIC ;don't call MAG 111300
104 I $P($G(^RA(79.1,+$P(^RADPT(RADFN,"DT",RADTI,0),U,4),0)),U,18)="Y" D PRTDX^RART K RADXCODE
105 Q:X="P" G DISP1:X="T",Q6:X="^"
106 ;
107 I $D(ORVP) D
108 .S RAVERF=+$P($G(^RARPT(+RARPT,0)),"^",9)
109 .S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25)
110 .S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25)
111 .S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30)
112 .S:RADFTSBT']"" RADFTSBT=$$TITLE^RARTR0(RAVERF)
113 .W !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"")
114 .W:RADFTSBT]"" ", "_RADFTSBT
115 Q:X="P" G DISP1:X="T",Q6:X="^"
116 ;
117 K RAP I '$D(RARTVER) D WAIT Q:X="P" G DISP1:X="T"
118Q6 K %,DIC,DIWF,DIWL,DIWR,I,J,OREND,POP,RABTCH,RAF1,RAHEAD,RALOC,RANME,RAPAR,RAPRC,RAREPORT,RASEL,RASSN,RAST,RAV,RAXX,Y,X1,Z
119 K RAVERF,RADFTSBN,RADFTSBT
120 K DIW,DIWT,DN
121 K C,DIPGM,DISYS,R1,RAIMGTYI,RAP
122 K:'$D(RARTVER) RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RARPT Q
123 ;
124WRITE K RAXX N Y
125 F RAV=0:0 S RAV=$O(^RARPT(RARPT,RAP,RAV)) Q:RAV'>0 D Q:X="^"!(X="P")!(X="T")
126 . S RAXX=^RARPT(RARPT,RAP,RAV,0) S X=""
127 . D WAIT:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="P")!(X="T")
128 . S X=RAXX D ^DIWP S X=""
129 . Q
130 Q:X="^" D ^DIWW:$D(RAXX) Q
131 ;
132WRITEHX(RAP) ; Get and write the clinical history
133 ;
134 ;Input: RAP H = Clinical History from file 70
135 ; AH = Additional Clinical History from file 74
136 ;
137 K RAXX N Y
138 S RAV=0
139 I RAP="H" D
140 . F S RAV=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV)) Q:RAV'>0 D Q:X="^"!(X="P")!(X="T")
141 . . S RAXX=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAV,0),X=""
142 . . D WAIT:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="P")!(X="T")
143 . . S X=RAXX D ^DIWP S X=""
144 . . Q
145 I RAP="AH" D
146 . F S RAV=$O(^RARPT(RARPT,"H",RAV)) Q:RAV'>0 D Q:X="^"!(X="P")!(X="T")
147 . . S RAXX=^RARPT(RARPT,"H",RAV,0),X=""
148 . . D WAIT:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="P")!(X="T")
149 . . S X=RAXX D ^DIWP S X=""
150 . . Q
151 Q:X="^" D ^DIWW:$D(RAXX) Q
152 ;
153CHKDUPHX ; Check Duplicate History in file 70 and 74.
154 ; Returns RADUPHX 1 = Duplicate
155 ; 0 = Different
156 N RAX,RA74,RA70,RAOK,RAX1
157 ; Initialize to Different
158 S RADUPHX=0
159 ; Quit if H node does not exist. Could have been purged.
160 I '$D(^RARPT(RARPT,"H")) S RADUPHX=1 Q
161 S RA74=$O(^RARPT(RARPT,"H",""),-1)
162 S RA70=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",""),-1),RA701=$O(^(0))
163 S RAX=RA74-RA70+1 Q:RAX'=1 ; begin comparison
164 ; Check line by line of each file
165 ; RAOK 1 = all lines match
166 ; 0 = at least 1 difference
167 S RAOK=1
168 F RAX1=RA701:1:RA70 I ^RARPT(RARPT,"H",RAX1,0)'=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",RAX1,0) S RAOK=0 Q ;can exit loop on 1st difference
169 I 'RAOK Q
170 S RADUPHX=1
171 Q
172 ;
173WAIT ; user input, goto top, print, or continue
174 S RARD(1)="Continue^continue normal processing"
175 S:$D(RALERTS) RARD(2)="Print^print the entire report"
176 S RARD(3)="Top^display the report from the beginning"
177 S (RARD("B"),RARD("DTOUT"))=1
178 S:$D(RALERTS) RARD("A")="Enter 'Top', 'Print' or 'Continue': "
179 S:'$D(RALERTS) RARD("A")="Enter 'Top' or 'Continue': "
180 S RARD(0)="S" D SET^RARD K RARD S X=$E(X)
181 I $D(RALERTS),(X="P") D QRPT^RART3
182 Q:X="^"!(X="P") W:X="C"&($D(RAP)) @IOF
183 Q
184 ;
185LOCK(X,Y) ; Lock an entry
186 W !!,$C(7),"Another user is editing this ",$S(X="R":"report (Case # "_Y_")",1:"exam (diagnostic code)"),". Please try again later." H 4 Q
187 ;
188SETVARS ; Setup Rad/Nuc Med required variables
189 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
190 Q:'($D(RACCESS(DUZ))\10)
191 I $G(RAIMGTY)="" D SETVARS^RAPSET1(1)
192 Q
Note: See TracBrowser for help on using the repository browser.