source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACMP1.m@ 898

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1RACMP1 ;HISC/GJC-Complication Report (Part 2 of 3) ;4/16/96 10:50
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3PRINT ; Output subroutine part one
4 N I,J,RADATE,RAINVDT,RALBL,RALN1,RATECH
5 S RA1="",RALBL="Description: ",RALN1=$TR(RALN,$E(RALN),"=")
6 F S RA1=$O(^TMP($J,"RACMP",RA1)) Q:RA1']"" D Q:RAXIT
7 . S RADIV=RA1,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^"),RA2=""
8 . F S RA2=$O(^TMP($J,"RACMP",RA1,RA2)) Q:RA2']"" D Q:RAXIT
9 .. S RAITYPE=RA2,RA3=""
10 .. F S RA3=$O(^TMP($J,"RACMP",RA1,RA2,RA3)) Q:RA3']"" D Q:RAXIT
11 ... S RA4=0
12 ... F S RA4=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4)) Q:'RA4 D Q:RAXIT
13 .... S RA5=0
14 .... F S RA5=$O(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5)) Q:'RA5 D Q:RAXIT
15 ..... S RA0=$G(^TMP($J,"RACMP",RA1,RA2,RA3,RA4,RA5))
16 ..... D:RA0]"" PRT1
17 ..... Q
18 .... Q
19 ... Q
20 .. D:'RAXIT IMGCHK
21 .. Q
22 . D:'RAXIT DIVCHK
23 . Q
24 Q
25PRT1 ; Output subroutine two
26 F I=1:1:9 D
27 . S @$P("RAPRC^RATME^RAPHY^RARES^RASTF^RACMPTX^RACOMP^RASSN^RADFN","^",I)=$P(RA0,"^",I)
28 . Q
29 S RADATE=$$FMTE^XLFDT(RA4,"2D"),RAINVDT=9999999.9999-RADATE
30 I $Y>(IOSL-4) D Q:RAXIT
31 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
32 . Q
33 I IOM=132 D
34 . W !,RA3,?RATAB(2),RASSN,?RATAB(3),RADATE,?RATAB(4),RAPRC
35 . W ?RATAB(5),"Physician: ",RAPHY,!?RATAB(3),RATME,?RATAB(4),RACOMP
36 . W ?RATAB(5),"Interpreting Res. : ",RARES
37 . W !?RATAB(5),"Interpreting Stf. : ",RASTF
38 . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D Q:RAXIT
39 .. F S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I D Q:RAXIT
40 ... S J=$G(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I,0))
41 ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)
42 ... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
43 ... W:'RAXIT !?RATAB(5),"Tech: ",RATECH
44 ... Q
45 .. Q
46 . W:'RAXIT !,RALBL,RACMPTX,!,RALN1
47 . Q
48 E D ; Assume 80
49 . W !,RA3,?RATAB(3),RADATE,?RATAB(4),RAPRC,!,RASSN,?RATAB(3),RATME
50 . W ?RATAB(4),RACOMP
51 . W !?RATAB(1),"Physician: ",RAPHY
52 . W !?RATAB(1),"Interpreting Res. : ",RARES
53 . W !?RATAB(1),"Interpreting Stf. : ",RASTF
54 . I +$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",0)) S I=0 D
55 .. F S I=$O(^RADPT(RADFN,"DT",RAINVDT,"P",RA5,"TC",I)) Q:'I S J=^(0) D
56 ... S RATECH=$E($P($G(^VA(200,+J,0)),"^"),1,20)
57 ... W !?RATAB(1),"Tech: ",RATECH
58 ... Q
59 .. Q
60 . W !,RALBL,$E(RACMPTX,1,65)
61 . W:$E(RALBL,66,100)]"" !?$L(RALBL),$E(RALBL,66,100) W !,RALN1
62 . Q
63 Q
64DIVCHK ; Output statistics within division, check for EOS on division
65 N RA6
66 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
67 W !!?5,"Division: "_RADIV("X")
68 W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV))
69 W " Exams: ",+$G(^TMP($J,"RAEXAM",RADIV))," % Complications: "
70 I +$G(^TMP($J,"RAEXAM",RADIV))=0 W "0"
71 E W $J((+$G(^TMP($J,"RACOMP",RADIV))/+$G(^TMP($J,"RAEXAM",RADIV)))*100,6,2)
72 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
73 W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV))
74 W " C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV))
75 W " % C.M. Comp.: "
76 I +$G(^TMP($J,"RACOMP",RADIV))=0 W "0"
77 E W $J((+$G(^TMP($J,"RACMRE",RADIV))/+$G(^TMP($J,"RACOMP",RADIV)))*100,6,2)
78 S RA6=+$O(^TMP($J,"RACMP",RA1))
79 I RA6 S RADIV=RA6,RADIV("X")=$P($G(^DIC(4,RADIV,0)),"^") D
80 . N RA7 S RA7=$O(^TMP($J,"RACMP",RADIV,"")) S:RA7]"" RAITYPE=RA7
81 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
82 . Q
83 Q
84IMGCHK ; Check for EOS on I-Type
85 N RA10
86 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
87 W !,"Complications: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))
88 W " Exams: ",+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))
89 W " % Complications: "
90 I +$G(^TMP($J,"RAEXAM",RADIV,RAITYPE))=0 W "0"
91 E W $J((+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))/+$G(^TMP($J,"RAEXAM",RADIV,RAITYPE)))*100,6,2)
92 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2 Q:RAXIT
93 W !,"Contrast Media Complications: ",+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))
94 W " C.M. Exams: ",+$G(^TMP($J,"RACOMP",RADIV,RAITYPE))
95 W " % C.M. Comp.: "
96 I +$G(^TMP($J,"RACOMP",RADIV,RAITYPE))=0 W "0"
97 E W $J((+$G(^TMP($J,"RACMRE",RADIV,RAITYPE))/+$G(^TMP($J,"RACOMP",RADIV,RAITYPE)))*100,6,2)
98 S RA10=$O(^TMP($J,"RACMP",RA1,RA2))
99 I RA10]"" S RAITYPE=RA10 D
100 . S:$E(IOST,1,2)="C-" RAXIT=$$EOS^RAUTL5() D:'RAXIT HEADER^RACMP2
101 . Q
102 Q
Note: See TracBrowser for help on using the repository browser.