- 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 Feb 18, 2025@23:27:27 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