124 lines
4.7 KiB
Mathematica
124 lines
4.7 KiB
Mathematica
MAGGTRP1 ;WOIFO/GEK - Display Associated Report ; [ 11/08/2001 17:18 ]
|
|
;;3.0;IMAGING;**8**;Sep 15, 2004
|
|
;; +---------------------------------------------------------------+
|
|
;; | Property of the US Government. |
|
|
;; | No permission to copy or redistribute this software is given. |
|
|
;; | Use of unreleased versions of this software requires the user |
|
|
;; | to execute a written test agreement with the VistA Imaging |
|
|
;; | Development Office of the Department of Veterans Affairs, |
|
|
;; | telephone (301) 734-0100. |
|
|
;; | |
|
|
;; | The Food and Drug Administration classifies this software as |
|
|
;; | a medical device. As such, it may not be changed in any way. |
|
|
;; | Modifications to this software may result in an adulterated |
|
|
;; | medical device under 21CFR820, the use of which is considered |
|
|
;; | to be a violation of US Federal Statutes. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
Q
|
|
RAD(MAGRPTY,RARPT) ;RPC [MAGGRADREPORT] Call to retrun a Radiology report
|
|
; MAGRPTY is the return array
|
|
; RARPT is the Radiology Report IEN i.e. ^RARPT(RARPT
|
|
N ERRRES,RPTRES
|
|
S ERRRES=""
|
|
D OPENDEV Q:POP
|
|
D BUILD(RARPT)
|
|
S RPTRES=$G(@MAGRPTY@(0))
|
|
I 'RPTRES S ERRRES=RPTRES
|
|
I +RPTRES=-2 S ERRRES=RPTRES
|
|
D:IO'=IO(0) ^%ZISC
|
|
I $L(ERRRES) K @MAGRPTY S @MAGRPTY@(0)=ERRRES
|
|
; Mod Patch5 block Questionable reports
|
|
; stop incorrectly report success on a failed report attempt. this line is
|
|
; moved inside BUILD tag
|
|
;S @MAGRPTY@(0)="1^OK"
|
|
Q
|
|
BUILD(RARPT) ;Call to generate the Radiology Report
|
|
; This call is called be various Imaging routines to get the Rad Report
|
|
; This call assumes the device is already open.
|
|
; New the variables that'll be defined in the call to RASET^RAUTL2
|
|
N RACN,RACNI,RADATE,RADFN,RADTE,RADTI
|
|
; We'll use these
|
|
; RADTI = Inverse date/time for rad order
|
|
; RACNI = rad case number
|
|
; RADFN = Patient DFN
|
|
N I,Y,X,MAGPRC,XINF
|
|
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTRP1"
|
|
E S X="ERRA^MAGGTPR1",@^%ZOSF("TRAP")
|
|
I RARPT["PMRAD" S @MAGRPTY@(0)="-2^Patient Mismatch. Radiology Files" Q
|
|
I '$G(RARPT) S @MAGRPTY@(0)="0^NO Radiology Report number." Q
|
|
;
|
|
I '$$FIND1^DIC(74,"","A",+RARPT) S @MAGRPTY@(0)="0^Radiology report entry "_RARPT_" is not on file. Contact IRM." Q
|
|
;
|
|
S Y=RARPT
|
|
; This call will define the needed variables RADTI,RACNI and RADFN
|
|
D RASET^RAUTL2
|
|
;D RPT2DPT(RARPT,.XINF)
|
|
;S ^TMP("MAGQIRP1",$J,"XINF")=XINF
|
|
;I +XINF'=RADFN S @MAGRPTY@(0)="0^Patient Mismatch. Radiology Files" Q
|
|
S ^TMP("MAGQIRP1",$J)="RADFN "_RADFN_" RADTI "_RADTI_" RACNI "_RACNI
|
|
S ^TMP("MAGQIRP1",$J,1)="RARPT "_RARPT_" ,0)="_$G(^RARPT(RARPT,0))
|
|
D EN3^RAO7PC3(RADFN_"^"_RADTI_"^"_RACNI)
|
|
I '$D(^TMP($J,"RAE3")) D Q
|
|
. S @MAGRPTY@(0)="0^Radiology report not on file. Contact IRM." Q
|
|
S MAGPRC=$O(^TMP($J,"RAE3",RADFN,RACNI,""))
|
|
S I=0 F S I=$O(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I)) Q:'I D
|
|
. W !,$G(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I))
|
|
; 2.5P5 This line was moved from above. So this BUILD function
|
|
; should now correctly return success or failure.
|
|
S @MAGRPTY@(0)="1^OK"
|
|
Q
|
|
OPENDEV ;
|
|
S MAGRPTY=$NA(^TMP($J,"WSDAT"))
|
|
K @MAGRPTY ; clean it up first.
|
|
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
|
|
I POP S @MAGRPTY@(0)="0^Can't open device IMAGING WORKSTATION" Q
|
|
U IO
|
|
Q
|
|
ERRA ;
|
|
S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
|
|
D @^%ZOSF("ERRTN")
|
|
Q
|
|
GRPDESC(MAGIEN) ; PRINT LONG DESC OF IMAGE GROUP and ALL children in Group
|
|
;DEVICE HAS ALREADY BEEN OPENED
|
|
N MAGCIEN,MAGJ,MAGDASH
|
|
S $P(MAGDASH,"_",79)="_"
|
|
K ^UTILITY($J,"W")
|
|
D GETDESC(MAGIEN)
|
|
S MAGCIEN=0
|
|
F S MAGCIEN=$O(^MAG(2005,MAGIEN,1,MAGCIEN)) Q:'MAGCIEN D
|
|
. S MAGJ=^MAG(2005,MAGIEN,1,MAGCIEN,0)
|
|
. I '$D(^MAG(2005,+MAGJ,3)) Q
|
|
. D GETDESC(MAGJ)
|
|
W MAGDASH
|
|
Q
|
|
GETDESC(MAGIEN) ;
|
|
;
|
|
N X,MAGI,DIWR,DIWL,DIWF,MAGHD
|
|
I $O(^MAG(2005,MAGIEN,1,0)) S MAGHD="Group"
|
|
E S MAGHD="Image"
|
|
W MAGHD_" ID# "_MAGIEN,!
|
|
I $O(^MAG(2005,MAGIEN,3,0)) D
|
|
. S DIWR=80,DIWL=1,DIWF="N"
|
|
. W MAGHD_" : "_$P(^MAG(2005,MAGIEN,2),U,4),!
|
|
. W MAGHD_" Long Description: ",!
|
|
. S MAGI=0
|
|
. F S MAGI=$O(^MAG(2005,MAGIEN,3,MAGI)) Q:+MAGI<1 D
|
|
. . S X=^MAG(2005,MAGIEN,3,MAGI,0) D ^DIWP
|
|
. D ^DIWW
|
|
. W !
|
|
Q
|
|
RPT2DPT(RARPT,RET) ; For input RARPT, return string RET containing case
|
|
; subscript values for accessing ^RADPT
|
|
; Stole this code from john, don't tell him.
|
|
; * This subroutine may be called by other routines of the Radiology
|
|
; Imaging Workstation programs
|
|
;
|
|
N DFN,DTI,CNI S (DFN,DTI,CNI)=""
|
|
I RARPT?1N.N,$D(^RARPT(RARPT)) S X=$G(^(RARPT,0)) I X]"" D
|
|
. S X=$P(X,U)
|
|
. S X=$O(^RADPT("ADC",X,0)) I X S DFN=X,DTI=$O(^(X,0)),CNI=$O(^(DTI,0))
|
|
. S RET=DFN_U_DTI_U_CNI
|
|
E S RET=""
|
|
Q
|