MAGDQR13 ;WOIFO/EdM/MLH/JSL/SAF/BT - Imaging RPCs for Query/Retrieve - Overflow from MAGDQR03; 10 Apr 2012 2:05 PM ; 06 Aug 2012 2:42 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
;; 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
;
; SAVRSLT^MAGDQR13 is called by MAGDQR03
;
; This procedure
; - saves compiled result (V) to the Query Retrieve Result File (#2006.5732)
; - merges modalities with the same Study Instance UID
;
; Input Parameters
; ================
; RESULT = pointer into the Query Retrieve Result File (#2006.5732)
; MAGDFN = pointer into the Patient File (#2)
; MAGIEN = pointer into the Image File (#2005 or 2005.64)
; V = compiled result
;
; V Structure
; ===========
; V(TAG) = VALUE
; V(TAG,SEQ) = VALUE
; V(TAG,SEQ,SEQ2) = VALUE
;
; Values of V(TAG) and V(TAG,SEQ) will be merged as one record using delimiter
; Each value of V(TAG,SEQ,SEQ2) will be saved separately
;
; TAG = see MAGDQR00 for list of Supported tags
;
SAVRSLT(RESULT,MAGDFN,MAGIEN,V) ;
N PRVRSLT,STUDYUID,ACCN,PATNAME
;
; At this point V($$STUIDTAG) - STUDY INSTANCE UID will exist, caller validates the value before calling this proc
S STUDYUID=V($$STUIDTAG^MAGDQR00)
S ACCN=$G(V($$ACCNTAG^MAGDQR00)) ;Accession number
S:ACCN="" ACCN="*" ;might not be requested in the result
S PATNAM=$G(V($$PTNAMTAG^MAGDQR00)) ;patientname
S:PATNAM="" PATNAM="*" ;might not be requested in the result
;
; if there are multiple modalities, replace comma delimiter with "\"
N MODTAG
S MODTAG=$$MODTAG^MAGDQR00
S:$G(V(MODTAG))'="" V(MODTAG)=$TR(V(MODTAG),",","\")
;
; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
S PRVRSLT=$$GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM)
; Merge record if there is previous record with the same STUDYUID
I PRVRSLT>0 D MERGEREC(PRVRSLT,.V) Q
; otherwise, save record to file
I PRVRSLT=0 D SAVREC(RESULT,MAGDFN,MAGIEN,STUDYUID,ACCN,PATNAM,.V)
; PRVSLT=-1 Do not save Duplicate Study UID
Q
;
GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM) ; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
; Return 0 - Study UID not found
; Record Number - Study UID found
; -1 - Study UID found but has different patient id, patient name or accession number
;
; ^TMP("MAG",$J,"DICOMQR","STUDYUID") and ^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS") below are
; cross references of file 2006.5732
;
I '$D(^TMP("MAG",$J,"DICOMQR","STUDYUID",STUDYUID)) Q 0
I '$D(^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM)) Q -1
Q ^TMP("MAG",$J,"DICOMQR","STUDYUID",STUDYUID)
;
MERGEREC(PRVRSLT,V) ; Merge record to previous record with the same UID
; Merge Modalities
D:$G(V($$MODTAG^MAGDQR00))'="" MRGONMOD(PRVRSLT,.V)
;
; Accumulate "Number of Study Related Series" and "Number of Study Related Instances"
N NIMGTAG
F NIMGTAG=$$NSRSTAG^MAGDQR00,$$NSRITAG^MAGDQR00 D:$G(V(NIMGTAG)) MRGONIMG(PRVRSLT,.V,NIMGTAG)
;
; Use non empty Study Description
D:$G(V($$STDESTAG^MAGDQR00))'="" UPDSTDES(PRVRSLT,.V)
Q
;
MRGONMOD(PRVRSLT,V) ; Merge modalities from old and new db
; V(MODTAG) must have value before calling this procedure
N MODTAG
S MODTAG=$$MODTAG^MAGDQR00
;
; find record number for the Modalities of previous record with the same Study UID
N STUDYUID,STUDYTA,MODRECNO
S STUDYUID=V($$STUIDTAG^MAGDQR00)
S MODRECNO=$$GTAGRECN(PRVRSLT,MODTAG,STUDYUID)
;
; if not found, add modalities to sub file (2006.57321)
I 'MODRECNO D ADDTAGFL(PRVRSLT,MODTAG,V(MODTAG)) Q
;
; if found, merge current modalities to previous record with the same Study UID
N PAIR,TAG,PREVMOD,MERGE
S PAIR=$$GTAGPAIR(PRVRSLT,MODRECNO)
S TAG=$P(PAIR,U)
Q:MODTAG'=TAG ;should not happen, corrupted data, no merge
;
S PREVMOD=$P(PAIR,U,2) ;modalities from previous record
S MERGE=$$MERGEMOD(.PREVMOD,V(MODTAG))
D:MERGE UTAGPAIR(PRVRSLT,MODRECNO,MODTAG_U_PREVMOD)
Q
;
MERGEMOD(PREVMOD,NEWMOD) ; return the merged modalities
I PREVMOD="" S PREVMOD=NEWMOD Q 1
;
N I,MOD,MERGE
S MERGE=0
;
F I=1:1:$L(NEWMOD,"\") D
. S MOD=$P(NEWMOD,"\",I)
. I '$F("\"_PREVMOD_"\","\"_MOD_"\") D
. . S PREVMOD=PREVMOD_"\"_MOD
. . S MERGE=1
;
Q MERGE
;
MRGONIMG(PRVRSLT,V,NIMGTAG) ; Sum Number of NIMGTAG values from old and new db
; NIMGTAG is either
; $$NSRSTAG (Number of Study Related Series TAG) or
; $$NSRITAG (Number of Study Related Instances TAG)
;
; find record number for the NIMGTAG of previous record with the same Study UID
N STUDYUID,RECNO
S STUDYUID=V($$STUIDTAG^MAGDQR00)
S RECNO=$$GTAGRECN(PRVRSLT,NIMGTAG,STUDYUID)
;
; if not found, add NIMGTAG entry to sub file (2006.57321)
I 'RECNO D ADDTAGFL(PRVRSLT,NIMGTAG,V(NIMGTAG)) Q
;
; if found, sum up the NIMGTAG value from old and new db
N PAIR,TAG
S PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
S TAG=$P(PAIR,U)
Q:NIMGTAG'=TAG ;should not happen, corrupted data, no merge
;
S $P(PAIR,U,2)=$P(PAIR,U,2)+V(NIMGTAG) ;Sum current NIMGTAG with previous value
D UTAGPAIR(PRVRSLT,RECNO,PAIR)
Q
;
UPDSTDES(PRVRSLT,V) ; Update Study Description
N STDESTAG
S STDESTAG=$$STDESTAG^MAGDQR00 ; Study Description Tag
;
; find record number for Study Description of previous record with the same Study UID
N STUDYUID,RECNO
S STUDYUID=V($$STUIDTAG^MAGDQR00)
S RECNO=$$GTAGRECN(PRVRSLT,STDESTAG,STUDYUID)
;
; if not found, add Study Description to sub file (2006.57321)
I 'RECNO D ADDTAGFL(PRVRSLT,STDESTAG,V(STDESTAG)) Q
;
; if found, update empty Study Description with non empty description
N PAIR,TAG
S PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
S TAG=$P(PAIR,U)
Q:STDESTAG'=TAG ;should not happen, corrupted data, no merge
;
I $P(PAIR,U,2)="" D
. S $P(PAIR,U,2)=V(STDESTAG)
. D UTAGPAIR(PRVRSLT,RECNO,PAIR)
Q
;
SAVREC(RESULT,MAGDFN,MAGIEN,UID,ACCN,PATNAM,V) ; save record (V) to file 2006.5732
; save header
D SAVHDR(RESULT)
; save Image saved date
D SAVIMGDT(RESULT,MAGDFN,MAGIEN,UID)
;
; save each tag/tag value pair to a separate record
N TAG
S TAG=""
F S TAG=$O(V(TAG)) Q:TAG="" D
. D SAVTAG(RESULT,.V,TAG)
. Q
;
; The following TMPs used to identify whether a record need to be merged to previous
; record with the same identities (MAGDFN,ACCN,PATNAM)
S ^TMP("MAG",$J,"DICOMQR","STUDYUID",UID)=RESULT
S ^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM)=""
Q
;
SAVHDR(RESULT) ; Save header
N TAGVAL
S ^TMP("MAG",$J,"DICOMQR","RESULTSET")=$G(^TMP("MAG",$J,"DICOMQR","RESULTSET"))+1
S TAGVAL="Result # "_^TMP("MAG",$J,"DICOMQR","RESULTSET")
D ADDTAGFL(RESULT,$$HDRTAG^MAGDQR00,TAGVAL)
Q
;
SAVIMGDT(RESULT,MAGDFN,MAGIEN,STUDYUID) ; Save Image Saved Date
N IMGSAVDT,RECNO
S IMGSAVDT=$$GETIMGDT(MAGIEN)
S RECNO=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)
S ^TMP("MAG",$J,"QR",99,STUDYUID,IMGSAVDT_" "_MAGDFN,RECNO)=MAGIEN
Q
;
GETIMGDT(MAGIEN) ; Return Image Saved date
; MAGIEN must exist.
; Caller validates the existence of the image in either file 2005 or 2005.64
I $D(^MAG(2005,MAGIEN)) Q $G(^MAG(2005,MAGIEN,2))\1 ;Date Image Saved
I $D(^MAGV(2005.64,MAGIEN)) Q $G(^MAGV(2005.64,MAGIEN,15))\1 ;Last Update Date
Q ""
;
SAVTAG(RESULT,V,TAG) ; Save TAG^TAG_VALUE pair
N TAGVAL
S TAGVAL=$$GTAGVAL(.V,TAG)
D ADDTAGFL(RESULT,TAG,TAGVAL)
;
Q:$D(V(TAG))<10 ;no multiple values
;
; save multiple values V(TAG,TAGRECNO,SEQ)
N TAGRECNO,SEQ
S (TAGRECNO,SEQ)=""
;
F S TAGRECNO=$O(V(TAG,TAGRECNO)) Q:TAGRECNO="" D
. F S SEQ=$O(V(TAG,TAGRECNO,SEQ)) Q:SEQ="" D
. . S TAGVAL=$G(V(TAG,TAGRECNO,SEQ)) Q:TAGVAL=""
. . D ADDTAGFL(RESULT,TAG,TAGVAL)
. . Q
. Q
Q
;
GTAGVAL(V,TAG) ; Get Tag Value
; Values of V(TAG) and V(TAG,SEQ) will be saved as one record using delimiter "\"
N TAGVAL,SEQ
S TAGVAL=$G(V(TAG))
S SEQ=""
;
F S SEQ=$O(V(TAG,SEQ)) Q:SEQ="" D
. Q:$G(V(TAG,SEQ))=""
. S:TAGVAL'="" TAGVAL=TAGVAL_"\"
. S TAGVAL=TAGVAL_V(TAG,SEQ)
. Q
Q TAGVAL
;
GTAGRECN(RESULT,TAG,STUDYUID) ; Return Sub Index for Sub File (2006.57321) for the TAG within RESULT records with STUDYUID
N STUIDTAG,HDRTAG
S STUIDTAG=$$STUIDTAG^MAGDQR00 ; Study UID Tag
S HDRTAG=$$HDRTAG^MAGDQR00 ; Result Header Tag
;
; Find the Result Header Record # for StudyUID
N HDRRECNO,FOUND
S FOUND=0
S HDRRECNO=""
F S HDRRECNO=$O(^MAGDQR(2006.5732,RESULT,1,"B",HDRTAG,HDRRECNO)) Q:HDRRECNO="" D Q:FOUND
. N STUIDRCN
. S STUIDRCN=$O(^MAGDQR(2006.5732,RESULT,1,"B",STUIDTAG,HDRRECNO))
. Q:STUIDRCN=""
. I STUDYUID=$P(^MAGDQR(2006.5732,RESULT,1,STUIDRCN,0),U,2) S FOUND=1
. Q
;
N RECNO
S RECNO=0
S:FOUND RECNO=$O(^MAGDQR(2006.5732,RESULT,1,"B",TAG,HDRRECNO))
Q RECNO
;
ADDTAGFL(RESULT,TAG,TAGVAL) ; Add entry to Sub File (2006.57321)
N LSTRECNO
S LSTRECNO=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)+1
;
N HDR
S HDR=$G(^MAGDQR(2006.5732,RESULT,1,0))
S $P(HDR,U,1,2)="TAG^2006.57321"
S $P(HDR,U,3)=LSTRECNO
S $P(HDR,U,4)=$P(HDR,U,4)+1
S ^MAGDQR(2006.5732,RESULT,1,0)=HDR
;
S ^MAGDQR(2006.5732,RESULT,1,LSTRECNO,0)=TAG_U_TAGVAL
S ^MAGDQR(2006.5732,RESULT,1,"B",TAG,LSTRECNO)=""
Q
;
GTAGPAIR(RESULT,RECNO) ; Given Result and RecNo, Get Tag pair value from File 2006.5732
N TAGPAIR
S TAGPAIR=^MAGDQR(2006.5732,RESULT,1,RECNO,0)
Q TAGPAIR
;
UTAGPAIR(RESULT,RECNO,TAGPAIR) ; Update Result, RecNo of File 2006.5732 with Tag Pair Value
S ^MAGDQR(2006.5732,RESULT,1,RECNO,0)=TAGPAIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR13 10495 printed Sep 23, 2025@19:37:11 Page 2
MAGDQR13 ;WOIFO/EdM/MLH/JSL/SAF/BT - Imaging RPCs for Query/Retrieve - Overflow from MAGDQR03; 10 Apr 2012 2:05 PM ; 06 Aug 2012 2:42 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
+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 ;
+19 ; SAVRSLT^MAGDQR13 is called by MAGDQR03
+20 ;
+21 ; This procedure
+22 ; - saves compiled result (V) to the Query Retrieve Result File (#2006.5732)
+23 ; - merges modalities with the same Study Instance UID
+24 ;
+25 ; Input Parameters
+26 ; ================
+27 ; RESULT = pointer into the Query Retrieve Result File (#2006.5732)
+28 ; MAGDFN = pointer into the Patient File (#2)
+29 ; MAGIEN = pointer into the Image File (#2005 or 2005.64)
+30 ; V = compiled result
+31 ;
+32 ; V Structure
+33 ; ===========
+34 ; V(TAG) = VALUE
+35 ; V(TAG,SEQ) = VALUE
+36 ; V(TAG,SEQ,SEQ2) = VALUE
+37 ;
+38 ; Values of V(TAG) and V(TAG,SEQ) will be merged as one record using delimiter
+39 ; Each value of V(TAG,SEQ,SEQ2) will be saved separately
+40 ;
+41 ; TAG = see MAGDQR00 for list of Supported tags
+42 ;
SAVRSLT(RESULT,MAGDFN,MAGIEN,V) ;
+1 NEW PRVRSLT,STUDYUID,ACCN,PATNAME
+2 ;
+3 ; At this point V($$STUIDTAG) - STUDY INSTANCE UID will exist, caller validates the value before calling this proc
+4 SET STUDYUID=V($$STUIDTAG^MAGDQR00)
+5 ;Accession number
SET ACCN=$GET(V($$ACCNTAG^MAGDQR00))
+6 ;might not be requested in the result
if ACCN=""
SET ACCN="*"
+7 ;patientname
SET PATNAM=$GET(V($$PTNAMTAG^MAGDQR00))
+8 ;might not be requested in the result
if PATNAM=""
SET PATNAM="*"
+9 ;
+10 ; if there are multiple modalities, replace comma delimiter with "\"
+11 NEW MODTAG
+12 SET MODTAG=$$MODTAG^MAGDQR00
+13 if $GET(V(MODTAG))'=""
SET V(MODTAG)=$TRANSLATE(V(MODTAG),",","\")
+14 ;
+15 ; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
+16 SET PRVRSLT=$$GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM)
+17 ; Merge record if there is previous record with the same STUDYUID
+18 IF PRVRSLT>0
DO MERGEREC(PRVRSLT,.V)
QUIT
+19 ; otherwise, save record to file
+20 IF PRVRSLT=0
DO SAVREC(RESULT,MAGDFN,MAGIEN,STUDYUID,ACCN,PATNAM,.V)
+21 ; PRVSLT=-1 Do not save Duplicate Study UID
+22 QUIT
+23 ;
GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM) ; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
+1 ; Return 0 - Study UID not found
+2 ; Record Number - Study UID found
+3 ; -1 - Study UID found but has different patient id, patient name or accession number
+4 ;
+5 ; ^TMP("MAG",$J,"DICOMQR","STUDYUID") and ^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS") below are
+6 ; cross references of file 2006.5732
+7 ;
+8 IF '$DATA(^TMP("MAG",$JOB,"DICOMQR","STUDYUID",STUDYUID))
QUIT 0
+9 IF '$DATA(^TMP("MAG",$JOB,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM))
QUIT -1
+10 QUIT ^TMP("MAG",$JOB,"DICOMQR","STUDYUID",STUDYUID)
+11 ;
MERGEREC(PRVRSLT,V) ; Merge record to previous record with the same UID
+1 ; Merge Modalities
+2 if $GET(V($$MODTAG^MAGDQR00))'=""
DO MRGONMOD(PRVRSLT,.V)
+3 ;
+4 ; Accumulate "Number of Study Related Series" and "Number of Study Related Instances"
+5 NEW NIMGTAG
+6 FOR NIMGTAG=$$NSRSTAG^MAGDQR00,$$NSRITAG^MAGDQR00
if $GET(V(NIMGTAG))
DO MRGONIMG(PRVRSLT,.V,NIMGTAG)
+7 ;
+8 ; Use non empty Study Description
+9 if $GET(V($$STDESTAG^MAGDQR00))'=""
DO UPDSTDES(PRVRSLT,.V)
+10 QUIT
+11 ;
MRGONMOD(PRVRSLT,V) ; Merge modalities from old and new db
+1 ; V(MODTAG) must have value before calling this procedure
+2 NEW MODTAG
+3 SET MODTAG=$$MODTAG^MAGDQR00
+4 ;
+5 ; find record number for the Modalities of previous record with the same Study UID
+6 NEW STUDYUID,STUDYTA,MODRECNO
+7 SET STUDYUID=V($$STUIDTAG^MAGDQR00)
+8 SET MODRECNO=$$GTAGRECN(PRVRSLT,MODTAG,STUDYUID)
+9 ;
+10 ; if not found, add modalities to sub file (2006.57321)
+11 IF 'MODRECNO
DO ADDTAGFL(PRVRSLT,MODTAG,V(MODTAG))
QUIT
+12 ;
+13 ; if found, merge current modalities to previous record with the same Study UID
+14 NEW PAIR,TAG,PREVMOD,MERGE
+15 SET PAIR=$$GTAGPAIR(PRVRSLT,MODRECNO)
+16 SET TAG=$PIECE(PAIR,U)
+17 ;should not happen, corrupted data, no merge
if MODTAG'=TAG
QUIT
+18 ;
+19 ;modalities from previous record
SET PREVMOD=$PIECE(PAIR,U,2)
+20 SET MERGE=$$MERGEMOD(.PREVMOD,V(MODTAG))
+21 if MERGE
DO UTAGPAIR(PRVRSLT,MODRECNO,MODTAG_U_PREVMOD)
+22 QUIT
+23 ;
MERGEMOD(PREVMOD,NEWMOD) ; return the merged modalities
+1 IF PREVMOD=""
SET PREVMOD=NEWMOD
QUIT 1
+2 ;
+3 NEW I,MOD,MERGE
+4 SET MERGE=0
+5 ;
+6 FOR I=1:1:$LENGTH(NEWMOD,"\")
Begin DoDot:1
+7 SET MOD=$PIECE(NEWMOD,"\",I)
+8 IF '$FIND("\"_PREVMOD_"\","\"_MOD_"\")
Begin DoDot:2
+9 SET PREVMOD=PREVMOD_"\"_MOD
+10 SET MERGE=1
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT MERGE
+13 ;
MRGONIMG(PRVRSLT,V,NIMGTAG) ; Sum Number of NIMGTAG values from old and new db
+1 ; NIMGTAG is either
+2 ; $$NSRSTAG (Number of Study Related Series TAG) or
+3 ; $$NSRITAG (Number of Study Related Instances TAG)
+4 ;
+5 ; find record number for the NIMGTAG of previous record with the same Study UID
+6 NEW STUDYUID,RECNO
+7 SET STUDYUID=V($$STUIDTAG^MAGDQR00)
+8 SET RECNO=$$GTAGRECN(PRVRSLT,NIMGTAG,STUDYUID)
+9 ;
+10 ; if not found, add NIMGTAG entry to sub file (2006.57321)
+11 IF 'RECNO
DO ADDTAGFL(PRVRSLT,NIMGTAG,V(NIMGTAG))
QUIT
+12 ;
+13 ; if found, sum up the NIMGTAG value from old and new db
+14 NEW PAIR,TAG
+15 SET PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
+16 SET TAG=$PIECE(PAIR,U)
+17 ;should not happen, corrupted data, no merge
if NIMGTAG'=TAG
QUIT
+18 ;
+19 ;Sum current NIMGTAG with previous value
SET $PIECE(PAIR,U,2)=$PIECE(PAIR,U,2)+V(NIMGTAG)
+20 DO UTAGPAIR(PRVRSLT,RECNO,PAIR)
+21 QUIT
+22 ;
UPDSTDES(PRVRSLT,V) ; Update Study Description
+1 NEW STDESTAG
+2 ; Study Description Tag
SET STDESTAG=$$STDESTAG^MAGDQR00
+3 ;
+4 ; find record number for Study Description of previous record with the same Study UID
+5 NEW STUDYUID,RECNO
+6 SET STUDYUID=V($$STUIDTAG^MAGDQR00)
+7 SET RECNO=$$GTAGRECN(PRVRSLT,STDESTAG,STUDYUID)
+8 ;
+9 ; if not found, add Study Description to sub file (2006.57321)
+10 IF 'RECNO
DO ADDTAGFL(PRVRSLT,STDESTAG,V(STDESTAG))
QUIT
+11 ;
+12 ; if found, update empty Study Description with non empty description
+13 NEW PAIR,TAG
+14 SET PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
+15 SET TAG=$PIECE(PAIR,U)
+16 ;should not happen, corrupted data, no merge
if STDESTAG'=TAG
QUIT
+17 ;
+18 IF $PIECE(PAIR,U,2)=""
Begin DoDot:1
+19 SET $PIECE(PAIR,U,2)=V(STDESTAG)
+20 DO UTAGPAIR(PRVRSLT,RECNO,PAIR)
End DoDot:1
+21 QUIT
+22 ;
SAVREC(RESULT,MAGDFN,MAGIEN,UID,ACCN,PATNAM,V) ; save record (V) to file 2006.5732
+1 ; save header
+2 DO SAVHDR(RESULT)
+3 ; save Image saved date
+4 DO SAVIMGDT(RESULT,MAGDFN,MAGIEN,UID)
+5 ;
+6 ; save each tag/tag value pair to a separate record
+7 NEW TAG
+8 SET TAG=""
+9 FOR
SET TAG=$ORDER(V(TAG))
if TAG=""
QUIT
Begin DoDot:1
+10 DO SAVTAG(RESULT,.V,TAG)
+11 QUIT
End DoDot:1
+12 ;
+13 ; The following TMPs used to identify whether a record need to be merged to previous
+14 ; record with the same identities (MAGDFN,ACCN,PATNAM)
+15 SET ^TMP("MAG",$JOB,"DICOMQR","STUDYUID",UID)=RESULT
+16 SET ^TMP("MAG",$JOB,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM)=""
+17 QUIT
+18 ;
SAVHDR(RESULT) ; Save header
+1 NEW TAGVAL
+2 SET ^TMP("MAG",$JOB,"DICOMQR","RESULTSET")=$GET(^TMP("MAG",$JOB,"DICOMQR","RESULTSET"))+1
+3 SET TAGVAL="Result # "_^TMP("MAG",$JOB,"DICOMQR","RESULTSET")
+4 DO ADDTAGFL(RESULT,$$HDRTAG^MAGDQR00,TAGVAL)
+5 QUIT
+6 ;
SAVIMGDT(RESULT,MAGDFN,MAGIEN,STUDYUID) ; Save Image Saved Date
+1 NEW IMGSAVDT,RECNO
+2 SET IMGSAVDT=$$GETIMGDT(MAGIEN)
+3 SET RECNO=$ORDER(^MAGDQR(2006.5732,RESULT,1," "),-1)
+4 SET ^TMP("MAG",$JOB,"QR",99,STUDYUID,IMGSAVDT_" "_MAGDFN,RECNO)=MAGIEN
+5 QUIT
+6 ;
GETIMGDT(MAGIEN) ; Return Image Saved date
+1 ; MAGIEN must exist.
+2 ; Caller validates the existence of the image in either file 2005 or 2005.64
+3 ;Date Image Saved
IF $DATA(^MAG(2005,MAGIEN))
QUIT $GET(^MAG(2005,MAGIEN,2))\1
+4 ;Last Update Date
IF $DATA(^MAGV(2005.64,MAGIEN))
QUIT $GET(^MAGV(2005.64,MAGIEN,15))\1
+5 QUIT ""
+6 ;
SAVTAG(RESULT,V,TAG) ; Save TAG^TAG_VALUE pair
+1 NEW TAGVAL
+2 SET TAGVAL=$$GTAGVAL(.V,TAG)
+3 DO ADDTAGFL(RESULT,TAG,TAGVAL)
+4 ;
+5 ;no multiple values
if $DATA(V(TAG))<10
QUIT
+6 ;
+7 ; save multiple values V(TAG,TAGRECNO,SEQ)
+8 NEW TAGRECNO,SEQ
+9 SET (TAGRECNO,SEQ)=""
+10 ;
+11 FOR
SET TAGRECNO=$ORDER(V(TAG,TAGRECNO))
if TAGRECNO=""
QUIT
Begin DoDot:1
+12 FOR
SET SEQ=$ORDER(V(TAG,TAGRECNO,SEQ))
if SEQ=""
QUIT
Begin DoDot:2
+13 SET TAGVAL=$GET(V(TAG,TAGRECNO,SEQ))
if TAGVAL=""
QUIT
+14 DO ADDTAGFL(RESULT,TAG,TAGVAL)
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
GTAGVAL(V,TAG) ; Get Tag Value
+1 ; Values of V(TAG) and V(TAG,SEQ) will be saved as one record using delimiter "\"
+2 NEW TAGVAL,SEQ
+3 SET TAGVAL=$GET(V(TAG))
+4 SET SEQ=""
+5 ;
+6 FOR
SET SEQ=$ORDER(V(TAG,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+7 if $GET(V(TAG,SEQ))=""
QUIT
+8 if TAGVAL'=""
SET TAGVAL=TAGVAL_"\"
+9 SET TAGVAL=TAGVAL_V(TAG,SEQ)
+10 QUIT
End DoDot:1
+11 QUIT TAGVAL
+12 ;
GTAGRECN(RESULT,TAG,STUDYUID) ; Return Sub Index for Sub File (2006.57321) for the TAG within RESULT records with STUDYUID
+1 NEW STUIDTAG,HDRTAG
+2 ; Study UID Tag
SET STUIDTAG=$$STUIDTAG^MAGDQR00
+3 ; Result Header Tag
SET HDRTAG=$$HDRTAG^MAGDQR00
+4 ;
+5 ; Find the Result Header Record # for StudyUID
+6 NEW HDRRECNO,FOUND
+7 SET FOUND=0
+8 SET HDRRECNO=""
+9 FOR
SET HDRRECNO=$ORDER(^MAGDQR(2006.5732,RESULT,1,"B",HDRTAG,HDRRECNO))
if HDRRECNO=""
QUIT
Begin DoDot:1
+10 NEW STUIDRCN
+11 SET STUIDRCN=$ORDER(^MAGDQR(2006.5732,RESULT,1,"B",STUIDTAG,HDRRECNO))
+12 if STUIDRCN=""
QUIT
+13 IF STUDYUID=$PIECE(^MAGDQR(2006.5732,RESULT,1,STUIDRCN,0),U,2)
SET FOUND=1
+14 QUIT
End DoDot:1
if FOUND
QUIT
+15 ;
+16 NEW RECNO
+17 SET RECNO=0
+18 if FOUND
SET RECNO=$ORDER(^MAGDQR(2006.5732,RESULT,1,"B",TAG,HDRRECNO))
+19 QUIT RECNO
+20 ;
ADDTAGFL(RESULT,TAG,TAGVAL) ; Add entry to Sub File (2006.57321)
+1 NEW LSTRECNO
+2 SET LSTRECNO=$ORDER(^MAGDQR(2006.5732,RESULT,1," "),-1)+1
+3 ;
+4 NEW HDR
+5 SET HDR=$GET(^MAGDQR(2006.5732,RESULT,1,0))
+6 SET $PIECE(HDR,U,1,2)="TAG^2006.57321"
+7 SET $PIECE(HDR,U,3)=LSTRECNO
+8 SET $PIECE(HDR,U,4)=$PIECE(HDR,U,4)+1
+9 SET ^MAGDQR(2006.5732,RESULT,1,0)=HDR
+10 ;
+11 SET ^MAGDQR(2006.5732,RESULT,1,LSTRECNO,0)=TAG_U_TAGVAL
+12 SET ^MAGDQR(2006.5732,RESULT,1,"B",TAG,LSTRECNO)=""
+13 QUIT
+14 ;
GTAGPAIR(RESULT,RECNO) ; Given Result and RecNo, Get Tag pair value from File 2006.5732
+1 NEW TAGPAIR
+2 SET TAGPAIR=^MAGDQR(2006.5732,RESULT,1,RECNO,0)
+3 QUIT TAGPAIR
+4 ;
UTAGPAIR(RESULT,RECNO,TAGPAIR) ; Update Result, RecNo of File 2006.5732 with Tag Pair Value
+1 SET ^MAGDQR(2006.5732,RESULT,1,RECNO,0)=TAGPAIR
+2 QUIT
