source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTRPT.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1MAGGTRPT ;WOIFO/RED/GEK - Display Associated Report ; [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**8,48**;Jan 11, 2005
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18BRK(MAGRPTY,MAGGIEN,NOCHK) ;RPC [MAGGRPT] Call to return Image report
19 ; MAGGIEN is internal number in Image File ^MAG(2005,
20 ; NOCHK is a Flag that tell to Not run the QA check, just return
21 ; the report.
22 ;
23 S MAGRPTY=$NA(^TMP($J,"WSDAT"))
24 K @MAGRPTY ; clean it up first.
25 S @MAGRPTY@(0)="0^Building the Image report..."
26 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTRPT"
27 ;
28 N X,Y,Z,MAGGBRK,MAGO,MAGGRPO,MAGDFN,MAGTMPR,MAGTMPRT
29 N MAGNODIS,MAGTMPR2,MAGDESC,MAGISGRP,MAGQA,%ZIS,IOP
30 S MAGGBRK=1,MAGISGRP=0
31 S MAGO=+$P(MAGGIEN,"^")
32 S NOCHK=+$G(NOCHK)
33 ; Requesting a report, have to check Image
34 ; and Group, if this image is in a group.
35 I 'NOCHK D Q:'MAGQA(0)
36 . D CHK^MAGGSQI(.MAGQA,MAGO)
37 . I 'MAGQA(0) S @MAGRPTY@(0)="-2^"_$P(MAGQA(0),U,2,99) Q
38 . S MAGGRPO=+$P(^MAG(2005,MAGO,0),U,10)
39 . Q:'MAGGRPO K MAGQA
40 . D CHK^MAGGSQI(.MAGQA,MAGGRPO)
41 . I 'MAGQA(0) S @MAGRPTY@(0)="-2^"_$P(MAGQA(0),U,2,99) Q
42 ;
43 ;
44 I 'MAGO S @MAGRPTY@(0)="INVALID Image pointer: '"_MAGGIEN_"'" Q
45 I $D(^MAG(2005.1,MAGO)) S @MAGRPTY@(0)="0^Image : """_$P($G(^MAG(2005.1,MAGO,2)),U,4)_""" has been deleted." Q
46 S MAGDESC="",MAGDFN=$P(^MAG(2005,MAGO,0),U,7)
47 ; IN check we get Desc for Report Window header,
48 ; and Define Group IEN - MAGGRPO if it exists.
49 ; and Define MAGISGRP = 1 if this MAGO is a group itself
50 D CHECK(.MAGO,MAGDFN,.MAGDESC,.MAGGRPO,.MAGISGRP)
51 ; quit if NO PARENT DATA FILE and No long description.
52 ; for the Image or the Group entry
53 I ($P($G(^MAG(2005,MAGO,2)),U,6)="")&('$D(^MAG(2005,MAGO,3)))&($P($G(^MAG(2005,MAGGRPO,2)),U,6)="")&('$D(^MAG(2005,MAGGRPO,3))) S @MAGRPTY@(0)="0^No Report for this Image" Q
54 S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
55 I POP S @MAGRPTY@(0)="0^Can't open device IMAGING WORKSTATION" K POP Q
56 U IO D BUILD
57 ;
58 D:IO'=IO(0) ^%ZISC
59 S:+$P(@MAGRPTY@(0),"^") @MAGRPTY@(0)="1^"_MAGDESC
60 Q
61BUILD ;
62 K DIC,DIR
63 N MAGDASH,DIWR,DIWL
64 S $P(MAGDASH,"_",79)="_"
65 ; If Child of group get PARENT DATA FILE from group
66 I MAGGRPO S MAGTMPR=$G(^MAG(2005,MAGGRPO,2)),MAGTMPRT=$P(MAGTMPR,"^",6) ;
67 ; if not child of group, then get PARENT DATA FILE from original IEN
68 I 'MAGGRPO S MAGTMPR=$G(^MAG(2005,MAGO,2)),MAGTMPRT=$P(MAGTMPR,"^",6)
69 S DIWR=80,DIWL=1
70 ; IF This is a group call GRPDESC which will print ALL image long descriptions , not just the group long desc
71 I MAGISGRP D GRPDESC^MAGGTRP1(MAGO)
72 ; If not a group, then print group long desc if it exists,
73 ; and/or the long desc of the Images itself
74 I 'MAGISGRP D
75 . I MAGGRPO D GETDESC^MAGGTRP1(MAGGRPO)
76 . D GETDESC^MAGGTRP1(MAGO)
77 . W MAGDASH
78 I MAGTMPRT="" D ENTRY^MAGLOG("LONGDES",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0) Q
79 I $P(MAGTMPR,"^",7)="" S @MAGRPTY@(0)="0^Full report not available through this windows option." Q
80 ;
81 ; Surgery reports
82 S MAGTMPR2=$P(^MAG(2005.03,MAGTMPRT,0),"^",1) I MAGTMPR2="SURGERY" D Q
83 . S SRTN=$P(MAGTMPR,"^",7)
84 . D ^SROPRPT K SRTN
85 . D ENTRY^MAGLOG("SURGRPT",DUZ,MAGO,"MAGRPT",MAGDFN,0)
86 ;
87 ; TIU documents;
88 I MAGTMPRT=8925 D Q
89 . N MAGY
90 . D TGET^TIUSRVR1(.MAGY,$P(MAGTMPR,"^",7))
91 . S I="" F S I=$O(@MAGY@(I)) Q:'I W !,@MAGY@(I)
92 . D ENTRY^MAGLOG("TIURPT",DUZ,MAGO,"MAGRPT",MAGDFN,0)
93 ;
94 ; Medicine reports
95 I MAGTMPRT>689.999&(MAGTMPRT<703) D Q
96 . S MAGNODIS=1
97 . D REPRT^MCMAGDSP($P(MAGTMPR,"^",7),MAGTMPRT)
98 . D ENTRY^MAGLOG("MEDRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
99 ;
100 ; Radiology reports
101 I MAGTMPRT=74 D Q
102 . D BUILD^MAGGTRP1($P(MAGTMPR,U,7))
103 . D ENTRY^MAGLOG("RADRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
104 ;
105 ;Laboratory reports
106 I $P(^MAG(2005.03,MAGTMPRT,0),"^",4)=63 D @$S(MAGTMPRT=63:"AU",MAGTMPRT=63.2:"AU",1:"LAB") Q
107 ;
108 S @MAGRPTY@(0)="0^Full report not available through this windows option."
109 Q
110 ;
111CHECK(MAGO,MAGDFN,MAGDESC,MAGGRPO,MAGISGRP) ;
112 ; 9/28/99 Change Report long description, so this is changed to
113 ; return the desc of MAGO, and define MAGGRPO if this is child of grp
114 N MAGTMP
115 I '$D(^MAG(2005,MAGO)) S @MAGRPTY@(0)="0^Invalid Image pointer"_MAGO Q
116 S MAGDESC=$P($G(^MAG(2005,MAGO,2)),U,4)
117 I $O(^MAG(2005,MAGO,1,0)) S MAGISGRP=1
118 S MAGGRPO=+$P(^MAG(2005,MAGO,0),U,10)
119 ;
120 S MAGTMP=$S(MAGGRPO:MAGGRPO,1:MAGO)
121 Q:'$D(^MAG(2005,MAGTMP,2))
122 ; Procedure Exam Date/Time
123 S Y=$P(^MAG(2005,MAGTMP,2),U,5),X=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
124 ; procedure short description
125 S Y=X_" "_$P(^MAG(2005,MAGTMP,0),U,8)_" "_$P($G(^MAG(2005,MAGTMP,2)),U,4)
126 I MAGDFN S MAGDESC=MAGDESC_"^"_$P($G(^DPT(MAGDFN,0)),U)
127 Q
128LAB ; Pathology Reports
129 N LINE,MAGIOPEN,MAGSTART,MAGEND,MAGSUB,TYPE,MAGXX,MAGLR
130 S TYPE=$P(^MAG(2005.03,MAGTMPRT,0),"^",2)
131 S MAGSTART=$P(^MAG(2005,MAGO,2),"^",10),MAGLR=$P(^MAG(2005,MAGO,2),"^",7)
132 I MAGSTART,MAGLR,$D(^LR(MAGLR,TYPE,MAGSTART,0)) D
133 . S (MAGSTART,MAGEND)=9999999-MAGSTART
134 . Q
135 ;if no pointer back to lab file use the procedure date/time.
136 I 'MAGSTART D
137 . S MAGSTART=$P(^MAG(2005,MAGO,2),"^",5)
138 . S (MAGSTART,MAGEND)=$P(MAGSTART,".")
139 . Q
140 I '$L(MAGSTART) D Q
141 . S @MAGRPTY@(1)="No Procedure Date/Time entered in file 2005 for this Image"
142 S TYPE=$S(TYPE="SP":"SURGICAL PATHOLOGY",TYPE="CY":"CYTOPATHOLOGY",1:TYPE)
143 S MAGSUB=1,MAGSUB(TYPE)="",MAGXX=""
144 S MAGIOPEN=1
145 D EN^LR7OSUM(MAGXX,MAGDFN,MAGSTART,MAGEND,10,80,.MAGSUB)
146 I '$D(^TMP("LRC",$J)) S @MAGRPTY@(1)="No report(s) on file." Q
147 E S LINE=0 F S LINE=$O(^TMP("LRC",$J,LINE)) Q:LINE<1 W !,^TMP("LRC",$J,LINE,0)
148 D ENTRY^MAGLOG("LABRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
149 K ^TMP("LRC",$J),^TMP("LRT",$J),^TMP("LRH",$J)
150 Q
151AU ;Autopsy Report
152 N LRDFN,MAGSUB,MAGXX,LINE
153 S MAGSUB("AUTOPSY")=""
154 I '$D(MAGO)!'$D(MAGDFN) W !,"Missing imaging pointers." Q
155 S LRDFN=$P(^MAG(2005,MAGO,2),"^",7),LRDFN=+LRDFN
156 I 'LRDFN!'$D(^LR(LRDFN,0)) W !,"Information missing, please use DHCP Lab print options." Q
157 I '$D(^LR(LRDFN,"AU")) W !,"Missing autopsy information." K LRDFN Q
158 D EN^LR7OSUM(.MAGXX,MAGDFN,,,,80,.MAGSUB)
159 I '$D(^TMP("LRC",$J)) S @MAGRPTY@(1)="No autopsy report on file." Q
160 S LINE=0 F S LINE=$O(^TMP("LRC",$J,LINE)) Q:LINE<1 W !,^TMP("LRC",$J,LINE,0)
161 D ENTRY^MAGLOG("LABRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
162 K ^TMP("LRC",$J)
163 Q
164ERRA ;
165 S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
166 D @^%ZOSF("ERRTN")
167 Q
Note: See TracBrowser for help on using the repository browser.