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

RADUTL.m

Go to the documentation of this file.
  1. RADUTL ;HISC/GJC Radiation dosage data filing utility ;12 Jul 2017 9:37 AM
  1. ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
  1. ;
  1. ;<<< Business rules >>>
  1. ;-Exam moved to a status of 'Complete': Initially create the record in
  1. ; 70.3. Call the VI API and get dose parameters. Store the relevant
  1. ; radiation dose data in file 70.3.
  1. ;
  1. ;-Exam backed down from a status of 'Complete': Do nothing; leave rad
  1. ; dose data tied to the study
  1. ;
  1. ;-Exam moved to a status of 'Complete' for a second/nth time: Delete
  1. ; existing rad dosage data. Call the VI API and get up to date rad
  1. ; dose parameters. Store the relevant rad dose data in file 70.3.
  1. ;
  1. ;-Exam deleted: The exam is deleted from the database (file 70).
  1. ; The rad dosage data tied to the study, a study which no longer
  1. ; exists, cannot be referenced via an exam. Therefore, the rad dose
  1. ; data record in file 70.3 tied to that study is also deleted.
  1. ;<<< end business rules >>>
  1. ;
  1. ;--- IAs ---
  1. ;Call Number Type
  1. ;------------------------------------------------
  1. ;FILE^DIE 2056 S
  1. ;UPDATE^DIE 2056 S
  1. ;REFRESH^MAGVRD03 6000 P
  1. ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
  1. ;
  1. Q
  1. ;
  1. DEL(Y) ;delete the top level record from file 70.3
  1. ;called from option: RA DELETEXAM -Exam Deletion
  1. ;Input: Y - the top level IEN from file 70.3
  1. N DIERR,RAFDA,RAIEN
  1. S RAIEN=Y_",",RAFDA(70.3,RAIEN,.01)="@" D UPDATE^DIE("","RAFDA")
  1. Q
  1. ;
  1. UPCT(RAX,RAII,RAIEN) ;update the CT sub-file 70.31
  1. ;input: RAX array - RAX(IIUID,fld #)=data for that field
  1. ; RAII - irradiation instance UID value
  1. ; RAIENS - IEN top level record # for 70.3
  1. ;*** First find the IIUID record, if not found add it as new ***
  1. N RAFDA,RAH,RAIENS,RAXX,RAY S RAXX="?+1,"_RAIEN_","
  1. S RAFDA(70.31,RAXX,.01)=RAII
  1. D UPDATE^DIE("E","RAFDA","RAY(1)")
  1. Q:$D(DIERR)#2
  1. S RAH=$G(RAY(1,1))
  1. Q:'RAH S RAIENS=RAH_","_RAIEN_","
  1. ;
  1. ;*** file the remaining (non .01 field) CT data ***
  1. S RAH=.01 K RAFDA
  1. F S RAH=$O(RAX(RAII,RAH)) Q:RAH'>0 D
  1. .S RAFDA(70.31,RAIENS,RAH)=$G(RAX(RAII,RAH))
  1. .Q
  1. D FILE^DIE("E","RAFDA")
  1. Q
  1. ;
  1. EDTFL(RAP,RAQ,RAR,RAS,RAIENS) ;edit fluoroscopy specific data
  1. ;<< assumed RADFN, RADTE & RACN are defined globally >>
  1. ;Input: RAP - DOSE COLLECTED WITHIN THE VA? (#.04)
  1. ; RAQ - AIR KERMA (#.05)
  1. ; RAR - AIR KERMA AREA PRODUCT (#.06)
  1. ; RAS - TOTAL FLUOROSCOPY TIME (#.07)
  1. ; RAIENS - IEN file 70.3
  1. ;
  1. ;Note: All input variables are REQUIRED. If an input
  1. ;value is null the value in the field, if any, will
  1. ;be deleted.
  1. N DIERR,RAFDA
  1. Q:RAIENS="" S RAIENS=RAIENS_","
  1. S RAFDA(70.3,RAIENS,.04)=RAP
  1. S RAFDA(70.3,RAIENS,.05)=RAQ
  1. S RAFDA(70.3,RAIENS,.06)=RAR
  1. S RAFDA(70.3,RAIENS,.07)=RAS
  1. D FILE^DIE("","RAFDA")
  1. Q
  1. ;
  1. FIND(RADFN,RADTE,RACN) ;find the record in file 70.3
  1. ;Input: RADFN = DFN of the Radiology patient
  1. ; RADTE = the EXAM DATE (FM internal value)
  1. ; RACN = case number of the study
  1. ;
  1. ;Output: the IEN of the 70.3 record or null
  1. ;
  1. Q $O(^RAD("ARAD",RADTE,RADFN,RACN,0))
  1. ;
  1. NEW(RADFN,RADTE,RACN) ;create a radiation absorbtion dose (RAD) record
  1. ;(top-level) for this exam
  1. ;Input: RADFN - the DFN of the patient
  1. ; RADTE - the exam date w/time (FM internal format)
  1. ; RACN - the case number on the exam
  1. ;Return: if successful the record number is returned else return
  1. ;an error message.
  1. N DIERR,RAFDA,RAIEN703
  1. S RAFDA(70.3,"+1,",.01)=RADFN
  1. S RAFDA(70.3,"+1,",.02)=RADTE,RAFDA(70.3,"+1,",.03)=RACN
  1. D UPDATE^DIE("","RAFDA","RAIEN703")
  1. S RAIEN703=$S(+$G(RAIEN703(1))>0:RAIEN703(1),1:"-1^unable to create a radiation dose record for this exam")
  1. Q RAIEN703
  1. ;
  1. ;----------------------------------------------------------------
  1. ;
  1. RADPTR(RADFN,RADTI,RACNI,Y) ;file/delete the pointer value from 70.3 from
  1. ;the RADIATION ABSORBED DOSAGE (1.1) field of the EXAMINATION (70.03)
  1. ;sub-file.
  1. ;Input: RADFN - the DFN of the patient DA(2)
  1. ; RADTI - inverse exam date/time DA(1)
  1. ; RACNI - the exam record number DA
  1. ; Y - if filing the file 70.3 record number
  1. ; if deleting the "@"
  1. ;
  1. N DIERR,RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_","
  1. S RAFDA(70.03,RAIENS,1.1)=Y D FILE^DIE("","RAFDA")
  1. Q
  1. ;
  1. II(X) ;check the data integrity of the Irradiation Instance UID (IIUID).
  1. ;Definition: IIUID is defined as a character string containing a UID
  1. ;that is used to uniquely identify a wide variety of items. The UID
  1. ;is a series of numeric components separated by the period "."
  1. ;character. If a Value Field containing one or more UIDs is an
  1. ;odd number of bytes in length, the Value Field shall be padded
  1. ;with a single trailing NULL (00H) character (binary: 00000000)
  1. ;to ensure that the Value Field is an even number of bytes in length.
  1. ;
  1. ;Data format: "0"-"9", "." (A series of numeric components separated
  1. ;by the period "." character)
  1. ;
  1. ;Length: 64 bytes maximum
  1. ;
  1. ;Input: X = the IIUID with padding or w/o padding
  1. ;Return: the IIUID w/o padding
  1. ;
  1. Q $P(X,$C(0),1)
  1. ;
  1. GETDOSE ;call the Imaging API which returns radiation dose data for a study
  1. ; RADFN, RADTI & RACNI exist
  1. ; RAY2, RAY3 & RAIT set in RAORDC
  1. ; $P(RAY3,U) = case #
  1. N D,FLD,I,II,P,Q,RACCNUM,RADOSE,RAIEN,RAII,RAQ,RARY,X
  1. ;S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. ;S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. S RACCNUM=$P(RAY3,U,31) ;SSAN
  1. S:RACCNUM="" RACCNUM=$E(RAY2,4,7)_$E(RAY2,2,3)_"-"_$P(RAY3,U)
  1. ;S X=$P($G(^RA(79.2,$P(RAY2,U,2),0)),U,3) ;abbreviation
  1. ;S RAIT=$S(X="RAD":"FLUORO",1:"CT")
  1. ;
  1. D REFRESH^MAGVRD03(.RARY,RADFN,RACCNUM,RAIT)
  1. Q:+RARY(1)'=0 ;'0' indicates the call was a success; else quit
  1. Q:$P(RARY(1),"`",3)=0 ;call a success but no data
  1. ;
  1. ;set RADTE if it is not defined
  1. S:'$D(RADTE)#2 RADTE=9999999.9999-RADTI ;P119 h/t Fayetteville, NC
  1. ;is there an existing rad dose record for this study?
  1. S RADOSE=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U)
  1. ;if RADOSE="" create new record in file 70.3
  1. S:RADOSE="" RADOSE=$$NEW(RADFN,RADTE,$P(RAY3,U))
  1. ;
  1. ;<<< FORMAT the data into a structure I can use. Note: the variable 'D' will act as my delimiter >>>
  1. S D="|"
  1. ;
  1. ; Note: Each new CT repetition starts with TYPE
  1. ; as a label
  1. ;
  1. ;CT from: ARRAY(n)=field name_D_value
  1. ; to: RAQ(IIUID,field 70.31)=value
  1. ;IRRADIATION INSTANCE -> fld: .01; TARGET REGION -> fld: 2
  1. ;PHANTOM TYPE -> fld: 3; CTDIvol -> fld: 4 and DLP -> fld: 5
  1. I RAIT="CT" D
  1. .K RAQ S RAI=$O(RARY(0)) ;# rec indicator
  1. .S RAI=0 F S RAI=$O(RARY(RAI)) Q:RAI'>0 D
  1. ..S X=$G(RARY(RAI))
  1. ..I $P(X,D,1)="IRRADIATION INSTANCE UID" D
  1. ...S II=$$II($P(X,D,2)) ;IIUID
  1. ...S RAQ(II,.01)=II
  1. ...Q
  1. ..;I $P(X,D,1)="TARGET REGION" S RAQ(II,2)=$P(X,D,2) ;T6 don't file TR
  1. ..I $P(X,D,1)="PHANTOM TYPE" S RAQ(II,3)=$P(X,D,2)
  1. ..I $P(X,D,1)="CTDIVOL" S RAQ(II,4)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119
  1. ..I $P(X,D,1)="DLP" S RAQ(II,5)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119
  1. ..; $S added for fields 4 & 5 above to record a null value as an empty field
  1. ..; +$P(X,D,2) used to turn 5.100000000 to 5.1
  1. ..; reports will display values to their proper fractional part precision
  1. ..Q
  1. .K RARY S RAII=""
  1. .F S RAII=$O(RAQ(RAII)) Q:RAII="" D
  1. ..D UPCT(.RAQ,RAII,RADOSE) ;update CT multiple
  1. ..Q
  1. .K I,II,RAI,RAII,RAQ,X
  1. .Q
  1. ;
  1. ;
  1. ;FLUORO from: ARRAY(n)=field name_D_value
  1. ; to: RAQ(field 70.3)=value
  1. E D ;else if RAIT="FLUORO"
  1. .;TOTAL TIME IN FLUOROSCOPY (2005.633,2) maps to
  1. .; TOTAL FLUOROSCOPY TIME (70.3,.07)
  1. .;
  1. .;CINE DOSE (RP) TOTAL (2005.633,12) + FLUORO DOSE (RP) TOTAL (2005.633,10)
  1. .; maps to the RIS' AIR KERMA (70.3,.05) field
  1. .;
  1. .;FLUORO DOSE AREA PRODUCT TOTAL (2005.633,11) +
  1. .; CINE DOSE AREA PRODUCT TOTAL (2005.633,13)
  1. .; maps to AIR KERMA AREA PRODUCT (70.3,.06)
  1. .;
  1. .S T="0^0^0"
  1. .;first piece RIS' AIR KERMA (70.3,.05)
  1. .;second piece RIS' AIR KERMA AREA PRODUCT (70.3,.06)
  1. .;third piece RIS' TOTAL FLUOROSCOPY TIME (70.3,.07)
  1. .;
  1. .S RAI=$O(RARY(0)) ;# rec indicator
  1. .F S RAI=$O(RARY(RAI)) Q:RAI'>0 D
  1. ..S X=$G(RARY(RAI))
  1. ..S:$P(X,D,1)="CINE DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6
  1. ..S:$P(X,D,1)="FLUORO DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6
  1. ..;
  1. ..S:$P(X,D,1)="FLUORO DOSE AREA PRODUCT TOTAL" $P(T,U,2)=$P(T,U,2)+(+$FN($P(X,D,2),"",9)) ;p119T6
  1. ..S:$P(X,D,1)="CINE DOSE AREA PRODUCT TOTAL" $P(T,U,2)=$P(T,U,2)+(+$FN($P(X,D,2),"",9)) ;p119T6
  1. ..;
  1. ..S:$P(X,D,1)="TOTAL TIME IN FLUOROSCOPY" $P(T,U,3)=$P(T,U,3)+$P(X,D,2)
  1. ..Q
  1. .;file fluoro data into file 70.3
  1. .K RARY D EDTFL("",$P(T,U,1),$P(T,U,2),$P(T,U,3),RADOSE)
  1. .K RAI,T,X
  1. .Q
  1. ;
  1. ;
  1. ;<<< update the EXAMINATIONS sub-file's >>>
  1. ; RADIATION ABSORBED DOSE field (#1.1)
  1. D RADPTR(RADFN,RADTI,RACNI,RADOSE)
  1. Q
  1. ;