MAGDSTQ0.m

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 ---MAGDSTQ0   8517     printed  Apr 23, 2025@18:16:30                                                                                                                                                                                                    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