MAGDSTQ0 ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Aug 16, 2020@17:57:20
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Jun 29, 2011
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Notice: This routine is on both VistA and the DICOM Gateway
;
; Supported IA #10103 reference $$NOW^XLFDT function call
; Supported IA #10103 reference $$FMADD^XLFDT function call
;
Q
;
INITXTMP() ; initialize ^XTMP
N MAGXTMP,PURGE,TODAY
S MAGXTMP="MAG Q/R Client"
S TODAY=$$NOW^XLFDT()\1
D KILLXTMP(MAGXTMP,TODAY)
S PURGE=$$FMADD^XLFDT(TODAY,7) ; keep a week's worth for debug purposes
S MAGXTMP=MAGXTMP_" "_TODAY
I '$D(^XTMP(MAGXTMP,0)) S ^(0)=PURGE_"^"_TODAY_"^DICOM Q/R Client"
K ^XTMP(MAGXTMP,HOSTNAME,$J)
Q MAGXTMP
;
KILLXTMP(MAGXTMP,TODAY) ; remove old ^XTMP files
N X
F S MAGXTMP=$O(^XTMP(MAGXTMP)) Q:MAGXTMP'?1"MAG".E D
. ; check purge date against today's - keep a week's worth for debug purposes
. S X=$G(^XTMP(MAGXTMP,0)) I $P(X,"^",1)<TODAY K ^XTMP(MAGXTMP)
. Q
Q
;
KEYLIST(KEYLIST) ; initialize KEYLIST
N I,LINETAG,T
S QRROOT=$G(^TMP("MAG",$J,"Q/R PARAM","ROOT"))
S QUERYLEVEL=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL"))
S LINETAG=$E(QRROOT,1)_QUERYLEVEL
S T=$T(@LINETAG) I T="" Q 0 ; not a valid Q/R Root/Level pair
K KEYLIST
S KEYCOUNT=0
F I=1:1 S T=$P($T(@LINETAG+I),";;",2) Q:T="END" D
. S KEYCOUNT=KEYCOUNT+1
. S KEYLIST(KEYCOUNT)=T
. Q
Q KEYCOUNT
;
PPATIENT ; patient root patient level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;END
;;
PSTUDY ; patient root study level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;END
;;
PSERIES ; patient root series level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;SERIES NUMBER|SERIESNO^MAGDSTQ1
;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
;;END
;;
PIMAGE ; patient root image level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;SERIES NUMBER|SERIESNO^MAGDSTQ1
;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
;;SOP INSTANCE UID(0001)|SOPUID^MAGDSTQ1
;;END
;;
SSTUDY ; study root study level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;END
;;
SSERIES ; study root series level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;SERIES NUMBER|SERIESNO^MAGDSTQ1
;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
;;END
;;
SIMAGE ; study root image level query keys
;;PATIENT NAME|PNAME^MAGDSTQ1
;;PATIENT ID|PID^MAGDSTQ1
;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
;;PATIENT'S SEX|SEX^MAGDSTQ1
;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
;;STUDY DATE|STDYDATE^MAGDSTQ1
;;STUDY TIME|STDYTIME^MAGDSTQ1
;;STUDY ID|STUDYID^MAGDSTQ1
;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
;;MODALITY|MODALITY^MAGDSTQ1
;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
;;SERIES NUMBER|SERIESNO^MAGDSTQ1
;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
;;SOP INSTANCE UID(0001)|SOPUID^MAGDSTQ1
;;END
;;
;
ASKDASH ; ask the dash question
N PIDDASHES
S PIDDASHES=$G(^TMP("MAG",$J,"Q/R PARAM","PATIENT ID DASHES"))
I PIDDASHES="" D
. ; set the patient lookup CLIENT for manual Q/R client
. N X,DEFAULT
. D DASHES(.DEFAULT) ; get VistA setting for dashes in PID
. I $$YESNO^MAGDSTQ("Include dashes in the PATIENT ID key?",DEFAULT,.X)<0 Q
. S (^TMP("MAG",$J,"Q/R PARAM","PATIENT ID DASHES"),PIDDASHES)=$E(X,1)
. Q
Q
;
DASHES(OUTPUT) ; lookup whether or not PID should contain dashes - returns Y or N
I $$VISTA^MAGDSTQ D ; VistA code - call API
. D DASHES^MAGDSTA3(.OUTPUT)
. Q
E D ; DICOM Gateway code - call RPC
. N RPCERR
. S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PT ID DASHES","M",.OUTPUT)
. I RPCERR<0 D S OUTPUT(0)=-1 Q
. . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PT ID DASHES rpc",.OUTPUT)
. . Q
. Q
Q
;
PUSH(QRSTACK) ; push the query down onto the stack
S QRSTACK=QRSTACK+1
; remove any previous query results
K ^TMP("MAG",$J,"Q/R QUERY",QRSTACK) ; remove any previous query results
K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK) ; remove any previous query results
; copy the previous stack results to the new stack
M ^TMP("MAG",$J,"Q/R QUERY",QRSTACK)=^TMP("MAG",$J,"Q/R QUERY",QRSTACK-1)
M ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK)=^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK-1)
Q
;
POP(QRSTACK) ; remove the old query from the stack
K ^TMP("MAG",$J,"Q/R QUERY",QRSTACK) ; remove any old query results
K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK) ; remove any old query results
I QRSTACK>1 S QRSTACK=QRSTACK-1
E D
. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")=QRROOT
. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")=QRROOT
. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=QRSCP
. Q
D KEYLIST^MAGDSTQ0(.KEYLIST)
Q
;
ERRORMSG(PAUSE,TEXT,INFO) ; display error message to user called from MAGDSTQA
N COMEFROM,I,J,MAXLEN,MSG,X
S COMEFROM=$P($STACK($STACK-1,"PLACE")," ",1)
S I=0,MAXLEN=36+$L(COMEFROM) ; max length of last line
I $L($G(TEXT)) S I=I+1,MSG(I)=TEXT
S I=I+1,MSG(I)=""
I $D(INFO)=1 D ERRMSG1(.MSG,.I,INFO)
E F J=1:1 Q:'$D(INFO(J)) D ERRMSG1(.MSG,.I,INFO(J))
F J=1:1:I I $L(MSG(J))>MAXLEN S MAXLEN=$L(MSG(J))
S I=I+1,MSG(I)=""
S I=I+1,MSG(I)="Message generated at MUMPS line tag "_COMEFROM
W ! F J=1:1:MAXLEN+8 W "*"
F J=1:1:I W !,"*** ",MSG(J),?MAXLEN+4," ***"
W ! F J=1:1:MAXLEN+8 W "*"
I $G(PAUSE) D CONTINUE^MAGDSTQ
Q
;
ERRMSG1(MSG,I,INFO) ; split long lines into shorter ones
N J,K,X
I $L(INFO)'>75 S I=I+1,MSG(I)=INFO Q
; split the line up into shorter ones
S K=1,X=$P(INFO," ",1)
F J=2:1:$L(INFO," ") D
. I ($L(X)+$L($P(INFO," ",J)))>75 D ; output short line
. . S I=I+1,MSG(I)=X,X="",K=0
. . Q
. S K=K+1,$P(X," ",K)=$P(INFO," ",J)
. Q
I X'="" S I=I+1,MSG(I)=X ; flush buffer
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ0 8517 printed Dec 13, 2024@02:01:57 Page 2
MAGDSTQ0 ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Aug 16, 2020@17:57:20
+1 ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Jun 29, 2011
+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 ; Notice: This routine is on both VistA and the DICOM Gateway
+19 ;
+20 ; Supported IA #10103 reference $$NOW^XLFDT function call
+21 ; Supported IA #10103 reference $$FMADD^XLFDT function call
+22 ;
+23 QUIT
+24 ;
INITXTMP() ; initialize ^XTMP
+1 NEW MAGXTMP,PURGE,TODAY
+2 SET MAGXTMP="MAG Q/R Client"
+3 SET TODAY=$$NOW^XLFDT()\1
+4 DO KILLXTMP(MAGXTMP,TODAY)
+5 ; keep a week's worth for debug purposes
SET PURGE=$$FMADD^XLFDT(TODAY,7)
+6 SET MAGXTMP=MAGXTMP_" "_TODAY
+7 IF '$DATA(^XTMP(MAGXTMP,0))
SET ^(0)=PURGE_"^"_TODAY_"^DICOM Q/R Client"
+8 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB)
+9 QUIT MAGXTMP
+10 ;
KILLXTMP(MAGXTMP,TODAY) ; remove old ^XTMP files
+1 NEW X
+2 FOR
SET MAGXTMP=$ORDER(^XTMP(MAGXTMP))
if MAGXTMP'?1"MAG".E
QUIT
Begin DoDot:1
+3 ; check purge date against today's - keep a week's worth for debug purposes
+4 SET X=$GET(^XTMP(MAGXTMP,0))
IF $PIECE(X,"^",1)<TODAY
KILL ^XTMP(MAGXTMP)
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
KEYLIST(KEYLIST) ; initialize KEYLIST
+1 NEW I,LINETAG,T
+2 SET QRROOT=$GET(^TMP("MAG",$JOB,"Q/R PARAM","ROOT"))
+3 SET QUERYLEVEL=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL"))
+4 SET LINETAG=$EXTRACT(QRROOT,1)_QUERYLEVEL
+5 ; not a valid Q/R Root/Level pair
SET T=$TEXT(@LINETAG)
IF T=""
QUIT 0
+6 KILL KEYLIST
+7 SET KEYCOUNT=0
+8 FOR I=1:1
SET T=$PIECE($TEXT(@LINETAG+I),";;",2)
if T="END"
QUIT
Begin DoDot:1
+9 SET KEYCOUNT=KEYCOUNT+1
+10 SET KEYLIST(KEYCOUNT)=T
+11 QUIT
End DoDot:1
+12 QUIT KEYCOUNT
+13 ;
PPATIENT ; patient root patient level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;END
+6 ;;
PSTUDY ; patient root study level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;END
+13 ;;
PSERIES ; patient root series level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;SERIES NUMBER|SERIESNO^MAGDSTQ1
+13 ;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
+14 ;;END
+15 ;;
PIMAGE ; patient root image level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;SERIES NUMBER|SERIESNO^MAGDSTQ1
+13 ;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
+14 ;;SOP INSTANCE UID(0001)|SOPUID^MAGDSTQ1
+15 ;;END
+16 ;;
SSTUDY ; study root study level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;END
+13 ;;
SSERIES ; study root series level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;SERIES NUMBER|SERIESNO^MAGDSTQ1
+13 ;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
+14 ;;END
+15 ;;
SIMAGE ; study root image level query keys
+1 ;;PATIENT NAME|PNAME^MAGDSTQ1
+2 ;;PATIENT ID|PID^MAGDSTQ1
+3 ;;PATIENT BIRTH DATE|BIRTHDAT^MAGDSTQ1
+4 ;;PATIENT'S SEX|SEX^MAGDSTQ1
+5 ;;ACCESSION NUMBER|ACNUMB^MAGDSTQ1
+6 ;;STUDY DATE|STDYDATE^MAGDSTQ1
+7 ;;STUDY TIME|STDYTIME^MAGDSTQ1
+8 ;;STUDY ID|STUDYID^MAGDSTQ1
+9 ;;STUDY INSTANCE UID(0001)|STUDYUID^MAGDSTQ1
+10 ;;MODALITY|MODALITY^MAGDSTQ1
+11 ;;REFERRING PHYSICIAN|REFDOC^MAGDSTQ1
+12 ;;SERIES NUMBER|SERIESNO^MAGDSTQ1
+13 ;;SERIES INSTANCE UID(0001)|SERIEUID^MAGDSTQ1
+14 ;;SOP INSTANCE UID(0001)|SOPUID^MAGDSTQ1
+15 ;;END
+16 ;;
+17 ;
ASKDASH ; ask the dash question
+1 NEW PIDDASHES
+2 SET PIDDASHES=$GET(^TMP("MAG",$JOB,"Q/R PARAM","PATIENT ID DASHES"))
+3 IF PIDDASHES=""
Begin DoDot:1
+4 ; set the patient lookup CLIENT for manual Q/R client
+5 NEW X,DEFAULT
+6 ; get VistA setting for dashes in PID
DO DASHES(.DEFAULT)
+7 IF $$YESNO^MAGDSTQ("Include dashes in the PATIENT ID key?",DEFAULT,.X)<0
QUIT
+8 SET (^TMP("MAG",$JOB,"Q/R PARAM","PATIENT ID DASHES"),PIDDASHES)=$EXTRACT(X,1)
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
DASHES(OUTPUT) ; lookup whether or not PID should contain dashes - returns Y or N
+1 ; VistA code - call API
IF $$VISTA^MAGDSTQ
Begin DoDot:1
+2 DO DASHES^MAGDSTA3(.OUTPUT)
+3 QUIT
End DoDot:1
+4 ; DICOM Gateway code - call RPC
IF '$TEST
Begin DoDot:1
+5 NEW RPCERR
+6 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PT ID DASHES","M",.OUTPUT)
+7 IF RPCERR<0
Begin DoDot:2
+8 DO ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PT ID DASHES rpc",.OUTPUT)
+9 QUIT
End DoDot:2
SET OUTPUT(0)=-1
QUIT
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
PUSH(QRSTACK) ; push the query down onto the stack
+1 SET QRSTACK=QRSTACK+1
+2 ; remove any previous query results
+3 ; remove any previous query results
KILL ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK)
+4 ; remove any previous query results
KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK)
+5 ; copy the previous stack results to the new stack
+6 MERGE ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK)=^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK-1)
+7 MERGE ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK)=^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK-1)
+8 QUIT
+9 ;
POP(QRSTACK) ; remove the old query from the stack
+1 ; remove any old query results
KILL ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK)
+2 ; remove any old query results
KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK)
+3 IF QRSTACK>1
SET QRSTACK=QRSTACK-1
+4 IF '$TEST
Begin DoDot:1
+5 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")=QRROOT
+6 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")=QRROOT
+7 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=QRSCP
+8 QUIT
End DoDot:1
+9 DO KEYLIST^MAGDSTQ0(.KEYLIST)
+10 QUIT
+11 ;
ERRORMSG(PAUSE,TEXT,INFO) ; display error message to user called from MAGDSTQA
+1 NEW COMEFROM,I,J,MAXLEN,MSG,X
+2 SET COMEFROM=$PIECE($STACK($STACK-1,"PLACE")," ",1)
+3 ; max length of last line
SET I=0
SET MAXLEN=36+$LENGTH(COMEFROM)
+4 IF $LENGTH($GET(TEXT))
SET I=I+1
SET MSG(I)=TEXT
+5 SET I=I+1
SET MSG(I)=""
+6 IF $DATA(INFO)=1
DO ERRMSG1(.MSG,.I,INFO)
+7 IF '$TEST
FOR J=1:1
if '$DATA(INFO(J))
QUIT
DO ERRMSG1(.MSG,.I,INFO(J))
+8 FOR J=1:1:I
IF $LENGTH(MSG(J))>MAXLEN
SET MAXLEN=$LENGTH(MSG(J))
+9 SET I=I+1
SET MSG(I)=""
+10 SET I=I+1
SET MSG(I)="Message generated at MUMPS line tag "_COMEFROM
+11 WRITE !
FOR J=1:1:MAXLEN+8
WRITE "*"
+12 FOR J=1:1:I
WRITE !,"*** ",MSG(J),?MAXLEN+4," ***"
+13 WRITE !
FOR J=1:1:MAXLEN+8
WRITE "*"
+14 IF $GET(PAUSE)
DO CONTINUE^MAGDSTQ
+15 QUIT
+16 ;
ERRMSG1(MSG,I,INFO) ; split long lines into shorter ones
+1 NEW J,K,X
+2 IF $LENGTH(INFO)'>75
SET I=I+1
SET MSG(I)=INFO
QUIT
+3 ; split the line up into shorter ones
+4 SET K=1
SET X=$PIECE(INFO," ",1)
+5 FOR J=2:1:$LENGTH(INFO," ")
Begin DoDot:1
+6 ; output short line
IF ($LENGTH(X)+$LENGTH($PIECE(INFO," ",J)))>75
Begin DoDot:2
+7 SET I=I+1
SET MSG(I)=X
SET X=""
SET K=0
+8 QUIT
End DoDot:2
+9 SET K=K+1
SET $PIECE(X," ",K)=$PIECE(INFO," ",J)
+10 QUIT
End DoDot:1
+11 ; flush buffer
IF X'=""
SET I=I+1
SET MSG(I)=X
+12 QUIT
