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