source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTRP1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1MAGGTRP1 ;WOIFO/GEK - Display Associated Report ; [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**8**;Sep 15, 2004
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 ;;
18 Q
19RAD(MAGRPTY,RARPT) ;RPC [MAGGRADREPORT] Call to retrun a Radiology report
20 ; MAGRPTY is the return array
21 ; RARPT is the Radiology Report IEN i.e. ^RARPT(RARPT
22 N ERRRES,RPTRES
23 S ERRRES=""
24 D OPENDEV Q:POP
25 D BUILD(RARPT)
26 S RPTRES=$G(@MAGRPTY@(0))
27 I 'RPTRES S ERRRES=RPTRES
28 I +RPTRES=-2 S ERRRES=RPTRES
29 D:IO'=IO(0) ^%ZISC
30 I $L(ERRRES) K @MAGRPTY S @MAGRPTY@(0)=ERRRES
31 ; Mod Patch5 block Questionable reports
32 ; stop incorrectly report success on a failed report attempt. this line is
33 ; moved inside BUILD tag
34 ;S @MAGRPTY@(0)="1^OK"
35 Q
36BUILD(RARPT) ;Call to generate the Radiology Report
37 ; This call is called be various Imaging routines to get the Rad Report
38 ; This call assumes the device is already open.
39 ; New the variables that'll be defined in the call to RASET^RAUTL2
40 N RACN,RACNI,RADATE,RADFN,RADTE,RADTI
41 ; We'll use these
42 ; RADTI = Inverse date/time for rad order
43 ; RACNI = rad case number
44 ; RADFN = Patient DFN
45 N I,Y,X,MAGPRC,XINF
46 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTRP1"
47 E S X="ERRA^MAGGTPR1",@^%ZOSF("TRAP")
48 I RARPT["PMRAD" S @MAGRPTY@(0)="-2^Patient Mismatch. Radiology Files" Q
49 I '$G(RARPT) S @MAGRPTY@(0)="0^NO Radiology Report number." Q
50 ;
51 I '$$FIND1^DIC(74,"","A",+RARPT) S @MAGRPTY@(0)="0^Radiology report entry "_RARPT_" is not on file. Contact IRM." Q
52 ;
53 S Y=RARPT
54 ; This call will define the needed variables RADTI,RACNI and RADFN
55 D RASET^RAUTL2
56 ;D RPT2DPT(RARPT,.XINF)
57 ;S ^TMP("MAGQIRP1",$J,"XINF")=XINF
58 ;I +XINF'=RADFN S @MAGRPTY@(0)="0^Patient Mismatch. Radiology Files" Q
59 S ^TMP("MAGQIRP1",$J)="RADFN "_RADFN_" RADTI "_RADTI_" RACNI "_RACNI
60 S ^TMP("MAGQIRP1",$J,1)="RARPT "_RARPT_" ,0)="_$G(^RARPT(RARPT,0))
61 D EN3^RAO7PC3(RADFN_"^"_RADTI_"^"_RACNI)
62 I '$D(^TMP($J,"RAE3")) D Q
63 . S @MAGRPTY@(0)="0^Radiology report not on file. Contact IRM." Q
64 S MAGPRC=$O(^TMP($J,"RAE3",RADFN,RACNI,""))
65 S I=0 F S I=$O(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I)) Q:'I D
66 . W !,$G(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I))
67 ; 2.5P5 This line was moved from above. So this BUILD function
68 ; should now correctly return success or failure.
69 S @MAGRPTY@(0)="1^OK"
70 Q
71OPENDEV ;
72 S MAGRPTY=$NA(^TMP($J,"WSDAT"))
73 K @MAGRPTY ; clean it up first.
74 S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
75 I POP S @MAGRPTY@(0)="0^Can't open device IMAGING WORKSTATION" Q
76 U IO
77 Q
78ERRA ;
79 S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
80 D @^%ZOSF("ERRTN")
81 Q
82GRPDESC(MAGIEN) ; PRINT LONG DESC OF IMAGE GROUP and ALL children in Group
83 ;DEVICE HAS ALREADY BEEN OPENED
84 N MAGCIEN,MAGJ,MAGDASH
85 S $P(MAGDASH,"_",79)="_"
86 K ^UTILITY($J,"W")
87 D GETDESC(MAGIEN)
88 S MAGCIEN=0
89 F S MAGCIEN=$O(^MAG(2005,MAGIEN,1,MAGCIEN)) Q:'MAGCIEN D
90 . S MAGJ=^MAG(2005,MAGIEN,1,MAGCIEN,0)
91 . I '$D(^MAG(2005,+MAGJ,3)) Q
92 . D GETDESC(MAGJ)
93 W MAGDASH
94 Q
95GETDESC(MAGIEN) ;
96 ;
97 N X,MAGI,DIWR,DIWL,DIWF,MAGHD
98 I $O(^MAG(2005,MAGIEN,1,0)) S MAGHD="Group"
99 E S MAGHD="Image"
100 W MAGHD_" ID# "_MAGIEN,!
101 I $O(^MAG(2005,MAGIEN,3,0)) D
102 . S DIWR=80,DIWL=1,DIWF="N"
103 . W MAGHD_" : "_$P(^MAG(2005,MAGIEN,2),U,4),!
104 . W MAGHD_" Long Description: ",!
105 . S MAGI=0
106 . F S MAGI=$O(^MAG(2005,MAGIEN,3,MAGI)) Q:+MAGI<1 D
107 . . S X=^MAG(2005,MAGIEN,3,MAGI,0) D ^DIWP
108 . D ^DIWW
109 . W !
110 Q
111RPT2DPT(RARPT,RET) ; For input RARPT, return string RET containing case
112 ; subscript values for accessing ^RADPT
113 ; Stole this code from john, don't tell him.
114 ; * This subroutine may be called by other routines of the Radiology
115 ; Imaging Workstation programs
116 ;
117 N DFN,DTI,CNI S (DFN,DTI,CNI)=""
118 I RARPT?1N.N,$D(^RARPT(RARPT)) S X=$G(^(RARPT,0)) I X]"" D
119 . S X=$P(X,U)
120 . S X=$O(^RADPT("ADC",X,0)) I X S DFN=X,DTI=$O(^(X,0)),CNI=$O(^(DTI,0))
121 . S RET=DFN_U_DTI_U_CNI
122 E S RET=""
123 Q
Note: See TracBrowser for help on using the repository browser.