source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACMP.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RACMP ;HISC/GJC AISC/MJK-Complication Report (Part 1 of 3) ;4/16/96 09:47
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ; Select Imaging Type, if exists
4 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
5 N RACMP S RACMP=+$O(^RA(78.1,"B","NO COMPLICATION",0))
6 I 'RACMP D Q
7 . W !,"You need to define 'NO COMPLICATION' in your Complication "
8 . W "Types file",!,"in order to run this report!"
9 . Q
10 S X=$$DIVLOC^RAUTL7() I X D KILL Q
11 S A="" F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
12 . Q:'$D(^TMP($J,"RA D-TYPE",A)) S B=0
13 . F S B=+$O(^TMP($J,"RA D-TYPE",A,B)) Q:'B D
14 .. S ^TMP($J,"RACMP",B)=0
15 .. S C="" F S C=$O(RACCESS(DUZ,"DIV-IMG",A,C)) Q:C']"" D
16 ... Q:'$D(^TMP($J,"RA I-TYPE",C)) S ^TMP($J,"RACMP",B,C)=0
17 ... Q
18 .. Q
19 . Q
20ASKLOG ; Ask date range
21 K A,B,C,^TMP($J,"DIV-IMG") W !
22 D DATE^RAUTL I RAPOP D KILL Q
23 S RADTBEGI=BEGDATE,RADTENDI=ENDDATE
24 S RADTBEG=BEGDATE-.0001,RADTEND=ENDDATE+.9999
25 K BEGDATE,ENDDATE
26 S Y=RADTBEGI X ^DD("DD") S RADTBEGX=Y
27 S Y=RADTENDI X ^DD("DD") S RADTENDX=Y
28 S ZTDESC="Rad/Nuc Med Complications Report"
29 S ZTRTN="START^RACMP",ZTSAVE("RACMP")=""
30 S ZTSAVE("RADT*")="",ZTSAVE("^TMP($J,""RACMP"",")=""
31 S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
32 S ZTSAVE("^TMP($J,""RA I-TYPE"",")="" D ZIS^RAUTL
33 I RAPOP D KILL Q
34START ; Start processing data
35 U IO D NOW^%DTC S (RAPG,RAXIT)=0
36 S:$D(ZTQUEUED) ZTREQ="@"
37 S RATDY=$$FMTE^XLFDT(%\1,1),$P(RALN,"-",(IOM+1))=""
38 S RAERR="No Data Captured For This Time Frame."
39 S RAHDR(1)=">>> Complications Report <<<"
40 S RAHDR(2)="Period: "_RADTBEGX_" to "_RADTENDX_"."
41 S RATAB(1)=$S(IOM=132:15,1:9),RATAB(2)=$S(IOM=132:24,1:26)
42 S RATAB(3)=$S(IOM=132:40,1:34),RATAB(4)=$S(IOM=132:52,1:49)
43 S RATAB(5)=$S(IOM=132:90,1:52),RATAB(6)=$S(IOM=132:102,1:62)
44 F RADTE=RADTBEG:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE!(RADTE>RADTEND) D Q:RAXIT
45 . S RADFN=0 F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN D Q:RAXIT
46 .. S RADTI=9999999.9999-RADTE D SORT^RACMP2
47 .. Q
48 . Q
49 I RAXIT D CLOSE^RAUTL,KILL Q
50 S X=$O(^TMP($J,"RACMP",""))
51 I X="" S Y=X
52 E S Y=$O(^TMP($J,"RACMP",X,""))
53 S RADIV=X,RAITYPE=Y D HEADER^RACMP2
54 I $D(^TMP($J,"RACMP")) D
55 . D PRINT^RACMP1
56 . I 'RAXIT D
57 .. S RADIVNM=$$DIVTOT("RACMP") Q:'RADIVNM
58 .. S (RADIV,RAFLG,RAITYPE)="",RAXIT=$$EOS^RAUTL5()
59 .. I 'RAXIT D HEADER^RACMP2,SYNOP^RACMP2
60 .. Q
61 . Q
62 D CLOSE^RAUTL,KILL
63 Q
64KILL ; Kill and quit
65 K %,%I,RA0,RA1,RA10,RA2,RA3,RA4,RA5,RA7,RACCESS(DUZ,"DIV-IMG"),RACMPTX
66 K RACNI,RACOMP,RADFN,RADIV,RADIVNM,RADTBEG,RADTBEGI,RADTBEGX,RADTE
67 K RADTEND,RADTENDI,RADTENDX,RADTI,RAERR,RAEX,RAFLG,RAHDR,RAITYPE,RALN
68 K RANME,RAPG,RAPHY,RAPOP,RAPRC,RARE,RARES,RASSN,RASTF,RATAB,RATDY,RATME
69 K RAQUIT,RAXIT,X,Y,ZTDESC,ZTRTN,ZTSAVE
70 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RACMP")
71 K ^TMP($J,"RACMRE"),^TMP($J,"RACNTU"),^TMP($J,"RACOMP")
72 K ^TMP($J,"RAEXAM")
73 K:$D(RAPSTX) RACCESS,RAPSTX
74 K %DT,BEGDATE,I,POP,RAMES
75 Q
76SET ; Set data global
77 S X=RADTE D TIME^RAUTL1 S RATME=X
78 S RAPRC=+$P(RAEX(0),"^",2),RAPRC=$G(^RAMIS(71,RAPRC,0))
79 S RAPRC=$S($P(RAPRC,"^")]"":$E($P(RAPRC,"^"),1,20),1:"Unknown")
80 S RARES=+$P(RAEX(0),"^",12),RARES=$G(^VA(200,RARES,0))
81 S RARES=$S($P(RARES,"^")]"":$E($P(RARES,"^"),1,20),1:"Unknown")
82 S RAPHY=+$P(RAEX(0),"^",14),RAPHY=$G(^VA(200,RAPHY,0))
83 S RAPHY=$S($P(RAPHY,"^")]"":$E($P(RAPHY,"^"),1,20),1:"Unknown")
84 S RASTF=+$P(RAEX(0),"^",15),RASTF=$G(^VA(200,RASTF,0))
85 S RASTF=$S($P(RASTF,"^")]"":$E($P(RASTF,"^"),1,20),1:"Unknown")
86 S RACMPTX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP"))
87 S RACMPTX=$S(RACMPTX]"":RACMPTX,1:"None")
88 S ^TMP($J,"RACMP",RADIV,RAITYPE,RANME,RADTE,RACNI)=RAPRC_"^"_RATME_"^"_RAPHY_"^"_RARES_"^"_RASTF_"^"_RACMPTX_"^"_$P(RACOMP,"^")_"^"_RASSN_"^"_RADFN
89 Q
90DIVTOT(Z) ; Check if more than one division is included in the report.
91 ; Pass back '0' if just one division, '1' if more than one division.
92 N X,Y1,Y2 S X=0
93 S Y1=+$O(^TMP($J,Z,X)) Q:'Y1 0
94 S Y2=+$O(^TMP($J,Z,Y1)) Q:Y2 1
95 Q 0
Note: See TracBrowser for help on using the repository browser.