MAGDSTA6 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Jul 06, 2021@08:04:39
;;3.0;IMAGING;**231,306**;MAR 19, 2002;Build 1;Feb 27, 2015
;; 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. |
;; +---------------------------------------------------------------+
;;
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #10103 reference $$FMTE^XLFDT function call
; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
;
Q
;
CONLKUP(DFN,COUNT,FIRSTDAY,LASTDAY,FIRSTIEN,LASTIEN) ;
N GMRCDATE,GMRCIEN,OK,REALDATE
S (COUNT,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN)=0
S GMRCDATE=$O(^GMR(123,"AD",DFN,""),1)
I GMRCDATE="" D Q
. W !!,"*** Patient does not have any consults or procedures on file. ***"
. D CONTINUE^MAGDSTQ(0)
. Q
;
; find completed consults for the designated services
S GMRCDATE=""
F S GMRCDATE=$O(^GMR(123,"AD",DFN,GMRCDATE),-1) Q:GMRCDATE="" D
. S GMRCIEN=""
. F S GMRCIEN=$O(^GMR(123,"AD",DFN,GMRCDATE,GMRCIEN)) Q:GMRCIEN="" D
. . S OK=$$CHECK(GMRCIEN)
. . I OK=1 D
. . . S COUNT=COUNT+1
. . . S REALDATE=$$GMRCDATE^MAGDSTA7(GMRCDATE)
. . . I FIRSTDAY=0 D ; first in chronological order
. . . . S FIRSTDAY=REALDATE
. . . . S FIRSTIEN=GMRCIEN
. . . . Q
. . . S LASTDAY=REALDATE ; last in chronological order
. . . S LASTIEN=GMRCIEN
. . Q
. Q
;
S FIRSTDAY=FIRSTDAY\1,LASTDAY=LASTDAY\1 ; want dates only, not times
;
I COUNT=0 D Q
. W !!,"*** Patient does not have any imaging consults or procedures on file. ***"
. D CONTINUE^MAGDSTQ(0)
. Q
E I COUNT>1 D
. W !!,"Patient has ",COUNT," imaging studies on file, from "
. W $$FMTE^XLFDT(FIRSTDAY,1)," to ",$$FMTE^XLFDT(LASTDAY,1)
. Q
E D
. W !!,"Patient has just one consult study in file for "
. W $$FMTE^XLFDT(FIRSTDAY,1)
. Q
Q
;
CHECK(GMRCIEN) ; check if this consult or procedure should have images
; 1) check for designated service
; 2) check complete status
; 3) check if it is defined for DICOM MWL
;
N CPRSSTATUS,MWL,TOSERVICE
;
; check if this is a selected service
S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
I TOSERVICE="" Q -1 ; no TOSERVICE
; check if it is for a designated service
I '$D(^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES",TOSERVICE)) Q -2 ; nope
;
; check if this is consult has been completed
S CPRSSTATUS=$$GET1^DIQ(123,GMRCIEN,8,"E")
I CPRSSTATUS'="COMPLETE",CPRSSTATUS'="PARTIAL RESULTS" Q -3 ; not completed
;
; check if this consult or procedure is supported for DICOM
S MWL=$$MWLFIND^MAGDHOW1(TOSERVICE,GMRCIEN)
I 'MWL Q -4 ; no file 2006.5831 entry for MWL
;
; otherwise, it's OK
Q 1
;
STUDY1 ; get the consult ien - called by MAGDSTA1
N STUDY1,X
S STUDY1=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
I STUDY1 D
. W !!,"Scanning will start with consult #",STUDY1,"."
. I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
. I X="YES" S STUDY1=+STUDY1 D STUDY1A
. Q
E D STUDY1A
Q
;
STUDY1A ; get new value
N BEGPTR ; first possible ^GMR(123) pointer value
N NEWPTR ; selected next possible ^GMR(123) pointer value
N ENDPTR ; last possible ^GMR(123) pointer value
N DATE ; consult date
N DEFAULT,OK,X,Z
;
S BEGPTR=$O(^GMR(123,0)) ; first ien
D STUDY1B(BEGPTR,.DATE)
W !!,"The first consult is #",BEGPTR," entered on ",DATE,"."
;
S ENDPTR=$O(^GMR(123," "),-1) ; last ien
D STUDY1B(ENDPTR,.DATE)
W !,"The last consult is #",ENDPTR," entered on ",DATE,"."
;
S OK=0 F D Q:OK
. S DEFAULT=$S(STUDY1:STUDY1,SORTORDER="ASCENDING":BEGPTR,SORTORDER="DESCENDING":ENDPTR)
. W !!,"Enter the new value of the consult #: ",DEFAULT,"// "
. R X:DTIME E S OK=-1 Q
. I X["^" S OK=-1 Q
. I X="" S X=DEFAULT W X
. I (X>ENDPTR)!(X<BEGPTR) D Q
. . W !!,"Please enter a number between ",BEGPTR," and ",ENDPTR,"."
. . Q
. S NEWPTR=X
. D STUDY1B(NEWPTR,.DATE)
. W !!,"Consult #",NEWPTR," entered on ",DATE,"."
. I $$YESNO^MAGDSTQ("Is this where to begin scanning?","n",.X)<0 S OK=-1 Q
. S:X="YES" OK=$S(NEWPTR=DEFAULT:2,1:1)
. Q
I OK<0 S QUIT=1 Q
I NEWPTR'=STUDY1 D
. S ^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN")=NEWPTR_" ("_DATE_")"
. W:OK=1 " -- changed"
. Q
Q
;
STUDY1B(GMRCIEN,DATE) ; get date from ^GMR(123,GMRCIEN,0)
S DATE=$$GET1^DIQ(123,GMRCIEN,.01,"E")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA6 5214 printed Sep 23, 2025@19:37:54 Page 2
MAGDSTA6 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Jul 06, 2021@08:04:39
+1 ;;3.0;IMAGING;**231,306**;MAR 19, 2002;Build 1;Feb 27, 2015
+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 ; Supported IA #2056 reference $$GET1^DIQ function call
+18 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+19 ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
+20 ;
+21 QUIT
+22 ;
CONLKUP(DFN,COUNT,FIRSTDAY,LASTDAY,FIRSTIEN,LASTIEN) ;
+1 NEW GMRCDATE,GMRCIEN,OK,REALDATE
+2 SET (COUNT,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN)=0
+3 SET GMRCDATE=$ORDER(^GMR(123,"AD",DFN,""),1)
+4 IF GMRCDATE=""
Begin DoDot:1
+5 WRITE !!,"*** Patient does not have any consults or procedures on file. ***"
+6 DO CONTINUE^MAGDSTQ(0)
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 ; find completed consults for the designated services
+10 SET GMRCDATE=""
+11 FOR
SET GMRCDATE=$ORDER(^GMR(123,"AD",DFN,GMRCDATE),-1)
if GMRCDATE=""
QUIT
Begin DoDot:1
+12 SET GMRCIEN=""
+13 FOR
SET GMRCIEN=$ORDER(^GMR(123,"AD",DFN,GMRCDATE,GMRCIEN))
if GMRCIEN=""
QUIT
Begin DoDot:2
+14 SET OK=$$CHECK(GMRCIEN)
+15 IF OK=1
Begin DoDot:3
+16 SET COUNT=COUNT+1
+17 SET REALDATE=$$GMRCDATE^MAGDSTA7(GMRCDATE)
+18 ; first in chronological order
IF FIRSTDAY=0
Begin DoDot:4
+19 SET FIRSTDAY=REALDATE
+20 SET FIRSTIEN=GMRCIEN
+21 QUIT
End DoDot:4
+22 ; last in chronological order
SET LASTDAY=REALDATE
+23 SET LASTIEN=GMRCIEN
End DoDot:3
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 ;
+27 ; want dates only, not times
SET FIRSTDAY=FIRSTDAY\1
SET LASTDAY=LASTDAY\1
+28 ;
+29 IF COUNT=0
Begin DoDot:1
+30 WRITE !!,"*** Patient does not have any imaging consults or procedures on file. ***"
+31 DO CONTINUE^MAGDSTQ(0)
+32 QUIT
End DoDot:1
QUIT
+33 IF '$TEST
IF COUNT>1
Begin DoDot:1
+34 WRITE !!,"Patient has ",COUNT," imaging studies on file, from "
+35 WRITE $$FMTE^XLFDT(FIRSTDAY,1)," to ",$$FMTE^XLFDT(LASTDAY,1)
+36 QUIT
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 WRITE !!,"Patient has just one consult study in file for "
+39 WRITE $$FMTE^XLFDT(FIRSTDAY,1)
+40 QUIT
End DoDot:1
+41 QUIT
+42 ;
CHECK(GMRCIEN) ; check if this consult or procedure should have images
+1 ; 1) check for designated service
+2 ; 2) check complete status
+3 ; 3) check if it is defined for DICOM MWL
+4 ;
+5 NEW CPRSSTATUS,MWL,TOSERVICE
+6 ;
+7 ; check if this is a selected service
+8 SET TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
+9 ; no TOSERVICE
IF TOSERVICE=""
QUIT -1
+10 ; check if it is for a designated service
+11 ; nope
IF '$DATA(^TMP("MAG",$JOB,"BATCH Q/R","CONSULT SERVICES",TOSERVICE))
QUIT -2
+12 ;
+13 ; check if this is consult has been completed
+14 SET CPRSSTATUS=$$GET1^DIQ(123,GMRCIEN,8,"E")
+15 ; not completed
IF CPRSSTATUS'="COMPLETE"
IF CPRSSTATUS'="PARTIAL RESULTS"
QUIT -3
+16 ;
+17 ; check if this consult or procedure is supported for DICOM
+18 SET MWL=$$MWLFIND^MAGDHOW1(TOSERVICE,GMRCIEN)
+19 ; no file 2006.5831 entry for MWL
IF 'MWL
QUIT -4
+20 ;
+21 ; otherwise, it's OK
+22 QUIT 1
+23 ;
STUDY1 ; get the consult ien - called by MAGDSTA1
+1 NEW STUDY1,X
+2 SET STUDY1=$GET(^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN"))
+3 IF STUDY1
Begin DoDot:1
+4 WRITE !!,"Scanning will start with consult #",STUDY1,"."
+5 IF $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0
SET QUIT=1
QUIT
+6 IF X="YES"
SET STUDY1=+STUDY1
DO STUDY1A
+7 QUIT
End DoDot:1
+8 IF '$TEST
DO STUDY1A
+9 QUIT
+10 ;
STUDY1A ; get new value
+1 ; first possible ^GMR(123) pointer value
NEW BEGPTR
+2 ; selected next possible ^GMR(123) pointer value
NEW NEWPTR
+3 ; last possible ^GMR(123) pointer value
NEW ENDPTR
+4 ; consult date
NEW DATE
+5 NEW DEFAULT,OK,X,Z
+6 ;
+7 ; first ien
SET BEGPTR=$ORDER(^GMR(123,0))
+8 DO STUDY1B(BEGPTR,.DATE)
+9 WRITE !!,"The first consult is #",BEGPTR," entered on ",DATE,"."
+10 ;
+11 ; last ien
SET ENDPTR=$ORDER(^GMR(123," "),-1)
+12 DO STUDY1B(ENDPTR,.DATE)
+13 WRITE !,"The last consult is #",ENDPTR," entered on ",DATE,"."
+14 ;
+15 SET OK=0
FOR
Begin DoDot:1
+16 SET DEFAULT=$SELECT(STUDY1:STUDY1,SORTORDER="ASCENDING":BEGPTR,SORTORDER="DESCENDING":ENDPTR)
+17 WRITE !!,"Enter the new value of the consult #: ",DEFAULT,"// "
+18 READ X:DTIME
IF '$TEST
SET OK=-1
QUIT
+19 IF X["^"
SET OK=-1
QUIT
+20 IF X=""
SET X=DEFAULT
WRITE X
+21 IF (X>ENDPTR)!(X<BEGPTR)
Begin DoDot:2
+22 WRITE !!,"Please enter a number between ",BEGPTR," and ",ENDPTR,"."
+23 QUIT
End DoDot:2
QUIT
+24 SET NEWPTR=X
+25 DO STUDY1B(NEWPTR,.DATE)
+26 WRITE !!,"Consult #",NEWPTR," entered on ",DATE,"."
+27 IF $$YESNO^MAGDSTQ("Is this where to begin scanning?","n",.X)<0
SET OK=-1
QUIT
+28 if X="YES"
SET OK=$SELECT(NEWPTR=DEFAULT:2,1:1)
+29 QUIT
End DoDot:1
if OK
QUIT
+30 IF OK<0
SET QUIT=1
QUIT
+31 IF NEWPTR'=STUDY1
Begin DoDot:1
+32 SET ^TMP("MAG",$JOB,"BATCH Q/R","REPORT/STUDY IEN")=NEWPTR_" ("_DATE_")"
+33 if OK=1
WRITE " -- changed"
+34 QUIT
End DoDot:1
+35 QUIT
+36 ;
STUDY1B(GMRCIEN,DATE) ; get date from ^GMR(123,GMRCIEN,0)
+1 SET DATE=$$GET1^DIQ(123,GMRCIEN,.01,"E")
+2 QUIT
