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