Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDQR13

MAGDQR13.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. ; SAVRSLT^MAGDQR13 is called by MAGDQR03
  1. ;
  1. ; This procedure
  1. ; - saves compiled result (V) to the Query Retrieve Result File (#2006.5732)
  1. ; - merges modalities with the same Study Instance UID
  1. ;
  1. ; Input Parameters
  1. ; ================
  1. ; RESULT = pointer into the Query Retrieve Result File (#2006.5732)
  1. ; MAGDFN = pointer into the Patient File (#2)
  1. ; MAGIEN = pointer into the Image File (#2005 or 2005.64)
  1. ; V = compiled result
  1. ;
  1. ; V Structure
  1. ; ===========
  1. ; V(TAG) = VALUE
  1. ; V(TAG,SEQ) = VALUE
  1. ; V(TAG,SEQ,SEQ2) = VALUE
  1. ;
  1. ; Values of V(TAG) and V(TAG,SEQ) will be merged as one record using delimiter
  1. ; Each value of V(TAG,SEQ,SEQ2) will be saved separately
  1. ;
  1. ; TAG = see MAGDQR00 for list of Supported tags
  1. ;
  1. SAVRSLT(RESULT,MAGDFN,MAGIEN,V) ;
  1. N PRVRSLT,STUDYUID,ACCN,PATNAME
  1. ;
  1. ; At this point V($$STUIDTAG) - STUDY INSTANCE UID will exist, caller validates the value before calling this proc
  1. S STUDYUID=V($$STUIDTAG^MAGDQR00)
  1. S ACCN=$G(V($$ACCNTAG^MAGDQR00)) ;Accession number
  1. S:ACCN="" ACCN="*" ;might not be requested in the result
  1. S PATNAM=$G(V($$PTNAMTAG^MAGDQR00)) ;patientname
  1. S:PATNAM="" PATNAM="*" ;might not be requested in the result
  1. ;
  1. ; if there are multiple modalities, replace comma delimiter with "\"
  1. N MODTAG
  1. S MODTAG=$$MODTAG^MAGDQR00
  1. S:$G(V(MODTAG))'="" V(MODTAG)=$TR(V(MODTAG),",","\")
  1. ;
  1. ; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
  1. S PRVRSLT=$$GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM)
  1. ; Merge record if there is previous record with the same STUDYUID
  1. I PRVRSLT>0 D MERGEREC(PRVRSLT,.V) Q
  1. ; otherwise, save record to file
  1. I PRVRSLT=0 D SAVREC(RESULT,MAGDFN,MAGIEN,STUDYUID,ACCN,PATNAM,.V)
  1. ; PRVSLT=-1 Do not save Duplicate Study UID
  1. Q
  1. ;
  1. GETPRSLT(MAGDFN,STUDYUID,ACCN,PATNAM) ; Get pointer (RESULT) for the given STUDYUID in file 2006.5732
  1. ; Return 0 - Study UID not found
  1. ; Record Number - Study UID found
  1. ; -1 - Study UID found but has different patient id, patient name or accession number
  1. ;
  1. ; ^TMP("MAG",$J,"DICOMQR","STUDYUID") and ^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS") below are
  1. ; cross references of file 2006.5732
  1. ;
  1. I '$D(^TMP("MAG",$J,"DICOMQR","STUDYUID",STUDYUID)) Q 0
  1. I '$D(^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM)) Q -1
  1. Q ^TMP("MAG",$J,"DICOMQR","STUDYUID",STUDYUID)
  1. ;
  1. MERGEREC(PRVRSLT,V) ; Merge record to previous record with the same UID
  1. ; Merge Modalities
  1. D:$G(V($$MODTAG^MAGDQR00))'="" MRGONMOD(PRVRSLT,.V)
  1. ;
  1. ; Accumulate "Number of Study Related Series" and "Number of Study Related Instances"
  1. N NIMGTAG
  1. F NIMGTAG=$$NSRSTAG^MAGDQR00,$$NSRITAG^MAGDQR00 D:$G(V(NIMGTAG)) MRGONIMG(PRVRSLT,.V,NIMGTAG)
  1. ;
  1. ; Use non empty Study Description
  1. D:$G(V($$STDESTAG^MAGDQR00))'="" UPDSTDES(PRVRSLT,.V)
  1. Q
  1. ;
  1. MRGONMOD(PRVRSLT,V) ; Merge modalities from old and new db
  1. ; V(MODTAG) must have value before calling this procedure
  1. N MODTAG
  1. S MODTAG=$$MODTAG^MAGDQR00
  1. ;
  1. ; find record number for the Modalities of previous record with the same Study UID
  1. N STUDYUID,STUDYTA,MODRECNO
  1. S STUDYUID=V($$STUIDTAG^MAGDQR00)
  1. S MODRECNO=$$GTAGRECN(PRVRSLT,MODTAG,STUDYUID)
  1. ;
  1. ; if not found, add modalities to sub file (2006.57321)
  1. I 'MODRECNO D ADDTAGFL(PRVRSLT,MODTAG,V(MODTAG)) Q
  1. ;
  1. ; if found, merge current modalities to previous record with the same Study UID
  1. N PAIR,TAG,PREVMOD,MERGE
  1. S PAIR=$$GTAGPAIR(PRVRSLT,MODRECNO)
  1. S TAG=$P(PAIR,U)
  1. Q:MODTAG'=TAG ;should not happen, corrupted data, no merge
  1. ;
  1. S PREVMOD=$P(PAIR,U,2) ;modalities from previous record
  1. S MERGE=$$MERGEMOD(.PREVMOD,V(MODTAG))
  1. D:MERGE UTAGPAIR(PRVRSLT,MODRECNO,MODTAG_U_PREVMOD)
  1. Q
  1. ;
  1. MERGEMOD(PREVMOD,NEWMOD) ; return the merged modalities
  1. I PREVMOD="" S PREVMOD=NEWMOD Q 1
  1. ;
  1. N I,MOD,MERGE
  1. S MERGE=0
  1. ;
  1. F I=1:1:$L(NEWMOD,"\") D
  1. . S MOD=$P(NEWMOD,"\",I)
  1. . I '$F("\"_PREVMOD_"\","\"_MOD_"\") D
  1. . . S PREVMOD=PREVMOD_"\"_MOD
  1. . . S MERGE=1
  1. ;
  1. Q MERGE
  1. ;
  1. MRGONIMG(PRVRSLT,V,NIMGTAG) ; Sum Number of NIMGTAG values from old and new db
  1. ; NIMGTAG is either
  1. ; $$NSRSTAG (Number of Study Related Series TAG) or
  1. ; $$NSRITAG (Number of Study Related Instances TAG)
  1. ;
  1. ; find record number for the NIMGTAG of previous record with the same Study UID
  1. N STUDYUID,RECNO
  1. S STUDYUID=V($$STUIDTAG^MAGDQR00)
  1. S RECNO=$$GTAGRECN(PRVRSLT,NIMGTAG,STUDYUID)
  1. ;
  1. ; if not found, add NIMGTAG entry to sub file (2006.57321)
  1. I 'RECNO D ADDTAGFL(PRVRSLT,NIMGTAG,V(NIMGTAG)) Q
  1. ;
  1. ; if found, sum up the NIMGTAG value from old and new db
  1. N PAIR,TAG
  1. S PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
  1. S TAG=$P(PAIR,U)
  1. Q:NIMGTAG'=TAG ;should not happen, corrupted data, no merge
  1. ;
  1. S $P(PAIR,U,2)=$P(PAIR,U,2)+V(NIMGTAG) ;Sum current NIMGTAG with previous value
  1. D UTAGPAIR(PRVRSLT,RECNO,PAIR)
  1. Q
  1. ;
  1. UPDSTDES(PRVRSLT,V) ; Update Study Description
  1. N STDESTAG
  1. S STDESTAG=$$STDESTAG^MAGDQR00 ; Study Description Tag
  1. ;
  1. ; find record number for Study Description of previous record with the same Study UID
  1. N STUDYUID,RECNO
  1. S STUDYUID=V($$STUIDTAG^MAGDQR00)
  1. S RECNO=$$GTAGRECN(PRVRSLT,STDESTAG,STUDYUID)
  1. ;
  1. ; if not found, add Study Description to sub file (2006.57321)
  1. I 'RECNO D ADDTAGFL(PRVRSLT,STDESTAG,V(STDESTAG)) Q
  1. ;
  1. ; if found, update empty Study Description with non empty description
  1. N PAIR,TAG
  1. S PAIR=$$GTAGPAIR(PRVRSLT,RECNO)
  1. S TAG=$P(PAIR,U)
  1. Q:STDESTAG'=TAG ;should not happen, corrupted data, no merge
  1. ;
  1. I $P(PAIR,U,2)="" D
  1. . S $P(PAIR,U,2)=V(STDESTAG)
  1. . D UTAGPAIR(PRVRSLT,RECNO,PAIR)
  1. Q
  1. ;
  1. SAVREC(RESULT,MAGDFN,MAGIEN,UID,ACCN,PATNAM,V) ; save record (V) to file 2006.5732
  1. ; save header
  1. D SAVHDR(RESULT)
  1. ; save Image saved date
  1. D SAVIMGDT(RESULT,MAGDFN,MAGIEN,UID)
  1. ;
  1. ; save each tag/tag value pair to a separate record
  1. N TAG
  1. S TAG=""
  1. F S TAG=$O(V(TAG)) Q:TAG="" D
  1. . D SAVTAG(RESULT,.V,TAG)
  1. . Q
  1. ;
  1. ; The following TMPs used to identify whether a record need to be merged to previous
  1. ; record with the same identities (MAGDFN,ACCN,PATNAM)
  1. S ^TMP("MAG",$J,"DICOMQR","STUDYUID",UID)=RESULT
  1. S ^TMP("MAG",$J,"DICOMQR","STUDYUNIQUEFIELDS",MAGDFN,ACCN,PATNAM)=""
  1. Q
  1. ;
  1. SAVHDR(RESULT) ; Save header
  1. N TAGVAL
  1. S ^TMP("MAG",$J,"DICOMQR","RESULTSET")=$G(^TMP("MAG",$J,"DICOMQR","RESULTSET"))+1
  1. S TAGVAL="Result # "_^TMP("MAG",$J,"DICOMQR","RESULTSET")
  1. D ADDTAGFL(RESULT,$$HDRTAG^MAGDQR00,TAGVAL)
  1. Q
  1. ;
  1. SAVIMGDT(RESULT,MAGDFN,MAGIEN,STUDYUID) ; Save Image Saved Date
  1. N IMGSAVDT,RECNO
  1. S IMGSAVDT=$$GETIMGDT(MAGIEN)
  1. S RECNO=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)
  1. S ^TMP("MAG",$J,"QR",99,STUDYUID,IMGSAVDT_" "_MAGDFN,RECNO)=MAGIEN
  1. Q
  1. ;
  1. GETIMGDT(MAGIEN) ; Return Image Saved date
  1. ; MAGIEN must exist.
  1. ; Caller validates the existence of the image in either file 2005 or 2005.64
  1. I $D(^MAG(2005,MAGIEN)) Q $G(^MAG(2005,MAGIEN,2))\1 ;Date Image Saved
  1. I $D(^MAGV(2005.64,MAGIEN)) Q $G(^MAGV(2005.64,MAGIEN,15))\1 ;Last Update Date
  1. Q ""
  1. ;
  1. SAVTAG(RESULT,V,TAG) ; Save TAG^TAG_VALUE pair
  1. N TAGVAL
  1. S TAGVAL=$$GTAGVAL(.V,TAG)
  1. D ADDTAGFL(RESULT,TAG,TAGVAL)
  1. ;
  1. Q:$D(V(TAG))<10 ;no multiple values
  1. ;
  1. ; save multiple values V(TAG,TAGRECNO,SEQ)
  1. N TAGRECNO,SEQ
  1. S (TAGRECNO,SEQ)=""
  1. ;
  1. F S TAGRECNO=$O(V(TAG,TAGRECNO)) Q:TAGRECNO="" D
  1. . F S SEQ=$O(V(TAG,TAGRECNO,SEQ)) Q:SEQ="" D
  1. . . S TAGVAL=$G(V(TAG,TAGRECNO,SEQ)) Q:TAGVAL=""
  1. . . D ADDTAGFL(RESULT,TAG,TAGVAL)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. GTAGVAL(V,TAG) ; Get Tag Value
  1. ; Values of V(TAG) and V(TAG,SEQ) will be saved as one record using delimiter "\"
  1. N TAGVAL,SEQ
  1. S TAGVAL=$G(V(TAG))
  1. S SEQ=""
  1. ;
  1. F S SEQ=$O(V(TAG,SEQ)) Q:SEQ="" D
  1. . Q:$G(V(TAG,SEQ))=""
  1. . S:TAGVAL'="" TAGVAL=TAGVAL_"\"
  1. . S TAGVAL=TAGVAL_V(TAG,SEQ)
  1. . Q
  1. Q TAGVAL
  1. ;
  1. GTAGRECN(RESULT,TAG,STUDYUID) ; Return Sub Index for Sub File (2006.57321) for the TAG within RESULT records with STUDYUID
  1. N STUIDTAG,HDRTAG
  1. S STUIDTAG=$$STUIDTAG^MAGDQR00 ; Study UID Tag
  1. S HDRTAG=$$HDRTAG^MAGDQR00 ; Result Header Tag
  1. ;
  1. ; Find the Result Header Record # for StudyUID
  1. N HDRRECNO,FOUND
  1. S FOUND=0
  1. S HDRRECNO=""
  1. F S HDRRECNO=$O(^MAGDQR(2006.5732,RESULT,1,"B",HDRTAG,HDRRECNO)) Q:HDRRECNO="" D Q:FOUND
  1. . N STUIDRCN
  1. . S STUIDRCN=$O(^MAGDQR(2006.5732,RESULT,1,"B",STUIDTAG,HDRRECNO))
  1. . Q:STUIDRCN=""
  1. . I STUDYUID=$P(^MAGDQR(2006.5732,RESULT,1,STUIDRCN,0),U,2) S FOUND=1
  1. . Q
  1. ;
  1. N RECNO
  1. S RECNO=0
  1. S:FOUND RECNO=$O(^MAGDQR(2006.5732,RESULT,1,"B",TAG,HDRRECNO))
  1. Q RECNO
  1. ;
  1. ADDTAGFL(RESULT,TAG,TAGVAL) ; Add entry to Sub File (2006.57321)
  1. N LSTRECNO
  1. S LSTRECNO=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)+1
  1. ;
  1. N HDR
  1. S HDR=$G(^MAGDQR(2006.5732,RESULT,1,0))
  1. S $P(HDR,U,1,2)="TAG^2006.57321"
  1. S $P(HDR,U,3)=LSTRECNO
  1. S $P(HDR,U,4)=$P(HDR,U,4)+1
  1. S ^MAGDQR(2006.5732,RESULT,1,0)=HDR
  1. ;
  1. S ^MAGDQR(2006.5732,RESULT,1,LSTRECNO,0)=TAG_U_TAGVAL
  1. S ^MAGDQR(2006.5732,RESULT,1,"B",TAG,LSTRECNO)=""
  1. Q
  1. ;
  1. GTAGPAIR(RESULT,RECNO) ; Given Result and RecNo, Get Tag pair value from File 2006.5732
  1. N TAGPAIR
  1. S TAGPAIR=^MAGDQR(2006.5732,RESULT,1,RECNO,0)
  1. Q TAGPAIR
  1. ;
  1. UTAGPAIR(RESULT,RECNO,TAGPAIR) ; Update Result, RecNo of File 2006.5732 with Tag Pair Value
  1. S ^MAGDQR(2006.5732,RESULT,1,RECNO,0)=TAGPAIR
  1. Q