Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDSTA6

MAGDSTA6.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ; Supported IA #2056 reference $$GET1^DIQ function call
  1.  ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1.  ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
  1.  ;
  1.  Q
  1.  ;
  1. CONLKUP(DFN,COUNT,FIRSTDAY,LASTDAY,FIRSTIEN,LASTIEN) ;
  1.  N GMRCDATE,GMRCIEN,OK,REALDATE
  1.  S (COUNT,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN)=0
  1.  S GMRCDATE=$O(^GMR(123,"AD",DFN,""),1)
  1.  I GMRCDATE="" D  Q
  1.  . W !!,"*** Patient does not have any consults or procedures on file. ***"
  1.  . D CONTINUE^MAGDSTQ(0)
  1.  . Q
  1.  ;
  1.  ; find completed consults for the designated services
  1.  S GMRCDATE=""
  1.  F  S GMRCDATE=$O(^GMR(123,"AD",DFN,GMRCDATE),-1) Q:GMRCDATE=""  D
  1.  . S GMRCIEN=""
  1.  . F  S GMRCIEN=$O(^GMR(123,"AD",DFN,GMRCDATE,GMRCIEN)) Q:GMRCIEN=""  D
  1.  . . S OK=$$CHECK(GMRCIEN)
  1.  . . I OK=1 D
  1.  . . . S COUNT=COUNT+1
  1.  . . . S REALDATE=$$GMRCDATE^MAGDSTA7(GMRCDATE)
  1.  . . . I FIRSTDAY=0 D  ; first in chronological order
  1.  . . . . S FIRSTDAY=REALDATE
  1.  . . . . S FIRSTIEN=GMRCIEN
  1.  . . . . Q
  1.  . . . S LASTDAY=REALDATE ; last in chronological order
  1.  . . . S LASTIEN=GMRCIEN
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S FIRSTDAY=FIRSTDAY\1,LASTDAY=LASTDAY\1 ; want dates only, not times
  1.  ;
  1.  I COUNT=0 D  Q
  1.  . W !!,"*** Patient does not have any imaging consults or procedures on file. ***"
  1.  . D CONTINUE^MAGDSTQ(0)
  1.  . Q
  1.  E  I COUNT>1 D
  1.  . W !!,"Patient has ",COUNT," imaging studies on file, from "
  1.  . W $$FMTE^XLFDT(FIRSTDAY,1)," to ",$$FMTE^XLFDT(LASTDAY,1)
  1.  . Q
  1.  E  D
  1.  . W !!,"Patient has just one consult study in file for "
  1.  . W $$FMTE^XLFDT(FIRSTDAY,1)
  1.  . Q
  1.  Q
  1.  ;
  1. CHECK(GMRCIEN) ; check if this consult or procedure should have images
  1.  ; 1) check for designated service
  1.  ; 2) check complete status
  1.  ; 3) check if it is defined for DICOM MWL
  1.  ; 
  1.  N CPRSSTATUS,MWL,TOSERVICE
  1.  ;
  1.  ; check if this is a selected service
  1.  S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
  1.  I TOSERVICE="" Q -1 ; no TOSERVICE
  1.  ; check if it is for a designated service
  1.  I '$D(^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES",TOSERVICE)) Q -2 ; nope
  1.  ;
  1.  ; check if this is consult has been completed
  1.  S CPRSSTATUS=$$GET1^DIQ(123,GMRCIEN,8,"E")
  1.  I CPRSSTATUS'="COMPLETE",CPRSSTATUS'="PARTIAL RESULTS" Q -3 ; not completed
  1.  ;
  1.  ; check if this consult or procedure is supported for DICOM
  1.  S MWL=$$MWLFIND^MAGDHOW1(TOSERVICE,GMRCIEN)
  1.  I 'MWL Q -4 ; no file 2006.5831 entry for MWL
  1.  ;
  1.  ; otherwise, it's OK
  1.  Q 1
  1.  ;
  1. STUDY1 ; get the consult ien - called by MAGDSTA1
  1.  N STUDY1,X
  1.  S STUDY1=$G(^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN"))
  1.  I STUDY1 D
  1.  . W !!,"Scanning will start with consult #",STUDY1,"."
  1.  . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
  1.  . I X="YES" S STUDY1=+STUDY1 D STUDY1A
  1.  . Q
  1.  E  D STUDY1A
  1.  Q
  1.  ;
  1. STUDY1A ; get new value
  1.  N BEGPTR ; first possible ^GMR(123) pointer value
  1.  N NEWPTR ; selected next possible ^GMR(123) pointer value
  1.  N ENDPTR ; last possible ^GMR(123) pointer value
  1.  N DATE ; consult date
  1.  N DEFAULT,OK,X,Z
  1.  ;
  1.  S BEGPTR=$O(^GMR(123,0)) ; first ien
  1.  D STUDY1B(BEGPTR,.DATE)
  1.  W !!,"The first consult is #",BEGPTR," entered on ",DATE,"."
  1.  ;
  1.  S ENDPTR=$O(^GMR(123," "),-1) ; last ien
  1.  D STUDY1B(ENDPTR,.DATE)
  1.  W !,"The last consult is #",ENDPTR," entered on ",DATE,"."
  1.  ;
  1.  S OK=0 F  D  Q:OK
  1.  . S DEFAULT=$S(STUDY1:STUDY1,SORTORDER="ASCENDING":BEGPTR,SORTORDER="DESCENDING":ENDPTR)
  1.  . W !!,"Enter the new value of the consult #: ",DEFAULT,"// "
  1.  . R X:DTIME E  S OK=-1 Q
  1.  . I X["^" S OK=-1 Q
  1.  . I X="" S X=DEFAULT W X
  1.  . I (X>ENDPTR)!(X<BEGPTR) D  Q
  1.  . . W !!,"Please enter a number between ",BEGPTR," and ",ENDPTR,"."
  1.  . . Q
  1.  . S NEWPTR=X
  1.  . D STUDY1B(NEWPTR,.DATE)
  1.  . W !!,"Consult #",NEWPTR," entered on ",DATE,"."
  1.  . I $$YESNO^MAGDSTQ("Is this where to begin scanning?","n",.X)<0 S OK=-1 Q
  1.  . S:X="YES" OK=$S(NEWPTR=DEFAULT:2,1:1)
  1.  . Q
  1.  I OK<0 S QUIT=1 Q
  1.  I NEWPTR'=STUDY1 D
  1.  . S ^TMP("MAG",$J,"BATCH Q/R","REPORT/STUDY IEN")=NEWPTR_" ("_DATE_")"
  1.  . W:OK=1 " -- changed"
  1.  . Q
  1.  Q
  1.  ;
  1. STUDY1B(GMRCIEN,DATE) ; get date from ^GMR(123,GMRCIEN,0)
  1.  S DATE=$$GET1^DIQ(123,GMRCIEN,.01,"E")
  1.  Q