MAGVRD03 ;WOIFO/DAC - Radiation Dosage - Attach Instance ; 23 May 2017 8:41 AM
;;3.0;IMAGING;**138,172**;Mar 19, 2002;Build 33
;; 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
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
Q "`"
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
Q "|"
STATSEP() ; Status and Result separator ie. -3``No record IEN
Q "`"
;
;***** Get irradiation dosage information
;
; RPC: MAGV GET IRRADIATION DOSE
;
; Input Variables:
; PATIENT - Patient DFN
; PROC - Accession Number
; PROCTYPE - "CT" or "FLUORO" optional
; Output Variable:
; OUT - Array of name value pairs separated by an input separator
;
REFRESH(OUT,PATIENT,PROC,PROCTYPE) ; RPC [MAGV GET IRRADIATION DOSE]
N OSEP,ISEP,SSEP,NAM,VAL,I,J,ATTNAMS,FILE,IIUIDIEN,DOSEIEN,PROCIEN,STUDIEN,SERIEN,TYPE
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
; Quit with error if any input variable not defined
I $G(PATIENT)="" S OUT(1)="-10"_SSEP_"Patient not defined" Q
I $G(PROC)="" S OUT(1)="-11"_SSEP_"Procedure not defined" Q
; Site Specific Accession Number look up
S PROCXREF=$$SSAN(PROC)
I PROCXREF="" S OUT(1)="-13"_SSEP_"Procedure not found" Q
S I=2,IEN="",J=0
S PROCIEN=$O(^MAGV(2005.61,"B",PROCXREF,""))
S STUDIEN=""
F S STUDIEN=$O(^MAGV(2005.62,"C",PROCIEN,STUDIEN)) Q:STUDIEN="" D
. S SERIEN=""
. F S SERIEN=$O(^MAGV(2005.63,"C",STUDIEN,SERIEN)) Q:SERIEN="" D
. . F TYPE="CT","FLUORO" D
. . . I TYPE="CT",$G(PROCTYPE)'="FLUORO" S FILE=2005.632
. . . I TYPE="FLUORO",$G(PROCTYPE)'="CT" S FILE=2005.633
. . . Q:$G(FILE)=""
. . . S DOSEIEN=""
. . . F S DOSEIEN=$O(^MAGV(FILE,"C",SERIEN,DOSEIEN)) Q:DOSEIEN="" D
. . . . D REFRESH2(.OUT,.I,.J,TYPE,DOSEIEN,FILE)
. . . . Q
. . . S FILE=""
. . . Q
. . Q
. Q
S OUT(1)="0"_SSEP_SSEP_J ; Look up successful
Q
;
; ***** Get irradiation dosage information for an irradiation instance
;
; Input variables:
; I - Output array element number
; J - Number of records returned
; DOSEIEN - IEN of dosage instance
; FILE - File number to extract dosage information from (2005.632 or 2005.633)
; Output variable:
; OUT - Array of name value pairs separated by an input separator
;
REFRESH2(OUT,I,J,TYPE,DOSEIEN,FILE) ; Retrieve data from dosage instance
N FNUM,FORMAT,VALUE,TRANIEN,FIELD,IEN,DD
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
S FNUM=.01,J=J+1
S OUT(I)="TYPE"_OSEP_TYPE,I=I+1
; Get dosage instance data
D GETS^DIQ(FILE,DOSEIEN_",","**","I","DD")
F D Q:FNUM=""
. S FNUM=$O(DD(FILE,DOSEIEN_",",FNUM)) Q:FNUM=""
. S FIELD=$$GET1^DID(FILE,FNUM,,"LABEL")
. Q:FIELD="SERIES INSTANCE" ; Don't return Series Instance field
. S FORMAT="E"
. S VALUE=$$GET1^DIQ(FILE,DOSEIEN,FIELD,$G(FORMAT))
. I FIELD="TARGET REGION",VALUE'="" D
. . S IEN=$$GET1^DIQ(FILE,DOSEIEN,FIELD,"I")
. . I '$D(^MAGV(2005.63611,"B",IEN)) Q
. . S TRANIEN=$O(^MAGV(2005.63611,"B",IEN,""))
. . I $G(TRANIEN)'="" S VALUE=$P($G(^MAGV(2005.63611,TRANIEN,0)),U,2)
. . Q
. I FIELD="PHANTOM TYPE",VALUE'="" D
. . S IEN=$$GET1^DIQ(FILE,DOSEIEN,FIELD,"I")
. . I '$D(^MAGV(2005.63621,"B",VALUE)) Q
. . S TRANIEN=$O(^MAGV(2005.63621,"B",IEN,""))
. . I $G(TRANIEN)'="" S VALUE=$P($G(^MAGV(2005.63621,TRANIEN,0)),U,2)
. . Q
. S OUT(I)=FIELD_OSEP_VALUE
. S I=I+1
. Q
Q
;
; ***** Compare accession number for site specific and non-site specific accession numbers
;
; Input Variable:
; PROC - Accession number in either site specific or non site specific form
;
; Output:
; Returns accession number stored in PROCEDURE REFRENCE (#2005.61) file
;
SSAN(PROC) ; Site specific accession number function
N PROCXREF
; Scenario 1 - match
S PROCXREF=""
I $D(^MAGV(2005.61,"B",PROC)) Q PROC
; Scenario 2 - long (in) / short (DB x-ref)
S PROCXREF=""
I $L(PROC,"-")=3 S PROCXREF=$P(PROC,"-",2)_"-"_$P(PROC,"-",3) Q:$D(^MAGV(2005.61,"B",PROCXREF)) PROCXREF
; Scenario 3 - short (in) / long (DB x-ref)
S PROCXREF=""
I $L(PROC,"-")=2 D
. ; P172 DAC - Fixed to remove incorrect partial matches
. F S PROCXREF=$O(^MAGV(2005.61,"B",PROCXREF)) D Q:($P(PROCXREF,"-",2)_"-"_$P(PROCXREF,"-",3)=PROC)!(PROCXREF="")
. Q
Q PROCXREF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRD03 5450 printed Oct 16, 2024@18:10:42 Page 2
MAGVRD03 ;WOIFO/DAC - Radiation Dosage - Attach Instance ; 23 May 2017 8:41 AM
+1 ;;3.0;IMAGING;**138,172**;Mar 19, 2002;Build 33
+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
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
+1 QUIT "`"
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
+1 QUIT "|"
STATSEP() ; Status and Result separator ie. -3``No record IEN
+1 QUIT "`"
+2 ;
+3 ;***** Get irradiation dosage information
+4 ;
+5 ; RPC: MAGV GET IRRADIATION DOSE
+6 ;
+7 ; Input Variables:
+8 ; PATIENT - Patient DFN
+9 ; PROC - Accession Number
+10 ; PROCTYPE - "CT" or "FLUORO" optional
+11 ; Output Variable:
+12 ; OUT - Array of name value pairs separated by an input separator
+13 ;
REFRESH(OUT,PATIENT,PROC,PROCTYPE) ; RPC [MAGV GET IRRADIATION DOSE]
+1 NEW OSEP,ISEP,SSEP,NAM,VAL,I,J,ATTNAMS,FILE,IIUIDIEN,DOSEIEN,PROCIEN,STUDIEN,SERIEN,TYPE
+2 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
+3 ; Quit with error if any input variable not defined
+4 IF $GET(PATIENT)=""
SET OUT(1)="-10"_SSEP_"Patient not defined"
QUIT
+5 IF $GET(PROC)=""
SET OUT(1)="-11"_SSEP_"Procedure not defined"
QUIT
+6 ; Site Specific Accession Number look up
+7 SET PROCXREF=$$SSAN(PROC)
+8 IF PROCXREF=""
SET OUT(1)="-13"_SSEP_"Procedure not found"
QUIT
+9 SET I=2
SET IEN=""
SET J=0
+10 SET PROCIEN=$ORDER(^MAGV(2005.61,"B",PROCXREF,""))
+11 SET STUDIEN=""
+12 FOR
SET STUDIEN=$ORDER(^MAGV(2005.62,"C",PROCIEN,STUDIEN))
if STUDIEN=""
QUIT
Begin DoDot:1
+13 SET SERIEN=""
+14 FOR
SET SERIEN=$ORDER(^MAGV(2005.63,"C",STUDIEN,SERIEN))
if SERIEN=""
QUIT
Begin DoDot:2
+15 FOR TYPE="CT","FLUORO"
Begin DoDot:3
+16 IF TYPE="CT"
IF $GET(PROCTYPE)'="FLUORO"
SET FILE=2005.632
+17 IF TYPE="FLUORO"
IF $GET(PROCTYPE)'="CT"
SET FILE=2005.633
+18 if $GET(FILE)=""
QUIT
+19 SET DOSEIEN=""
+20 FOR
SET DOSEIEN=$ORDER(^MAGV(FILE,"C",SERIEN,DOSEIEN))
if DOSEIEN=""
QUIT
Begin DoDot:4
+21 DO REFRESH2(.OUT,.I,.J,TYPE,DOSEIEN,FILE)
+22 QUIT
End DoDot:4
+23 SET FILE=""
+24 QUIT
End DoDot:3
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 ; Look up successful
SET OUT(1)="0"_SSEP_SSEP_J
+28 QUIT
+29 ;
+30 ; ***** Get irradiation dosage information for an irradiation instance
+31 ;
+32 ; Input variables:
+33 ; I - Output array element number
+34 ; J - Number of records returned
+35 ; DOSEIEN - IEN of dosage instance
+36 ; FILE - File number to extract dosage information from (2005.632 or 2005.633)
+37 ; Output variable:
+38 ; OUT - Array of name value pairs separated by an input separator
+39 ;
REFRESH2(OUT,I,J,TYPE,DOSEIEN,FILE) ; Retrieve data from dosage instance
+1 NEW FNUM,FORMAT,VALUE,TRANIEN,FIELD,IEN,DD
+2 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
+3 SET FNUM=.01
SET J=J+1
+4 SET OUT(I)="TYPE"_OSEP_TYPE
SET I=I+1
+5 ; Get dosage instance data
+6 DO GETS^DIQ(FILE,DOSEIEN_",","**","I","DD")
+7 FOR
Begin DoDot:1
+8 SET FNUM=$ORDER(DD(FILE,DOSEIEN_",",FNUM))
if FNUM=""
QUIT
+9 SET FIELD=$$GET1^DID(FILE,FNUM,,"LABEL")
+10 ; Don't return Series Instance field
if FIELD="SERIES INSTANCE"
QUIT
+11 SET FORMAT="E"
+12 SET VALUE=$$GET1^DIQ(FILE,DOSEIEN,FIELD,$GET(FORMAT))
+13 IF FIELD="TARGET REGION"
IF VALUE'=""
Begin DoDot:2
+14 SET IEN=$$GET1^DIQ(FILE,DOSEIEN,FIELD,"I")
+15 IF '$DATA(^MAGV(2005.63611,"B",IEN))
QUIT
+16 SET TRANIEN=$ORDER(^MAGV(2005.63611,"B",IEN,""))
+17 IF $GET(TRANIEN)'=""
SET VALUE=$PIECE($GET(^MAGV(2005.63611,TRANIEN,0)),U,2)
+18 QUIT
End DoDot:2
+19 IF FIELD="PHANTOM TYPE"
IF VALUE'=""
Begin DoDot:2
+20 SET IEN=$$GET1^DIQ(FILE,DOSEIEN,FIELD,"I")
+21 IF '$DATA(^MAGV(2005.63621,"B",VALUE))
QUIT
+22 SET TRANIEN=$ORDER(^MAGV(2005.63621,"B",IEN,""))
+23 IF $GET(TRANIEN)'=""
SET VALUE=$PIECE($GET(^MAGV(2005.63621,TRANIEN,0)),U,2)
+24 QUIT
End DoDot:2
+25 SET OUT(I)=FIELD_OSEP_VALUE
+26 SET I=I+1
+27 QUIT
End DoDot:1
if FNUM=""
QUIT
+28 QUIT
+29 ;
+30 ; ***** Compare accession number for site specific and non-site specific accession numbers
+31 ;
+32 ; Input Variable:
+33 ; PROC - Accession number in either site specific or non site specific form
+34 ;
+35 ; Output:
+36 ; Returns accession number stored in PROCEDURE REFRENCE (#2005.61) file
+37 ;
SSAN(PROC) ; Site specific accession number function
+1 NEW PROCXREF
+2 ; Scenario 1 - match
+3 SET PROCXREF=""
+4 IF $DATA(^MAGV(2005.61,"B",PROC))
QUIT PROC
+5 ; Scenario 2 - long (in) / short (DB x-ref)
+6 SET PROCXREF=""
+7 IF $LENGTH(PROC,"-")=3
SET PROCXREF=$PIECE(PROC,"-",2)_"-"_$PIECE(PROC,"-",3)
if $DATA(^MAGV(2005.61,"B",PROCXREF))
QUIT PROCXREF
+8 ; Scenario 3 - short (in) / long (DB x-ref)
+9 SET PROCXREF=""
+10 IF $LENGTH(PROC,"-")=2
Begin DoDot:1
+11 ; P172 DAC - Fixed to remove incorrect partial matches
+12 FOR
SET PROCXREF=$ORDER(^MAGV(2005.61,"B",PROCXREF))
Begin DoDot:2
End DoDot:2
if ($PIECE(PROCXREF,"-",2)_"-"_$PIECE(PROCXREF,"-",3)=PROC)!(PROCXREF="")
QUIT
+13 QUIT
End DoDot:1
+14 QUIT PROCXREF
