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

MAGDSTA2.m

Go to the documentation of this file. 
  1. MAGDSTA2 ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Aug 19, 2020@16:04:13
  1.  ;;3.0;IMAGING;**231**;MAR 19, 2002;Build 9;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.  ;
  1.  ; Supported IA #10003 reference ^%DT subroutine call
  1.  ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1.  ; Supported IA #10000 reference NOW^%DTC subroutine call
  1.  ;
  1.  Q
  1.  ;
  1. QRSCP ; get the PACS DICOM Q/R SCP for the retrieve
  1.  N DEFAULT,TITLE,X
  1.  ;
  1.  I IMAGINGSERVICE="RADIOLOGY" D
  1.  . S TITLE="Radiology PACS"
  1.  . Q
  1.  E  D
  1.  . S TITLE="Default Consult"
  1.  . Q
  1.  ;
  1.  K ^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP") ; first remove the old value
  1.  ;
  1.  ; now get the new value
  1.  S DEFAULT=$G(^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION"))
  1.  I $L(DEFAULT) D
  1.  . W !!,"The ",TITLE," Query/Retrieve Provider is """,DEFAULT,"""."
  1.  . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 Q
  1.  . I X="YES" D
  1.  . . D QRSCP1
  1.  . . Q
  1.  . E  D
  1.  . . S ^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP")=DEFAULT
  1.  . . Q
  1.  . Q
  1.  E  D QRSCP1
  1.  Q
  1.  ;
  1. QRSCP1 ; get new value
  1.  N OK,QRSCP
  1.  S OK=0 F  D  Q:OK
  1.  . W !!,"Please select the ",TITLE," Query/Retrieve Provider"
  1.  . S QRSCP=$$PICKSCP^MAGDSTQ9(DEFAULT,"Q/R")
  1.  . I QRSCP="" W !!,"No ",TITLE," query/retrieve SCP was selected" S OK=-1 Q
  1.  . S ^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP
  1.  . S ^TMP("MAG",$J,"BATCH Q/R","PACS Q/R RETRIEVE SCP")=QRSCP
  1.  . S OK=1
  1.  . Q
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. SORTORDR ; get the direction for the ^RARPT OR ^GMR search
  1.  N X
  1.  S SORTORDER=$G(^TMP("MAG",$J,"BATCH Q/R","SORT ORDER"))
  1.  I $L(SORTORDER) D
  1.  . W !!,"The studies will be scanned in the """,SORTORDER,""" order."
  1.  . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
  1.  . I X="YES" D SORTORD1
  1.  . Q
  1.  E  D SORTORD1
  1.  Q
  1.  ;
  1. SORTORD1 ; get new value
  1.  N OK
  1.  S OK=0 F  D  Q:OK
  1.  . I SORTORDER="" S SORTORDER="ASCENDING"
  1.  . W !!,"Enter the scanning order for studies: ",SORTORDER,"// "
  1.  . R X:DTIME E  S OK=-1 Q
  1.  . I X["^" S OK=-1 Q
  1.  . I X="" S X=SORTORDER,OK=2 W X Q
  1.  . I "Aa"[$E(X) S SORTORDER="ASCENDING",OK=1 Q
  1.  . I "Dd"[$E(X) S SORTORDER="DESCENDING",OK=1 Q
  1.  . W !!,"Enter either Ascending (oldest to newest) or Descending (newest to oldest).",!
  1.  . Q
  1.  I OK<0 S QUIT=1 Q
  1.  I SORTORDER'=$G(^TMP("MAG",$J,"BATCH Q/R","SORT ORDER")) D
  1.  . S ^TMP("MAG",$J,"BATCH Q/R","SORT ORDER")=SORTORDER
  1.  . W:OK=1 " -- changed"
  1.  . Q
  1.  Q
  1.  ;
  1.  ;
  1. BEGDATE ; get the beginning date for the scan
  1.  N %DT,X,Y
  1.  ; following line is for RPT option
  1.  I '$D(SORTORDER) N SORTORDER S SORTORDER="ASCENDING"
  1.  W !!,"Enter the earliest date for the study.",!
  1.  S Y=$G(^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE"))
  1.  I Y S %DT("B")=$$FMTE^XLFDT(Y,1) ; default
  1.  I SORTORDER="ASCENDING" D
  1.  . S %DT(0)=-$$MIDNIGHT
  1.  . Q
  1.  E  D  ; DESCENDING
  1.  . S %DT(0)=-$G(^TMP("MAG",$J,"BATCH Q/R","END DATE"))
  1.  . Q
  1.  S %DT="AEPTS",%DT("A")="Earliest Study Date: ",X="" D ^%DT
  1.  I Y=-1 S QUIT=1
  1.  E  S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=Y
  1.  Q
  1.  ;
  1.  ;
  1. ENDDATE ; get the ending date for the scan
  1.  N %DT,X,Y
  1.  ; following line is for RPT option
  1.  I '$D(SORTORDER) N SORTORDER S SORTORDER="ASCENDING"
  1.  W !!,"Enter the latest date for the study.",!
  1.  S Y=$G(^TMP("MAG",$J,"BATCH Q/R","END DATE"))
  1.  I Y S %DT("B")=$$FMTE^XLFDT(Y,1) ; default
  1.  ; set the earliest date
  1.  I SORTORDER="ASCENDING" D
  1.  . S %DT(0)=$G(^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE"))
  1.  . Q
  1.  E  D  ; DESCENDING
  1.  . S %DT(0)=-$$MIDNIGHT
  1.  . Q
  1.  S %DT="AEPTS",%DT("A")="Latest Study Date: ",X="" D ^%DT
  1.  I Y=-1 S QUIT=1
  1.  E  D
  1.  . I Y'[".",$E(Y,4,5),$E(Y,6,7) S Y=Y+.235959 ; end of day
  1.  . S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=Y
  1.  . Q
  1.  Q
  1.  ;
  1. MIDNIGHT() ; return midnight today
  1.  N %,%H,%I,X
  1.  D NOW^%DTC
  1.  Q X+.24
  1.  ;
  1. BATCHSIZ ; get the size of the batch of studies to be retrieved in one run
  1.  N BATCHSIZE,X
  1.  S BATCHSIZE=$G(^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE"))
  1.  I BATCHSIZE D
  1.  . W !!,"This run will try to retrieve images for ",BATCHSIZE," studies."
  1.  . I IMAGINGSERVICE="CONSULTS" D
  1.  . . W !,"Only image-enabled consults and procedures are counted."
  1.  . . Q
  1.  . I $$YESNO^MAGDSTQ("Do you wish to change this count?","n",.X)<0 S QUIT=1 Q
  1.  . I X="YES" D BATCHSZ1
  1.  . Q
  1.  E  D BATCHSZ1
  1.  Q
  1.  ;
  1. BATCHSZ1 ; get the batch size for the retrieve run
  1.  N DEFAULT,OK,X
  1.  S DEFAULT=$S(BATCHSIZE:BATCHSIZE,1:100)
  1.  S OK=0 F  D  Q:OK
  1.  . W !!,"Enter the new value of the batch size: ",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?1.N S OK=$S(X=DEFAULT:2,1:1) Q
  1.  . W "  ??? (enter a a positive integer number)"
  1.  . Q
  1.  I OK<0 S QUIT=1 Q
  1.  D:BATCHSIZE'=X
  1.  . S ^TMP("MAG",$J,"BATCH Q/R","BATCH SIZE")=X
  1.  . W:X=1 " -- changed"
  1.  . Q
  1.  Q
  1.  ;
  1.  ;
  1. HOURS ; get hours of operation
  1.  N HOURS,X
  1.  S HOURS=$G(^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION"))
  1.  I HOURS'="" D
  1.  . W !!,"The active hours of operation are indicated below with a ""Y"""
  1.  . W !?18,"M12345678901N12345678901 (M=midnight, N=noon)"
  1.  . W !,"Active hours are: ",HOURS
  1.  . I $$YESNO^MAGDSTQ("Do you wish to change these hours?","n",.X)<0 S QUIT=1 Q
  1.  . I X="YES" D HOURS1
  1.  . Q
  1.  E  D HOURS1
  1.  Q
  1.  ;
  1. HOURS1 ; initialize/modify the hours of operations
  1.  N DEFAULT,FULLDAY,I,OK,X
  1.  S FULLDAY=$TR($J("",24)," ","Y") ; 24 hours
  1.  S DEFAULT=$S($L(HOURS):HOURS,1:FULLDAY)
  1.  S DEFAULT=$E(DEFAULT_"NNNNNNNNNNNNNNNNNNNNNNNN",1,24)
  1.  S OK=0 F  D  Q:OK
  1.  . W !?18,"M12345678901N12345678901 (M=midnight, N=noon)"
  1.  . W !,"Active hours are: ",DEFAULT
  1.  . W !?15,"// " R X:DTIME E  S OK=-1 Q
  1.  . I X["^" S OK=-1 Q
  1.  . I X="" S X=DEFAULT W X
  1.  . S X=$TR(X,"yn","YN")
  1.  . I $TR(X,"YN")="" D
  1.  . . S X=$E(X_FULLDAY,1,24)
  1.  . . S OK=1
  1.  . . S ^TMP("MAG",$J,"BATCH Q/R","HOURS OF OPERATION")=X
  1.  . . W " -- changed"
  1.  . . Q
  1.  . E  D
  1.  . . W !,?18 F I=1:1:24 S Z=$E(X,I) W $S("YN"'[Z:"^",1:" ")
  1.  . . W !!,"Enter a sequence of (up to) 24 ""Y's"" and ""N's""."
  1.  . . W !,"Every ""Y"" represents an hour when DICOM Query/Retrieve will be active."
  1.  . . W !,"Every ""N"" represents an hour when DICOM Query/Retrieve will not be active.",!
  1.  . . Q
  1.  . Q
  1.  I OK=-1 S QUIT=1
  1.  Q
  1.  ;
  1. ACNUM ; get the accession number
  1.  N GMRCIEN,HOURS,OK,RADPT1,RADPT2,RADPT3,RARPT1,RUNNUMBER,X,Y,Z,ZTDESC
  1.  S HOURS="YYYYYYYYYYYYYYYYYYYYYYYY"
  1.  S RUNNUMBER=0 ; not interested in this
  1.  S FIRSTTIME=1
  1.  D TASKINIT^MAGDSTA1
  1.  S X=MAGIOM X ^%ZOSF("RM") ; set right margin to 80 or 132
  1.  S OK=0  F  D  Q:OK
  1.  . I ^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")="RADIOLOGY" D
  1.  . . S OK=$$ACNUMRAD
  1.  . . Q
  1.  . E  D  ; consults
  1.  . . S OK=$$ACNUMCON
  1.  . . K ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES") ; remove old ones
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. ACNUMRAD() ; get and process a radiology study
  1.  W !!!!,"Enter the accession number: "
  1.  R X:DTIME E  Q -1
  1.  I "^"[X Q -1
  1.  I X?1"?".E D  Q 0
  1.  . W !,"Enter either the site-specific accession number (sss-MMDDYY-nnnn),"
  1.  . W !,"or just the legacy accession number (MMDDYY-nnnn) portion."
  1.  . Q
  1.  S X=$$ACCFIND^RAAPI(X,.RAA)
  1.  I X'=1 D  Q 0
  1.  . W " ??? not on file"
  1.  . Q
  1.  S RADPT1=$P(RAA(1),"^",1),RADPT2=$P(RAA(1),"^",2),RADPT3=$P(RAA(1),"^",3)
  1.  S Y=$G(^RADPT(RADPT1,"DT",RADPT2,"P",RADPT3,0))
  1.  S RARPT1=$P(Y,"^",17) ; REPORT TEXT
  1.  D HEADER^MAGDSTAA(0,0)
  1.  S Z=$$RADLKUP1^MAGDSTA5(RARPT1)
  1.  Q 0
  1.  ;
  1. ACNUMCON() ; get and process a consult study
  1.  N CONSULTSERVICES,LIST,PICK,SERVICE,SERVICENAME
  1.  ;
  1.  ; build the list of all consult services
  1.  S SERVICE=""
  1.  F I=1:1 S SERVICE=$O(^MAG(2006.5831,"B",SERVICE)) Q:'SERVICE  D
  1.  . S SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
  1.  . S LIST(I)=SERVICENAME_"^"_SERVICE,PICK(I)=1
  1.  . Q
  1.  D SERVICE4^MAGDSTA8(.CONSULTSERVICES,"YES",.LIST,.PICK)
  1.  K ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES") ; remove old ones
  1.  M ^TMP("MAG",$J,"BATCH Q/R","CONSULT SERVICES")=CONSULTSERVICES
  1.  ;
  1.  W !!!!,"Enter the accession number: "
  1.  R X:DTIME E  Q -1
  1.  I "^"[X Q -1
  1.  I X?1"?".E D  Q 0
  1.  . W !,"The consult accession number has two formats: ""sss-GMR-nnnn"" and ""GMRC-nnnn""."
  1.  . W !,"Enter the accession number or just the digits following the ""GMR-"" or ""GMRC-""."
  1.  . Q
  1.  S GMRCIEN=$P(X,"-",$L(X,"-"))
  1.  I '$D(^GMR(123,GMRCIEN)) D  Q 0
  1.  . W " ??? not on file"
  1.  . Q
  1.  D HEADER^MAGDSTAA(0,0)
  1.  S Z=$$CONLKUP1^MAGDSTA7(GMRCIEN)
  1.  Q 0