MAGGTRA1 ;WOIFO/GEK,DAC - RPC Call to list Patient's Rad/Nuc Exams, Reports ; 05 August 2019 7:45AM
;;3.0;IMAGING;**234,225**;Mar 01, 2002;Build 5
;; +---------------------------------------------------------------+
;; | 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) ; RPC Call MAGGRADLIST
;MAGRY - the return array of patient's exams.
;DATA - DFN ^ begining date ^ end date ^ number to return
; (only DFN is being sent for now. later we'll enable date
; ranges and/or counts )
;
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
;
N X,Y,Z,I,J,K,MAGNAME,MAGDFN,MAGCNT,MAGBDT,MAGEDT,MAGEXN
S MAGDFN=+DATA
S MAGNAME=$P($G(^DPT(MAGDFN,0)),U)
I MAGNAME="" S MAGRY(0)="0^INVALID Patient ID" Q
; We have to account for old Wrkstation code that was returning a
; 1 as second piece.
I $P(DATA,U,2)=1 S $P(DATA,U,2)=""
; Set default Begin,End dates and number to return
S MAGBDT=$S($P(DATA,U,2):$P(DATA,U,2),1:"1070101")
S MAGEDT=$S($P(DATA,U,3):$P(DATA,U,3),1:$$DT^XLFDT)
S MAGEXN=$S($P(DATA,U,4):$P(DATA,U,4),1:200)
S MAGRY(0)="0^Compiling list of Radiology Exams..."
;
D EN1^RAO7PC1(MAGDFN,MAGBDT,MAGEDT,MAGEXN)
I '$D(^TMP($J,"RAE1")) S MAGRY(0)="0^No Radiology Exams for "_MAGNAME Q
;
; we'll return MAGRY(0) = return count^message
; MAGRY(1)=column heading^column heading^column h.....
; MAGRY(2..n)=info from exam.
D CONVERT
S MAGRY(0)=MAGCNT-1_"^Radiology Exams: "_MAGNAME
S MAGRY(1)="#^Day-Case^Procedure^Exam Date^Exam status / Report status^Imaging Loc"
Q
CONVERT ; Convert the ^TMP($J,"RAE1",MAGDFN to our output array.
N XRPT
S MAGCNT=1
S I=0 F S I=$O(^TMP($J,"RAE1",MAGDFN,I)) Q:'I D
. N SITE,SITEACN,I2,SITEIEN ; P234/P225 - DAC
. S MAGCNT=MAGCNT+1
. S J=^TMP($J,"RAE1",MAGDFN,I) ; Changed to full reference /gek
. S X=9999999.9999-$P(I,"-"),X=$E(X,4,7)_$E(X,2,3)
. S I2=$P(I,"-")
. ; P234 DAC - Add site when there is a long accession number
. ; P225 DAC - Modified to pull data from next node if node(S) are deleted
. S SITEIEN=$O(^RADPT(MAGDFN,"DT",I2,"P",0)) ; ICR #1172 (Private)
. I SITEIEN S SITE="",SITEACN=$P(^RADPT(MAGDFN,"DT",I2,"P",SITEIEN,0),U,31) ; ICR #1172 (Private)
. I SITEACN S SITE=$P(SITEACN,"-",1)_"-"
. ;
. ; Y2K not needed on day-case - Rad uses as string variable.
. ; 1 # 2 day-case 3 desc
. ; P234 DAC - Add site when there is a long accession number
. S Z=MAGCNT-1_U_SITE_X_"-"_$P(J,"^",2)_U_$P(J,U)_U
. S X=9999999.9999-$P(I,"-")
. ; 4 date
. S Z=Z_$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))_U
. ; 5 EXAM status / Report status
. S Z=Z_$P($P(J,U,6),"~",2)_" / "_$P(J,U,3)_U
. S K=$$FMTE^XLFDT(X,"1P")
. ; 6 image loc 7 dfn 8 invrs dt 9 case # 10 11 12 output date
. S Z=Z_$P(J,U,7)_U_MAGDFN_U_$P(I,"-")_U_$P(I,"-",2)_U_U_U_K_U
. ; 13 intdt 14 RACN 16 rarpt
. S Z=Z_X_U_$P(J,U,2)_U_U_$P(J,U,5)_U_U
. S XRPT=$P(J,U,5) I XRPT I $P($G(^RARPT(XRPT,0)),U,2)'=MAGDFN D
. . S $P(Z,U,16)=XRPT_"PMRAD"
. . S $P(Z,U,5)="Patient Mismatch. Radiology Files"
. ; If this report has images, we'll display "(I)"
. I $O(^RARPT(+$P(J,U,5),2005,0)) S $P(Z,U,5)=$P(Z,U,5)_" (I)"
. ;
. S MAGRY(MAGCNT)=Z
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTRA1 4242 printed Apr 09, 2024@21:02:41 Page 2
MAGGTRA1 ;WOIFO/GEK,DAC - RPC Call to list Patient's Rad/Nuc Exams, Reports ; 05 August 2019 7:45AM
+1 ;;3.0;IMAGING;**234,225**;Mar 01, 2002;Build 5
+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
LIST(MAGRY,DATA) ; RPC Call MAGGRADLIST
+1 ;MAGRY - the return array of patient's exams.
+2 ;DATA - DFN ^ begining date ^ end date ^ number to return
+3 ; (only DFN is being sent for now. later we'll enable date
+4 ; ranges and/or counts )
+5 ;
+6 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+7 IF '$TEST
SET X="ERRA^MAGGTERR"
SET @^%ZOSF("TRAP")
+8 ;
+9 NEW X,Y,Z,I,J,K,MAGNAME,MAGDFN,MAGCNT,MAGBDT,MAGEDT,MAGEXN
+10 SET MAGDFN=+DATA
+11 SET MAGNAME=$PIECE($GET(^DPT(MAGDFN,0)),U)
+12 IF MAGNAME=""
SET MAGRY(0)="0^INVALID Patient ID"
QUIT
+13 ; We have to account for old Wrkstation code that was returning a
+14 ; 1 as second piece.
+15 IF $PIECE(DATA,U,2)=1
SET $PIECE(DATA,U,2)=""
+16 ; Set default Begin,End dates and number to return
+17 SET MAGBDT=$SELECT($PIECE(DATA,U,2):$PIECE(DATA,U,2),1:"1070101")
+18 SET MAGEDT=$SELECT($PIECE(DATA,U,3):$PIECE(DATA,U,3),1:$$DT^XLFDT)
+19 SET MAGEXN=$SELECT($PIECE(DATA,U,4):$PIECE(DATA,U,4),1:200)
+20 SET MAGRY(0)="0^Compiling list of Radiology Exams..."
+21 ;
+22 DO EN1^RAO7PC1(MAGDFN,MAGBDT,MAGEDT,MAGEXN)
+23 IF '$DATA(^TMP($JOB,"RAE1"))
SET MAGRY(0)="0^No Radiology Exams for "_MAGNAME
QUIT
+24 ;
+25 ; we'll return MAGRY(0) = return count^message
+26 ; MAGRY(1)=column heading^column heading^column h.....
+27 ; MAGRY(2..n)=info from exam.
+28 DO CONVERT
+29 SET MAGRY(0)=MAGCNT-1_"^Radiology Exams: "_MAGNAME
+30 SET MAGRY(1)="#^Day-Case^Procedure^Exam Date^Exam status / Report status^Imaging Loc"
+31 QUIT
CONVERT ; Convert the ^TMP($J,"RAE1",MAGDFN to our output array.
+1 NEW XRPT
+2 SET MAGCNT=1
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"RAE1",MAGDFN,I))
if 'I
QUIT
Begin DoDot:1
+4 ; P234/P225 - DAC
NEW SITE,SITEACN,I2,SITEIEN
+5 SET MAGCNT=MAGCNT+1
+6 ; Changed to full reference /gek
SET J=^TMP($JOB,"RAE1",MAGDFN,I)
+7 SET X=9999999.9999-$PIECE(I,"-")
SET X=$EXTRACT(X,4,7)_$EXTRACT(X,2,3)
+8 SET I2=$PIECE(I,"-")
+9 ; P234 DAC - Add site when there is a long accession number
+10 ; P225 DAC - Modified to pull data from next node if node(S) are deleted
+11 ; ICR #1172 (Private)
SET SITEIEN=$ORDER(^RADPT(MAGDFN,"DT",I2,"P",0))
+12 ; ICR #1172 (Private)
IF SITEIEN
SET SITE=""
SET SITEACN=$PIECE(^RADPT(MAGDFN,"DT",I2,"P",SITEIEN,0),U,31)
+13 IF SITEACN
SET SITE=$PIECE(SITEACN,"-",1)_"-"
+14 ;
+15 ; Y2K not needed on day-case - Rad uses as string variable.
+16 ; 1 # 2 day-case 3 desc
+17 ; P234 DAC - Add site when there is a long accession number
+18 SET Z=MAGCNT-1_U_SITE_X_"-"_$PIECE(J,"^",2)_U_$PIECE(J,U)_U
+19 SET X=9999999.9999-$PIECE(I,"-")
+20 ; 4 date
+21 SET Z=Z_$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_(1700+$EXTRACT(X,1,3))_U
+22 ; 5 EXAM status / Report status
+23 SET Z=Z_$PIECE($PIECE(J,U,6),"~",2)_" / "_$PIECE(J,U,3)_U
+24 SET K=$$FMTE^XLFDT(X,"1P")
+25 ; 6 image loc 7 dfn 8 invrs dt 9 case # 10 11 12 output date
+26 SET Z=Z_$PIECE(J,U,7)_U_MAGDFN_U_$PIECE(I,"-")_U_$PIECE(I,"-",2)_U_U_U_K_U
+27 ; 13 intdt 14 RACN 16 rarpt
+28 SET Z=Z_X_U_$PIECE(J,U,2)_U_U_$PIECE(J,U,5)_U_U
+29 SET XRPT=$PIECE(J,U,5)
IF XRPT
IF $PIECE($GET(^RARPT(XRPT,0)),U,2)'=MAGDFN
Begin DoDot:2
+30 SET $PIECE(Z,U,16)=XRPT_"PMRAD"
+31 SET $PIECE(Z,U,5)="Patient Mismatch. Radiology Files"
End DoDot:2
+32 ; If this report has images, we'll display "(I)"
+33 IF $ORDER(^RARPT(+$PIECE(J,U,5),2005,0))
SET $PIECE(Z,U,5)=$PIECE(Z,U,5)_" (I)"
+34 ;
+35 SET MAGRY(MAGCNT)=Z
End DoDot:1
+36 QUIT
