source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR3.m@ 1639

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1RARTR3 ;HIRMFO/SWM-Queue/print Radiology Reports (utility) ;8/31/99 13:57
2 ;;5.0;Radiology/Nuclear Medicine;**8,10,19,27,35,45,75**;Mar 16, 1998;Build 4
3MEMS1 ;--- modifiers --- handle cases within print set
4 N RACNISAV,RAY3SAV,RAMEMARR,RACDIS,RALDIS
5 D EN2^RAUTL20(.RAMEMARR) Q:'$O(RAMEMARR(0))
6 S RACNISAV=RACNI,RAY3SAV=RAY3,RACNI=0
7 D CDIS^RAPROD S (RAREZON,RACNI)=0
8 ;for printsets print the REASON FOR STUDY along with the lead procedure
9 ;(avoid duplicate printing of the same data)
10 F S RACNI=$O(RAMEMARR(RACNI)) Q:'RACNI D S:$G(RAXIT) RAOOUT=1 Q:$D(RAOOUT)
11 . S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
12 . ;Check if cancelled & not part of printset
13 . I $P(^RA(72,+$P(RAY3,"^",3),0),"^",3)=0,($P(RAY3,"^",17)="") Q
14 . D MODS^RAUTL2
15 . ; If printing page at a time we need to check the length - RA*5*8
16 . I '$D(RAUTOE),$Y>(IOSL-6),IOST["C-" S RAP="" D WAIT^RART1 I X="^"!(X="P")!(X="T") S RAOOUT=1 Q
17 . D OUT1 Q:$G(RAXIT) S RAREZON=1
18 . D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28)) Q:$D(RAOOUT)
19 . D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
20 . Q
21 S RACNI=RACNISAV,RAY3=RAY3SAV K RAREZON
22 Q
23OUT1 ;
24 ; $O(RAMEMARR(0)) may be defined, if previously called MEMS1^RARTR3
25 ; RALDIS flags long display wanted, comes from certain output options
26 ; RACDIS(n) exists if case n is to be displayed
27 ; RACDIS(n) not set for dupl proc+pmod+cptmod so don't display
28 I $O(RAMEMARR(0)),'$G(RALDIS),'$D(RACDIS(RACNI)) Q
29 S RASTUDY=$P($G(^RAO(75.1,+$P(RAY3,U,11),.1)),U) ;Convey 'Reason for Study' P75
30 I $D(RAUTOE) G MAIL1
31 W !,$$XAM()
32 ;check for contrast media; display if CM data exists (patch 45)
33 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
34 I $L(RACMDATA) D
35 .W !?5,"Contrast Media :"
36 .F RAIZ=1:1 Q:$P(RACMDATA,", ",RAIZ)="" D
37 ..W ?22,$P(RACMDATA,", ",RAIZ)
38 ..W:$P(RACMDATA,", ",RAIZ+1)'="" !
39 ..I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF W !
40 ..Q
41 .K RAIZ
42 .QUIT
43 K RACMDATA Q:$G(RAXIT)
44 W:Y'="None" !?RATAB,"Proc Modifiers : ",Y
45 N I,J
46 W:Y(1)'="None" !?RATAB,"CPT Modifiers : "
47 I Y(1)'="None" F I=1:1 Q:$P(Y(2),", ",I)']"" S J=$P(Y(2),", ",I),J=$$BASICMOD^RACPTMSC(J,DT) W ?22,$P(J,"^",2)," ",$P(J,"^",3) W:$P(Y(2),", ",I+1)]"" ! I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF W !
48 I $L(RASTUDY),$G(RAREZON,0)=0 W ! D DIWP^RAUTL5(RATAB,68,"Reason for Study: "_RASTUDY) ;P75
49 K RASTUDY
50 Q
51 ;
52MAIL1 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
53 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$XAM()
54 ;check for contrast media; display if CM data exists (patch 45)
55 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
56 I $L(RACMDATA) D
57 .S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Contrast Media : "_$P(RACMDATA,", ")
58 .F RAIZ=2:1 Q:$P(RACMDATA,", ",RAIZ)="" S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$P(RACMDATA,", ",RAIZ)
59 .K RAIZ
60 .Q
61 K RACMDATA
62 S:Y'="None" ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Proc Modifiers : "_Y
63 I Y(1)'="None" D
64 .S J=$P(Y(2),", ",1),J=$$BASICMOD^RACPTMSC(J,DT) S:+J<0 $P(J,"^",2,3)="None^"
65 .S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" CPT Modifiers : "_$S(J]"":$P(J,"^",2)_" "_$P(J,"^",3),1:"")
66 .F I=2:1 Q:$P(Y(2),", ",I)']"" S J=$P(Y(2),", ",I),J=$$BASICMOD^RACPTMSC(J,DT) S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$P(J,"^",2)_" "_$P(J,"^",3)
67 .Q
68 I $L(RASTUDY),$G(RAREZON,0)=0 D S RAREZON=1
69 .N RAY S RASTUDY="Reason for Study: "_RASTUDY
70 .I $L(RASTUDY)'>68 S $P(RAY," ",6)="",^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAY_RASTUDY Q
71 .I $L(RASTUDY)>68 D
72 ..K ^UTILITY($J,"W") N %,DIW,DIWF,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,RAI,RAX,X,X1,Z
73 ..S DIWF="",DIWL=1,DIWR=65,X=RASTUDY D ^DIWP
74 ..S RAI=0 F S RAI=$O(^UTILITY($J,"W",DIWL,RAI)) Q:'RAI D
75 ...S RAX=$G(^UTILITY($J,"W",DIWL,RAI,0))
76 ...I RAI=1 S $P(RAY," ",6)="",^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAY_RAX
77 ...I RAI'=1 S $P(RAY," ",24)="",^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAY_RAX
78 ...Q
79 ..Q
80 .K ^UTILITY($J,"W")
81 .Q
82 K RASTUDY
83 Q
84 ;
85XAM() ; Return exam data information. Case number, exam status & procedure
86 ; name build into one string. Assumes RAY3 is the 0 node for exam data
87 Q:$G(RAY3)="" "" ; no exam information present.
88 N RAPROC,RAXAMSTR S RAXAMSTR=""
89 I $G(RALDIS)!('$O(RAMEMARR(0)))!($O(RAMEMARR(0))&($G(RACDIS(RACNI))=1)) D
90 . S $E(RAXAMSTR,1,5)="(Case"
91 . S $E(RAXAMSTR,7,(7+$L(+RAY3)))=+RAY3
92 . S $E(RAXAMSTR,$L(RAXAMSTR)+2,79)=$S($D(^RA(72,+$P(RAY3,"^",3),0)):$E($P(^(0),"^"),1,8)_")",1:"Unknown)")
93 . Q
94 E S:$G(RACDIS(RACNI)) $E(RAXAMSTR,1)="(",$E(RAXAMSTR,9,14)=RACDIS(RACNI)_"x",$E(RAXAMSTR,20)=")"
95 S RAPROC=$G(^RAMIS(71,+$P(RAY3,"^",2),0))
96 S $E(RAXAMSTR,22,54)=$S($P(RAPROC,"^")]"":$E($P(RAPROC,"^"),1,33),1:"Unknown")
97 N RADISPLY
98 S RADISPLY=$G(^RAMIS(71,+$P($G(^RADPT(+RADFN,"DT",+RADTI,"P",+RACNI,0)),U,2),0)) ; set $ZR to 71 for prccpt^radd1, not call raprod since store result
99 S RADISPLY=$$PRCCPT^RADD1()
100 S $E(RAXAMSTR,55,79)=RADISPLY
101 Q RAXAMSTR
Note: See TracBrowser for help on using the repository browser.