MAGGTRA ;WOIFO/GEK - RPC Call to list Patient's Rad/Nuc Exams, Reports ; [ 06/20/2001 08:57 ]
;;3.0;IMAGING;**59,117**;Mar 19, 2002;Build 2238;Jul 15, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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
LIST(MAGRY,DATA) ;
; SOME OLD IMAGING EXECUTABLES (IMGVWP10) STILL CALL HERE
; THIS HAS BEEN SWITCHED TO LIST^MAGGTRA1
;
;MAGRY - return array of patient's exams.
;DATA - RADFN - Radiology Patient's DFN ^RADPT(
;
D LIST^MAGGTRA1(.MAGRY,.DATA)
Q
MAGPTR(MAGRY,XDUZ,MAGIEN,DATA) ;RPC Call to file Image pointer into Radiology
; File and Radiology pointer into Image File.
;
; MAGRY is the return string = 1^success if things work okay.
; 0^message if things not okay.
; DATA is The data that was sent in LIST^MAGGTRA
; it is the display data _ to ^TMP($J,"RAEX",RACNT
; the ^TMP is setup by RAPTLU, (and MAGGTRA) in the lookup
; of patient exams, we keep it, and send it back in case
; we need to create a new report.
;
; XDUZ is not used from parameter list anymore.
; MAGIEN is Image File IEN ^MAG(2005,IEN
;
N Y,I,CT,MAGERR,DIQUIET
N RADFN,RADTI,RACNI,RANME,RASSN,RADATE,RADTE,RACN,RAPRC,RARPT,RAST,MAGGP
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"
E S X="ERR^MAGGTERR",@^%ZOSF("TRAP")
S DIQUIET=1,MAGERR=0,CT=0
D DT^DICRW
; The list entry selected has the following data associated with it
; it was created using parts of RAPTLU routine to list rad exams
;^TMP($J,"RAEX",RACNT)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
;
S DATA=$P(DATA,"^",7,99)
F I="RADFN","RADTI","RACNI","RANME","RASSN","RADATE","RADTE","RACN","RAPRC","RARPT","RAST" S CT=CT+1,@I=$P(DATA,"^",CT)
;
; let us check a few things first
; Do we have a valid IMAGE IEN ^MAG(2005,
I '$D(^MAG(2005,MAGIEN,0)) S MAGRY="0^OPERATION CANCEDED: INVALID Imaging (2005) entry" Q
; Does this Imaging entry already point to a Report.
I $D(^MAG(2005,MAGIEN,2)) S Z=^(2) D
. F I=6,7,8 S X=$P(Z,U,I) I $L(X) S MAGERR=1 Q
I MAGERR S MAGRY="0^OPERATION CANCELED: Imaging File entry already has an associated Report" Q
; Does the Imaging entry patient, match the Rad Exam entry patient
I $P(^MAG(2005,MAGIEN,0),U,7)'=RADFN S MAGRY="0^OPERATION CANCELED: Imaging Patient doesn't match Radiology Patient" Q
I RARPT,'$D(^RARPT(RARPT,0)) S MAGRY="0^OPERATION CANCELED: INVALID Radiology Report Number" Q
; pre 117 only accounted for RARPT="" ...CREATE^RARIC I '$G(RARPT) S MAGRY=...
; patch 117 account for a possible negative RARPT after call to CREATE. Radiology routine changed
I '$G(RARPT) D CREATE^RARIC I +$G(RARPT)<1 S MAGRY="0^OPERATION FAILED creating new Radiology Report entry" Q
; Now lets file the Image pointer in the ^RARPT( file.
S MAGGP=MAGIEN
D PTR^RARIC
I Y<1 S MAGRY="0^OPERATION FAILED Creating Image pointer in Report File" Q
; Now SET the Parent fields in the Image File
S $P(^MAG(2005,MAGIEN,2),U,6,8)=74_U_RARPT_U_+Y
; DONE.
S MAGRY="1^Image pointer filed successfully"
D LINKDT^MAGGTU6(.X,MAGIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTRA 4116 printed Nov 22, 2024@17:13:17 Page 2
MAGGTRA ;WOIFO/GEK - RPC Call to list Patient's Rad/Nuc Exams, Reports ; [ 06/20/2001 08:57 ]
+1 ;;3.0;IMAGING;**59,117**;Mar 19, 2002;Build 2238;Jul 15, 2011
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | 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
LIST(MAGRY,DATA) ;
+1 ; SOME OLD IMAGING EXECUTABLES (IMGVWP10) STILL CALL HERE
+2 ; THIS HAS BEEN SWITCHED TO LIST^MAGGTRA1
+3 ;
+4 ;MAGRY - return array of patient's exams.
+5 ;DATA - RADFN - Radiology Patient's DFN ^RADPT(
+6 ;
+7 DO LIST^MAGGTRA1(.MAGRY,.DATA)
+8 QUIT
MAGPTR(MAGRY,XDUZ,MAGIEN,DATA) ;RPC Call to file Image pointer into Radiology
+1 ; File and Radiology pointer into Image File.
+2 ;
+3 ; MAGRY is the return string = 1^success if things work okay.
+4 ; 0^message if things not okay.
+5 ; DATA is The data that was sent in LIST^MAGGTRA
+6 ; it is the display data _ to ^TMP($J,"RAEX",RACNT
+7 ; the ^TMP is setup by RAPTLU, (and MAGGTRA) in the lookup
+8 ; of patient exams, we keep it, and send it back in case
+9 ; we need to create a new report.
+10 ;
+11 ; XDUZ is not used from parameter list anymore.
+12 ; MAGIEN is Image File IEN ^MAG(2005,IEN
+13 ;
+14 NEW Y,I,CT,MAGERR,DIQUIET
+15 NEW RADFN,RADTI,RACNI,RANME,RASSN,RADATE,RADTE,RACN,RAPRC,RARPT,RAST,MAGGP
+16 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGGTERR"
+17 IF '$TEST
SET X="ERR^MAGGTERR"
SET @^%ZOSF("TRAP")
+18 SET DIQUIET=1
SET MAGERR=0
SET CT=0
+19 DO DT^DICRW
+20 ; The list entry selected has the following data associated with it
+21 ; it was created using parts of RAPTLU routine to list rad exams
+22 ;^TMP($J,"RAEX",RACNT)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
+23 ;
+24 SET DATA=$PIECE(DATA,"^",7,99)
+25 FOR I="RADFN","RADTI","RACNI","RANME","RASSN","RADATE","RADTE","RACN","RAPRC","RARPT","RAST"
SET CT=CT+1
SET @I=$PIECE(DATA,"^",CT)
+26 ;
+27 ; let us check a few things first
+28 ; Do we have a valid IMAGE IEN ^MAG(2005,
+29 IF '$DATA(^MAG(2005,MAGIEN,0))
SET MAGRY="0^OPERATION CANCEDED: INVALID Imaging (2005) entry"
QUIT
+30 ; Does this Imaging entry already point to a Report.
+31 IF $DATA(^MAG(2005,MAGIEN,2))
SET Z=^(2)
Begin DoDot:1
+32 FOR I=6,7,8
SET X=$PIECE(Z,U,I)
IF $LENGTH(X)
SET MAGERR=1
QUIT
End DoDot:1
+33 IF MAGERR
SET MAGRY="0^OPERATION CANCELED: Imaging File entry already has an associated Report"
QUIT
+34 ; Does the Imaging entry patient, match the Rad Exam entry patient
+35 IF $PIECE(^MAG(2005,MAGIEN,0),U,7)'=RADFN
SET MAGRY="0^OPERATION CANCELED: Imaging Patient doesn't match Radiology Patient"
QUIT
+36 IF RARPT
IF '$DATA(^RARPT(RARPT,0))
SET MAGRY="0^OPERATION CANCELED: INVALID Radiology Report Number"
QUIT
+37 ; pre 117 only accounted for RARPT="" ...CREATE^RARIC I '$G(RARPT) S MAGRY=...
+38 ; patch 117 account for a possible negative RARPT after call to CREATE. Radiology routine changed
+39 IF '$GET(RARPT)
DO CREATE^RARIC
IF +$GET(RARPT)<1
SET MAGRY="0^OPERATION FAILED creating new Radiology Report entry"
QUIT
+40 ; Now lets file the Image pointer in the ^RARPT( file.
+41 SET MAGGP=MAGIEN
+42 DO PTR^RARIC
+43 IF Y<1
SET MAGRY="0^OPERATION FAILED Creating Image pointer in Report File"
QUIT
+44 ; Now SET the Parent fields in the Image File
+45 SET $PIECE(^MAG(2005,MAGIEN,2),U,6,8)=74_U_RARPT_U_+Y
+46 ; DONE.
+47 SET MAGRY="1^Image pointer filed successfully"
+48 DO LINKDT^MAGGTU6(.X,MAGIEN)
+49 QUIT
