MAGDSTA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:53:46
;;3.0;IMAGING;**231,305**;Mar 19, 2002;Build 3
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
CONRET ; retrieve missing consult images from PACS
K ^TMP("MAG",$J,"BATCH Q/R") ; remove clinical info from previous run
S ^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")="CONSULTS"
S ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
D NEXT("CONRET")
Q
;;
;; DICOM Consult & Procedure Image Retriever
;; -----------------------------------------
;;
;;This program transfers DICOM objects for CPRS consults and procedures
;;from the designated PACS to VistA.
;;
;;This application passes the CPRS consult and procedure request files to
;;find studies that are completed and should have images. It compares
;;the study's SOP Instance UIDs (if any) with those on the designated
;;PACS for the specialty consult or procedure.
;;
;;It then formulates the requests to retrieve them, either by a list of
;;of the missing SOP Instance UIDs, the series, or by the whole study.
;;
;;An optional Q/R provider may be stored in the QUERY/RETRIEVE PROVIDER
;;field (#8) of the CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831).
;;
;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
;;the images from the PACS to VistA.
;;END
;
CONCMP ; compare image counts between consult and PACS without retrieving images
K ^TMP("MAG",$J,"BATCH Q/R")
S ^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")="CONSULTS"
S ^TMP("MAG",$J,"BATCH Q/R","OPTION")="COMPARE IMAGE COUNTS"
D NEXT("CONCMP")
Q
;;
;; DICOM Consult & Procedure Image Count Comparer
;; ----------------------------------------------
;;
;;This application passes the CPRS consult and procedure request files to
;;find studies that are completed and should have images. It compares
;;the count of the study's images (if any) with those on the designated
;;PACS for the specialty consult or procedure.
;;
;;The optional PACS Q/R provider is stored in the QUERY/RETRIEVE PROVIDER
;;field (#8) of the CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831).
;;
;;No images are transferred from the PACS to VistA, however.
;;
;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
;;the images from the PACS to VistA.
;;END
;
RADRET ; retrieve missing radiology images from PACS
K ^TMP("MAG",$J,"BATCH Q/R")
S ^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")="RADIOLOGY"
S ^TMP("MAG",$J,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
D NEXT("RADRET")
Q
;;
;; DICOM Radiology Image Retriever
;; -------------------------------
;;
;;This program transfers DICOM radiology objects from PACS to VistA.
;;
;;This application passes the radiology files to find completed studies.
;;It compares the study's SOP Instance UIDs (if any) with those on PACS.
;;
;;It then formulates the requests to retrieve them, either by a list of
;;of the missing SOP Instance UIDs, the series, or by the whole study.
;;
;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
;;the images from the PACS to VistA.
;;END
;
RADCMP ; compare image counts between radiology and PACS without retrieving images
K ^TMP("MAG",$J,"BATCH Q/R")
S ^TMP("MAG",$J,"BATCH Q/R","IMAGING SERVICE")="RADIOLOGY"
S ^TMP("MAG",$J,"BATCH Q/R","OPTION")="COMPARE IMAGE COUNTS"
D NEXT("RADCMP")
Q
;;
;; DICOM Radiology Image Count Comparer
;; ------------------------------------
;;
;;This application passes the radiology files to find completed studies.
;;It compares the count of the study's images (if any) with those on PACS.
;;
;;No images are transferred from the PACS to VistA, however.
;;
;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
;;the images from the PACS to VistA.
;;END
;
NEXT(ENTRYPOINT) ; output banner and proceed to next routine
N I,J,MENUOPTION,MSG,TEXT
S J=0
F I=1:1 S TEXT=$T(@ENTRYPOINT+I) D Q:TEXT="END"
. I $E(TEXT,1,3)'=" ;;" Q ; ignore code
. S TEXT=$P(TEXT,";;",2)
. I TEXT="END" D MESSAGE(.MSG) Q
. S J=J+1,MSG(J)=TEXT
. Q
K ENTRYPOINT,I,J,MSG,TEXT
S MENUOPTION=$P(XQY0,"^",1)
D ENTRY^MAGDSTA1(MENUOPTION)
Q
;
MESSAGE(MSG) ; display message
N I,WIDTH
S WIDTH=IOM
W ! F I=1:1:WIDTH W "*"
I $D(MSG)=1 W !,"*** ",MSG,?WIDTH-4," ***"
E F I=1:1 Q:'$D(MSG(I)) W !,"*** ",MSG(I),?WIDTH-4," ***"
W ! F I=1:1:WIDTH W "*"
Q
;
INITSTT(RUNNUMBER) ; initialize the statistics
N I,T
; initialize the statistics so that they are in the most useful order
F I=1:1:15 S T=$T(INITSTT+I+7),T=$P(T,";;",2) D Q:T="**END**"
. D STTWRITE^MAGDSTAA(T,"")
. Q
Q
;
;;VISTA STUDIES PROCESSED
;;VISTA STUDIES WITHOUT DICOM IMAGES
;;LEGACY STUDIES PROCESSED
;;LEGACY SERIES COUNT
;;LEGACY IMAGE COUNT
;;NEW SOP CLASS STUDIES PROCESSED
;;NEW SOP CLASS SERIES COUNT
;;NEW SOP CLASS IMAGE COUNT
;;PACS STUDIES PROCESSED
;;PACS STUDIES WITHOUT IMAGES
;;PACS SERIES COUNT
;;PACS IMAGE COUNT
;;PACS STUDY LEVEL RETRIEVES
;;PACS SERIES LEVEL RETRIEVES
;;PACS IMAGES RETRIEVED
;;**END**
;
KILLCON ; entry point to kill consult statistics runs
N MYSERVICE S MYSERVICE="CONSULTS"
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D KILL
Q
;
KILLRAD ; entry point to kill radiology statistics runs
N MYSERVICE S MYSERVICE="RADIOLOGY"
N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D KILL
Q
;
KILL ; truncate the AUTOMATIC DICOM Q/R RUN STATS file (#2006.5443)
N COUNT,I,LIST,PROMPT,X
D MAKELIST^MAGDSTAS(MYSERVICE,.LIST,.COUNT)
I COUNT=0 D Q
. W !!,"The AUTOMATIC DICOM Q/R RUN STATS for ",MYSERVICE," have already been deleted."
. Q
I COUNT=1 D
. W !!,"There is one entry in the AUTOMATIC DICOM Q/R RUN STATS for ",MYSERVICE,"."
. S PROMPT="Do you want to remove it?"
. Q
E D
. W !!,"There are "_COUNT_" entries in the AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE,"."
. S PROMPT="Do you want to remove them?"
. Q
I $$YESNO^MAGDSTQ(PROMPT,"n",.X)>0,X="YES" D
. L +^MAGDSTT(2006.543,0):30 E D Q
. . W !!,"Cannot obtain LOCK on Q/R RETRIEVE DICOM RUN STATS Table.",!!
. . Q
. ; delete one node
. F I=1:1:COUNT D KILL1(LIST(I))
. ; update counter for zero node
. S (J,K)=0,L="" F S J=$O(^MAGDSTT(2006.543,J)) Q:'J D
. . S K=K+1 ; update count
. . S L=J ; last node
. . Q
. ; update last node and counter in zero node
. S $P(^MAGDSTT(2006.543,0),"^",3)=L ; last node
. S $P(^MAGDSTT(2006.543,0),"^",4)=K ; count
. L -^MAGDSTT(2006.543,0)
. ;
. W !!,"The AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE," has been truncated."
. Q
E W !!,"The AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE," has not been truncated."
Q
;
KILL1(I) ; delete a single entry
N COUNT,J,K,L,MENUOPTION,NODE0,SCANMODE,STARTTIME
S NODE0=$G(^MAGDSTT(2006.543,I,0))
S STARTTIME=$P(NODE0,"^",1)
S SCANMODE=$P(NODE0,"^",6)
S MENUOPTION=$P(NODE0,"^",20)
; kill node and cross references
K ^MAGDSTT(2006.543,I)
K ^MAGDSTT(2006.543,"B",STARTTIME,I)
K ^MAGDSTT(2006.543,"C",MENUOPTION,SCANMODE,I)
Q
;
ERROR ; error trap for automatic processes
N ERROR
S ERROR=$$EC^%ZOSV
I ERROR'?1"<INTERRUPT>".E D
. W !!,"*** ERROR: ",ERROR," ***"
. S X="ERROR: "_ERROR
. D ^%ZTER ; record the error
. Q
E S X="Interrupted by User"
I $D(RUNNUMBER) D
. S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)=$TR(X,"^","|")
. Q
I $G(MAGXTMP)'="" D
. N HOSTNAME S HOSTNAME=$$HOSTNAME^MAGDFCNV
. K ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$J) ; remove RUN status
. Q
D CONTINUE^MAGDSTQ
D UNWIND^%ZTER ; unwind the stack and return to the menu
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTA 8729 printed Apr 09, 2024@21:04:44 Page 2
MAGDSTA ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Feb 15, 2022@10:53:46
+1 ;;3.0;IMAGING;**231,305**;Mar 19, 2002;Build 3
+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 QUIT
+18 ;
CONRET ; retrieve missing consult images from PACS
+1 ; remove clinical info from previous run
KILL ^TMP("MAG",$JOB,"BATCH Q/R")
+2 SET ^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE")="CONSULTS"
+3 SET ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
+4 DO NEXT("CONRET")
+5 QUIT
+6 ;;
+7 ;; DICOM Consult & Procedure Image Retriever
+8 ;; -----------------------------------------
+9 ;;
+10 ;;This program transfers DICOM objects for CPRS consults and procedures
+11 ;;from the designated PACS to VistA.
+12 ;;
+13 ;;This application passes the CPRS consult and procedure request files to
+14 ;;find studies that are completed and should have images. It compares
+15 ;;the study's SOP Instance UIDs (if any) with those on the designated
+16 ;;PACS for the specialty consult or procedure.
+17 ;;
+18 ;;It then formulates the requests to retrieve them, either by a list of
+19 ;;of the missing SOP Instance UIDs, the series, or by the whole study.
+20 ;;
+21 ;;An optional Q/R provider may be stored in the QUERY/RETRIEVE PROVIDER
+22 ;;field (#8) of the CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831).
+23 ;;
+24 ;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
+25 ;;the images from the PACS to VistA.
+26 ;;END
+27 ;
CONCMP ; compare image counts between consult and PACS without retrieving images
+1 KILL ^TMP("MAG",$JOB,"BATCH Q/R")
+2 SET ^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE")="CONSULTS"
+3 SET ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="COMPARE IMAGE COUNTS"
+4 DO NEXT("CONCMP")
+5 QUIT
+6 ;;
+7 ;; DICOM Consult & Procedure Image Count Comparer
+8 ;; ----------------------------------------------
+9 ;;
+10 ;;This application passes the CPRS consult and procedure request files to
+11 ;;find studies that are completed and should have images. It compares
+12 ;;the count of the study's images (if any) with those on the designated
+13 ;;PACS for the specialty consult or procedure.
+14 ;;
+15 ;;The optional PACS Q/R provider is stored in the QUERY/RETRIEVE PROVIDER
+16 ;;field (#8) of the CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831).
+17 ;;
+18 ;;No images are transferred from the PACS to VistA, however.
+19 ;;
+20 ;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
+21 ;;the images from the PACS to VistA.
+22 ;;END
+23 ;
RADRET ; retrieve missing radiology images from PACS
+1 KILL ^TMP("MAG",$JOB,"BATCH Q/R")
+2 SET ^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE")="RADIOLOGY"
+3 SET ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="RETRIEVE MISSING IMAGES"
+4 DO NEXT("RADRET")
+5 QUIT
+6 ;;
+7 ;; DICOM Radiology Image Retriever
+8 ;; -------------------------------
+9 ;;
+10 ;;This program transfers DICOM radiology objects from PACS to VistA.
+11 ;;
+12 ;;This application passes the radiology files to find completed studies.
+13 ;;It compares the study's SOP Instance UIDs (if any) with those on PACS.
+14 ;;
+15 ;;It then formulates the requests to retrieve them, either by a list of
+16 ;;of the missing SOP Instance UIDs, the series, or by the whole study.
+17 ;;
+18 ;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
+19 ;;the images from the PACS to VistA.
+20 ;;END
+21 ;
RADCMP ; compare image counts between radiology and PACS without retrieving images
+1 KILL ^TMP("MAG",$JOB,"BATCH Q/R")
+2 SET ^TMP("MAG",$JOB,"BATCH Q/R","IMAGING SERVICE")="RADIOLOGY"
+3 SET ^TMP("MAG",$JOB,"BATCH Q/R","OPTION")="COMPARE IMAGE COUNTS"
+4 DO NEXT("RADCMP")
+5 QUIT
+6 ;;
+7 ;; DICOM Radiology Image Count Comparer
+8 ;; ------------------------------------
+9 ;;
+10 ;;This application passes the radiology files to find completed studies.
+11 ;;It compares the count of the study's images (if any) with those on PACS.
+12 ;;
+13 ;;No images are transferred from the PACS to VistA, however.
+14 ;;
+15 ;;The DICOM Gateway issues the DICOM Query/Retrieve requests to send
+16 ;;the images from the PACS to VistA.
+17 ;;END
+18 ;
NEXT(ENTRYPOINT) ; output banner and proceed to next routine
+1 NEW I,J,MENUOPTION,MSG,TEXT
+2 SET J=0
+3 FOR I=1:1
SET TEXT=$TEXT(@ENTRYPOINT+I)
Begin DoDot:1
+4 ; ignore code
IF $EXTRACT(TEXT,1,3)'=" ;;"
QUIT
+5 SET TEXT=$PIECE(TEXT,";;",2)
+6 IF TEXT="END"
DO MESSAGE(.MSG)
QUIT
+7 SET J=J+1
SET MSG(J)=TEXT
+8 QUIT
End DoDot:1
if TEXT="END"
QUIT
+9 KILL ENTRYPOINT,I,J,MSG,TEXT
+10 SET MENUOPTION=$PIECE(XQY0,"^",1)
+11 DO ENTRY^MAGDSTA1(MENUOPTION)
+12 QUIT
+13 ;
MESSAGE(MSG) ; display message
+1 NEW I,WIDTH
+2 SET WIDTH=IOM
+3 WRITE !
FOR I=1:1:WIDTH
WRITE "*"
+4 IF $DATA(MSG)=1
WRITE !,"*** ",MSG,?WIDTH-4," ***"
+5 IF '$TEST
FOR I=1:1
if '$DATA(MSG(I))
QUIT
WRITE !,"*** ",MSG(I),?WIDTH-4," ***"
+6 WRITE !
FOR I=1:1:WIDTH
WRITE "*"
+7 QUIT
+8 ;
INITSTT(RUNNUMBER) ; initialize the statistics
+1 NEW I,T
+2 ; initialize the statistics so that they are in the most useful order
+3 FOR I=1:1:15
SET T=$TEXT(INITSTT+I+7)
SET T=$PIECE(T,";;",2)
Begin DoDot:1
+4 DO STTWRITE^MAGDSTAA(T,"")
+5 QUIT
End DoDot:1
if T="**END**"
QUIT
+6 QUIT
+7 ;
+8 ;;VISTA STUDIES PROCESSED
+9 ;;VISTA STUDIES WITHOUT DICOM IMAGES
+10 ;;LEGACY STUDIES PROCESSED
+11 ;;LEGACY SERIES COUNT
+12 ;;LEGACY IMAGE COUNT
+13 ;;NEW SOP CLASS STUDIES PROCESSED
+14 ;;NEW SOP CLASS SERIES COUNT
+15 ;;NEW SOP CLASS IMAGE COUNT
+16 ;;PACS STUDIES PROCESSED
+17 ;;PACS STUDIES WITHOUT IMAGES
+18 ;;PACS SERIES COUNT
+19 ;;PACS IMAGE COUNT
+20 ;;PACS STUDY LEVEL RETRIEVES
+21 ;;PACS SERIES LEVEL RETRIEVES
+22 ;;PACS IMAGES RETRIEVED
+23 ;;**END**
+24 ;
KILLCON ; entry point to kill consult statistics runs
+1 NEW MYSERVICE
SET MYSERVICE="CONSULTS"
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+3 DO KILL
+4 QUIT
+5 ;
KILLRAD ; entry point to kill radiology statistics runs
+1 NEW MYSERVICE
SET MYSERVICE="RADIOLOGY"
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+3 DO KILL
+4 QUIT
+5 ;
KILL ; truncate the AUTOMATIC DICOM Q/R RUN STATS file (#2006.5443)
+1 NEW COUNT,I,LIST,PROMPT,X
+2 DO MAKELIST^MAGDSTAS(MYSERVICE,.LIST,.COUNT)
+3 IF COUNT=0
Begin DoDot:1
+4 WRITE !!,"The AUTOMATIC DICOM Q/R RUN STATS for ",MYSERVICE," have already been deleted."
+5 QUIT
End DoDot:1
QUIT
+6 IF COUNT=1
Begin DoDot:1
+7 WRITE !!,"There is one entry in the AUTOMATIC DICOM Q/R RUN STATS for ",MYSERVICE,"."
+8 SET PROMPT="Do you want to remove it?"
+9 QUIT
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !!,"There are "_COUNT_" entries in the AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE,"."
+12 SET PROMPT="Do you want to remove them?"
+13 QUIT
End DoDot:1
+14 IF $$YESNO^MAGDSTQ(PROMPT,"n",.X)>0
IF X="YES"
Begin DoDot:1
+15 LOCK +^MAGDSTT(2006.543,0):30
IF '$TEST
Begin DoDot:2
+16 WRITE !!,"Cannot obtain LOCK on Q/R RETRIEVE DICOM RUN STATS Table.",!!
+17 QUIT
End DoDot:2
QUIT
+18 ; delete one node
+19 FOR I=1:1:COUNT
DO KILL1(LIST(I))
+20 ; update counter for zero node
+21 SET (J,K)=0
SET L=""
FOR
SET J=$ORDER(^MAGDSTT(2006.543,J))
if 'J
QUIT
Begin DoDot:2
+22 ; update count
SET K=K+1
+23 ; last node
SET L=J
+24 QUIT
End DoDot:2
+25 ; update last node and counter in zero node
+26 ; last node
SET $PIECE(^MAGDSTT(2006.543,0),"^",3)=L
+27 ; count
SET $PIECE(^MAGDSTT(2006.543,0),"^",4)=K
+28 LOCK -^MAGDSTT(2006.543,0)
+29 ;
+30 WRITE !!,"The AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE," has been truncated."
+31 QUIT
End DoDot:1
+32 IF '$TEST
WRITE !!,"The AUTOMATIC DICOM Q/R RUN STATS file for ",MYSERVICE," has not been truncated."
+33 QUIT
+34 ;
KILL1(I) ; delete a single entry
+1 NEW COUNT,J,K,L,MENUOPTION,NODE0,SCANMODE,STARTTIME
+2 SET NODE0=$GET(^MAGDSTT(2006.543,I,0))
+3 SET STARTTIME=$PIECE(NODE0,"^",1)
+4 SET SCANMODE=$PIECE(NODE0,"^",6)
+5 SET MENUOPTION=$PIECE(NODE0,"^",20)
+6 ; kill node and cross references
+7 KILL ^MAGDSTT(2006.543,I)
+8 KILL ^MAGDSTT(2006.543,"B",STARTTIME,I)
+9 KILL ^MAGDSTT(2006.543,"C",MENUOPTION,SCANMODE,I)
+10 QUIT
+11 ;
ERROR ; error trap for automatic processes
+1 NEW ERROR
+2 SET ERROR=$$EC^%ZOSV
+3 IF ERROR'?1"<INTERRUPT>".E
Begin DoDot:1
+4 WRITE !!,"*** ERROR: ",ERROR," ***"
+5 SET X="ERROR: "_ERROR
+6 ; record the error
DO ^%ZTER
+7 QUIT
End DoDot:1
+8 IF '$TEST
SET X="Interrupted by User"
+9 IF $DATA(RUNNUMBER)
Begin DoDot:1
+10 SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",5)=$TRANSLATE(X,"^","|")
+11 QUIT
End DoDot:1
+12 IF $GET(MAGXTMP)'=""
Begin DoDot:1
+13 NEW HOSTNAME
SET HOSTNAME=$$HOSTNAME^MAGDFCNV
+14 ; remove RUN status
KILL ^XTMP(MAGXTMP,"AUTO Q/R",HOSTNAME,$JOB)
+15 QUIT
End DoDot:1
+16 DO CONTINUE^MAGDSTQ
+17 ; unwind the stack and return to the menu
DO UNWIND^%ZTER
+18 QUIT
