MAGGTRA1.m

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 ---MAGGTRA1   4242     printed  Mar 13, 2025@21:08:05                                                                                                                                                                                                    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