RADUTL ;HISC/GJC Radiation dosage data filing utility ;12 Jul 2017 9:37 AM
;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
;
;<<< Business rules >>>
;-Exam moved to a status of 'Complete': Initially create the record in
; 70.3. Call the VI API and get dose parameters. Store the relevant
; radiation dose data in file 70.3.
;
;-Exam backed down from a status of 'Complete': Do nothing; leave rad
; dose data tied to the study
;
;-Exam moved to a status of 'Complete' for a second/nth time: Delete
; existing rad dosage data. Call the VI API and get up to date rad
; dose parameters. Store the relevant rad dose data in file 70.3.
;
;-Exam deleted: The exam is deleted from the database (file 70).
; The rad dosage data tied to the study, a study which no longer
; exists, cannot be referenced via an exam. Therefore, the rad dose
; data record in file 70.3 tied to that study is also deleted.
;<<< end business rules >>>
;
;--- IAs ---
;Call Number Type
;------------------------------------------------
;FILE^DIE 2056 S
;UPDATE^DIE 2056 S
;REFRESH^MAGVRD03 6000 P
;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
;
Q
;
DEL(Y) ;delete the top level record from file 70.3
;called from option: RA DELETEXAM -Exam Deletion
;Input: Y - the top level IEN from file 70.3
N DIERR,RAFDA,RAIEN
S RAIEN=Y_",",RAFDA(70.3,RAIEN,.01)="@" D UPDATE^DIE("","RAFDA")
Q
;
UPCT(RAX,RAII,RAIEN) ;update the CT sub-file 70.31
;input: RAX array - RAX(IIUID,fld #)=data for that field
; RAII - irradiation instance UID value
; RAIENS - IEN top level record # for 70.3
;*** First find the IIUID record, if not found add it as new ***
N RAFDA,RAH,RAIENS,RAXX,RAY S RAXX="?+1,"_RAIEN_","
S RAFDA(70.31,RAXX,.01)=RAII
D UPDATE^DIE("E","RAFDA","RAY(1)")
Q:$D(DIERR)#2
S RAH=$G(RAY(1,1))
Q:'RAH S RAIENS=RAH_","_RAIEN_","
;
;*** file the remaining (non .01 field) CT data ***
S RAH=.01 K RAFDA
F S RAH=$O(RAX(RAII,RAH)) Q:RAH'>0 D
.S RAFDA(70.31,RAIENS,RAH)=$G(RAX(RAII,RAH))
.Q
D FILE^DIE("E","RAFDA")
Q
;
EDTFL(RAP,RAQ,RAR,RAS,RAIENS) ;edit fluoroscopy specific data
;<< assumed RADFN, RADTE & RACN are defined globally >>
;Input: RAP - DOSE COLLECTED WITHIN THE VA? (#.04)
; RAQ - AIR KERMA (#.05)
; RAR - AIR KERMA AREA PRODUCT (#.06)
; RAS - TOTAL FLUOROSCOPY TIME (#.07)
; RAIENS - IEN file 70.3
;
;Note: All input variables are REQUIRED. If an input
;value is null the value in the field, if any, will
;be deleted.
N DIERR,RAFDA
Q:RAIENS="" S RAIENS=RAIENS_","
S RAFDA(70.3,RAIENS,.04)=RAP
S RAFDA(70.3,RAIENS,.05)=RAQ
S RAFDA(70.3,RAIENS,.06)=RAR
S RAFDA(70.3,RAIENS,.07)=RAS
D FILE^DIE("","RAFDA")
Q
;
FIND(RADFN,RADTE,RACN) ;find the record in file 70.3
;Input: RADFN = DFN of the Radiology patient
; RADTE = the EXAM DATE (FM internal value)
; RACN = case number of the study
;
;Output: the IEN of the 70.3 record or null
;
Q $O(^RAD("ARAD",RADTE,RADFN,RACN,0))
;
NEW(RADFN,RADTE,RACN) ;create a radiation absorbtion dose (RAD) record
;(top-level) for this exam
;Input: RADFN - the DFN of the patient
; RADTE - the exam date w/time (FM internal format)
; RACN - the case number on the exam
;Return: if successful the record number is returned else return
;an error message.
N DIERR,RAFDA,RAIEN703
S RAFDA(70.3,"+1,",.01)=RADFN
S RAFDA(70.3,"+1,",.02)=RADTE,RAFDA(70.3,"+1,",.03)=RACN
D UPDATE^DIE("","RAFDA","RAIEN703")
S RAIEN703=$S(+$G(RAIEN703(1))>0:RAIEN703(1),1:"-1^unable to create a radiation dose record for this exam")
Q RAIEN703
;
;----------------------------------------------------------------
;
RADPTR(RADFN,RADTI,RACNI,Y) ;file/delete the pointer value from 70.3 from
;the RADIATION ABSORBED DOSAGE (1.1) field of the EXAMINATION (70.03)
;sub-file.
;Input: RADFN - the DFN of the patient DA(2)
; RADTI - inverse exam date/time DA(1)
; RACNI - the exam record number DA
; Y - if filing the file 70.3 record number
; if deleting the "@"
;
N DIERR,RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_","
S RAFDA(70.03,RAIENS,1.1)=Y D FILE^DIE("","RAFDA")
Q
;
II(X) ;check the data integrity of the Irradiation Instance UID (IIUID).
;Definition: IIUID is defined as a character string containing a UID
;that is used to uniquely identify a wide variety of items. The UID
;is a series of numeric components separated by the period "."
;character. If a Value Field containing one or more UIDs is an
;odd number of bytes in length, the Value Field shall be padded
;with a single trailing NULL (00H) character (binary: 00000000)
;to ensure that the Value Field is an even number of bytes in length.
;
;Data format: "0"-"9", "." (A series of numeric components separated
;by the period "." character)
;
;Length: 64 bytes maximum
;
;Input: X = the IIUID with padding or w/o padding
;Return: the IIUID w/o padding
;
Q $P(X,$C(0),1)
;
GETDOSE ;call the Imaging API which returns radiation dose data for a study
; RADFN, RADTI & RACNI exist
; RAY2, RAY3 & RAIT set in RAORDC
; $P(RAY3,U) = case #
N D,FLD,I,II,P,Q,RACCNUM,RADOSE,RAIEN,RAII,RAQ,RARY,X
;S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
;S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
S RACCNUM=$P(RAY3,U,31) ;SSAN
S:RACCNUM="" RACCNUM=$E(RAY2,4,7)_$E(RAY2,2,3)_"-"_$P(RAY3,U)
;S X=$P($G(^RA(79.2,$P(RAY2,U,2),0)),U,3) ;abbreviation
;S RAIT=$S(X="RAD":"FLUORO",1:"CT")
;
D REFRESH^MAGVRD03(.RARY,RADFN,RACCNUM,RAIT)
Q:+RARY(1)'=0 ;'0' indicates the call was a success; else quit
Q:$P(RARY(1),"`",3)=0 ;call a success but no data
;
;set RADTE if it is not defined
S:'$D(RADTE)#2 RADTE=9999999.9999-RADTI ;P119 h/t Fayetteville, NC
;is there an existing rad dose record for this study?
S RADOSE=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U)
;if RADOSE="" create new record in file 70.3
S:RADOSE="" RADOSE=$$NEW(RADFN,RADTE,$P(RAY3,U))
;
;<<< FORMAT the data into a structure I can use. Note: the variable 'D' will act as my delimiter >>>
S D="|"
;
; Note: Each new CT repetition starts with TYPE
; as a label
;
;CT from: ARRAY(n)=field name_D_value
; to: RAQ(IIUID,field 70.31)=value
;IRRADIATION INSTANCE -> fld: .01; TARGET REGION -> fld: 2
;PHANTOM TYPE -> fld: 3; CTDIvol -> fld: 4 and DLP -> fld: 5
I RAIT="CT" D
.K RAQ S RAI=$O(RARY(0)) ;# rec indicator
.S RAI=0 F S RAI=$O(RARY(RAI)) Q:RAI'>0 D
..S X=$G(RARY(RAI))
..I $P(X,D,1)="IRRADIATION INSTANCE UID" D
...S II=$$II($P(X,D,2)) ;IIUID
...S RAQ(II,.01)=II
...Q
..;I $P(X,D,1)="TARGET REGION" S RAQ(II,2)=$P(X,D,2) ;T6 don't file TR
..I $P(X,D,1)="PHANTOM TYPE" S RAQ(II,3)=$P(X,D,2)
..I $P(X,D,1)="CTDIVOL" S RAQ(II,4)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119
..I $P(X,D,1)="DLP" S RAQ(II,5)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119
..; $S added for fields 4 & 5 above to record a null value as an empty field
..; +$P(X,D,2) used to turn 5.100000000 to 5.1
..; reports will display values to their proper fractional part precision
..Q
.K RARY S RAII=""
.F S RAII=$O(RAQ(RAII)) Q:RAII="" D
..D UPCT(.RAQ,RAII,RADOSE) ;update CT multiple
..Q
.K I,II,RAI,RAII,RAQ,X
.Q
;
;
;FLUORO from: ARRAY(n)=field name_D_value
; to: RAQ(field 70.3)=value
E D ;else if RAIT="FLUORO"
.;TOTAL TIME IN FLUOROSCOPY (2005.633,2) maps to
.; TOTAL FLUOROSCOPY TIME (70.3,.07)
.;
.;CINE DOSE (RP) TOTAL (2005.633,12) + FLUORO DOSE (RP) TOTAL (2005.633,10)
.; maps to the RIS' AIR KERMA (70.3,.05) field
.;
.;FLUORO DOSE AREA PRODUCT TOTAL (2005.633,11) +
.; CINE DOSE AREA PRODUCT TOTAL (2005.633,13)
.; maps to AIR KERMA AREA PRODUCT (70.3,.06)
.;
.S T="0^0^0"
.;first piece RIS' AIR KERMA (70.3,.05)
.;second piece RIS' AIR KERMA AREA PRODUCT (70.3,.06)
.;third piece RIS' TOTAL FLUOROSCOPY TIME (70.3,.07)
.;
.S RAI=$O(RARY(0)) ;# rec indicator
.F S RAI=$O(RARY(RAI)) Q:RAI'>0 D
..S X=$G(RARY(RAI))
..S:$P(X,D,1)="CINE DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6
..S:$P(X,D,1)="FLUORO DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6
..;
..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
..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
..;
..S:$P(X,D,1)="TOTAL TIME IN FLUOROSCOPY" $P(T,U,3)=$P(T,U,3)+$P(X,D,2)
..Q
.;file fluoro data into file 70.3
.K RARY D EDTFL("",$P(T,U,1),$P(T,U,2),$P(T,U,3),RADOSE)
.K RAI,T,X
.Q
;
;
;<<< update the EXAMINATIONS sub-file's >>>
; RADIATION ABSORBED DOSE field (#1.1)
D RADPTR(RADFN,RADTI,RACNI,RADOSE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADUTL 8948 printed Apr 09, 2024@21:42:20 Page 2
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
+2 ;
+3 ;<<< Business rules >>>
+4 ;-Exam moved to a status of 'Complete': Initially create the record in
+5 ; 70.3. Call the VI API and get dose parameters. Store the relevant
+6 ; radiation dose data in file 70.3.
+7 ;
+8 ;-Exam backed down from a status of 'Complete': Do nothing; leave rad
+9 ; dose data tied to the study
+10 ;
+11 ;-Exam moved to a status of 'Complete' for a second/nth time: Delete
+12 ; existing rad dosage data. Call the VI API and get up to date rad
+13 ; dose parameters. Store the relevant rad dose data in file 70.3.
+14 ;
+15 ;-Exam deleted: The exam is deleted from the database (file 70).
+16 ; The rad dosage data tied to the study, a study which no longer
+17 ; exists, cannot be referenced via an exam. Therefore, the rad dose
+18 ; data record in file 70.3 tied to that study is also deleted.
+19 ;<<< end business rules >>>
+20 ;
+21 ;--- IAs ---
+22 ;Call Number Type
+23 ;------------------------------------------------
+24 ;FILE^DIE 2056 S
+25 ;UPDATE^DIE 2056 S
+26 ;REFRESH^MAGVRD03 6000 P
+27 ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
+28 ;
+29 QUIT
+30 ;
DEL(Y) ;delete the top level record from file 70.3
+1 ;called from option: RA DELETEXAM -Exam Deletion
+2 ;Input: Y - the top level IEN from file 70.3
+3 NEW DIERR,RAFDA,RAIEN
+4 SET RAIEN=Y_","
SET RAFDA(70.3,RAIEN,.01)="@"
DO UPDATE^DIE("","RAFDA")
+5 QUIT
+6 ;
UPCT(RAX,RAII,RAIEN) ;update the CT sub-file 70.31
+1 ;input: RAX array - RAX(IIUID,fld #)=data for that field
+2 ; RAII - irradiation instance UID value
+3 ; RAIENS - IEN top level record # for 70.3
+4 ;*** First find the IIUID record, if not found add it as new ***
+5 NEW RAFDA,RAH,RAIENS,RAXX,RAY
SET RAXX="?+1,"_RAIEN_","
+6 SET RAFDA(70.31,RAXX,.01)=RAII
+7 DO UPDATE^DIE("E","RAFDA","RAY(1)")
+8 if $DATA(DIERR)#2
QUIT
+9 SET RAH=$GET(RAY(1,1))
+10 if 'RAH
QUIT
SET RAIENS=RAH_","_RAIEN_","
+11 ;
+12 ;*** file the remaining (non .01 field) CT data ***
+13 SET RAH=.01
KILL RAFDA
+14 FOR
SET RAH=$ORDER(RAX(RAII,RAH))
if RAH'>0
QUIT
Begin DoDot:1
+15 SET RAFDA(70.31,RAIENS,RAH)=$GET(RAX(RAII,RAH))
+16 QUIT
End DoDot:1
+17 DO FILE^DIE("E","RAFDA")
+18 QUIT
+19 ;
EDTFL(RAP,RAQ,RAR,RAS,RAIENS) ;edit fluoroscopy specific data
+1 ;<< assumed RADFN, RADTE & RACN are defined globally >>
+2 ;Input: RAP - DOSE COLLECTED WITHIN THE VA? (#.04)
+3 ; RAQ - AIR KERMA (#.05)
+4 ; RAR - AIR KERMA AREA PRODUCT (#.06)
+5 ; RAS - TOTAL FLUOROSCOPY TIME (#.07)
+6 ; RAIENS - IEN file 70.3
+7 ;
+8 ;Note: All input variables are REQUIRED. If an input
+9 ;value is null the value in the field, if any, will
+10 ;be deleted.
+11 NEW DIERR,RAFDA
+12 if RAIENS=""
QUIT
SET RAIENS=RAIENS_","
+13 SET RAFDA(70.3,RAIENS,.04)=RAP
+14 SET RAFDA(70.3,RAIENS,.05)=RAQ
+15 SET RAFDA(70.3,RAIENS,.06)=RAR
+16 SET RAFDA(70.3,RAIENS,.07)=RAS
+17 DO FILE^DIE("","RAFDA")
+18 QUIT
+19 ;
FIND(RADFN,RADTE,RACN) ;find the record in file 70.3
+1 ;Input: RADFN = DFN of the Radiology patient
+2 ; RADTE = the EXAM DATE (FM internal value)
+3 ; RACN = case number of the study
+4 ;
+5 ;Output: the IEN of the 70.3 record or null
+6 ;
+7 QUIT $ORDER(^RAD("ARAD",RADTE,RADFN,RACN,0))
+8 ;
NEW(RADFN,RADTE,RACN) ;create a radiation absorbtion dose (RAD) record
+1 ;(top-level) for this exam
+2 ;Input: RADFN - the DFN of the patient
+3 ; RADTE - the exam date w/time (FM internal format)
+4 ; RACN - the case number on the exam
+5 ;Return: if successful the record number is returned else return
+6 ;an error message.
+7 NEW DIERR,RAFDA,RAIEN703
+8 SET RAFDA(70.3,"+1,",.01)=RADFN
+9 SET RAFDA(70.3,"+1,",.02)=RADTE
SET RAFDA(70.3,"+1,",.03)=RACN
+10 DO UPDATE^DIE("","RAFDA","RAIEN703")
+11 SET RAIEN703=$SELECT(+$GET(RAIEN703(1))>0:RAIEN703(1),1:"-1^unable to create a radiation dose record for this exam")
+12 QUIT RAIEN703
+13 ;
+14 ;----------------------------------------------------------------
+15 ;
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)
+2 ;sub-file.
+3 ;Input: RADFN - the DFN of the patient DA(2)
+4 ; RADTI - inverse exam date/time DA(1)
+5 ; RACNI - the exam record number DA
+6 ; Y - if filing the file 70.3 record number
+7 ; if deleting the "@"
+8 ;
+9 NEW DIERR,RAFDA,RAIENS
SET RAIENS=RACNI_","_RADTI_","_RADFN_","
+10 SET RAFDA(70.03,RAIENS,1.1)=Y
DO FILE^DIE("","RAFDA")
+11 QUIT
+12 ;
II(X) ;check the data integrity of the Irradiation Instance UID (IIUID).
+1 ;Definition: IIUID is defined as a character string containing a UID
+2 ;that is used to uniquely identify a wide variety of items. The UID
+3 ;is a series of numeric components separated by the period "."
+4 ;character. If a Value Field containing one or more UIDs is an
+5 ;odd number of bytes in length, the Value Field shall be padded
+6 ;with a single trailing NULL (00H) character (binary: 00000000)
+7 ;to ensure that the Value Field is an even number of bytes in length.
+8 ;
+9 ;Data format: "0"-"9", "." (A series of numeric components separated
+10 ;by the period "." character)
+11 ;
+12 ;Length: 64 bytes maximum
+13 ;
+14 ;Input: X = the IIUID with padding or w/o padding
+15 ;Return: the IIUID w/o padding
+16 ;
+17 QUIT $PIECE(X,$CHAR(0),1)
+18 ;
GETDOSE ;call the Imaging API which returns radiation dose data for a study
+1 ; RADFN, RADTI & RACNI exist
+2 ; RAY2, RAY3 & RAIT set in RAORDC
+3 ; $P(RAY3,U) = case #
+4 NEW D,FLD,I,II,P,Q,RACCNUM,RADOSE,RAIEN,RAII,RAQ,RARY,X
+5 ;S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
+6 ;S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+7 ;SSAN
SET RACCNUM=$PIECE(RAY3,U,31)
+8 if RACCNUM=""
SET RACCNUM=$EXTRACT(RAY2,4,7)_$EXTRACT(RAY2,2,3)_"-"_$PIECE(RAY3,U)
+9 ;S X=$P($G(^RA(79.2,$P(RAY2,U,2),0)),U,3) ;abbreviation
+10 ;S RAIT=$S(X="RAD":"FLUORO",1:"CT")
+11 ;
+12 DO REFRESH^MAGVRD03(.RARY,RADFN,RACCNUM,RAIT)
+13 ;'0' indicates the call was a success; else quit
if +RARY(1)'=0
QUIT
+14 ;call a success but no data
if $PIECE(RARY(1),"`",3)=0
QUIT
+15 ;
+16 ;set RADTE if it is not defined
+17 ;P119 h/t Fayetteville, NC
if '$DATA(RADTE)#2
SET RADTE=9999999.9999-RADTI
+18 ;is there an existing rad dose record for this study?
+19 SET RADOSE=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U)
+20 ;if RADOSE="" create new record in file 70.3
+21 if RADOSE=""
SET RADOSE=$$NEW(RADFN,RADTE,$PIECE(RAY3,U))
+22 ;
+23 ;<<< FORMAT the data into a structure I can use. Note: the variable 'D' will act as my delimiter >>>
+24 SET D="|"
+25 ;
+26 ; Note: Each new CT repetition starts with TYPE
+27 ; as a label
+28 ;
+29 ;CT from: ARRAY(n)=field name_D_value
+30 ; to: RAQ(IIUID,field 70.31)=value
+31 ;IRRADIATION INSTANCE -> fld: .01; TARGET REGION -> fld: 2
+32 ;PHANTOM TYPE -> fld: 3; CTDIvol -> fld: 4 and DLP -> fld: 5
+33 IF RAIT="CT"
Begin DoDot:1
+34 ;# rec indicator
KILL RAQ
SET RAI=$ORDER(RARY(0))
+35 SET RAI=0
FOR
SET RAI=$ORDER(RARY(RAI))
if RAI'>0
QUIT
Begin DoDot:2
+36 SET X=$GET(RARY(RAI))
+37 IF $PIECE(X,D,1)="IRRADIATION INSTANCE UID"
Begin DoDot:3
+38 ;IIUID
SET II=$$II($PIECE(X,D,2))
+39 SET RAQ(II,.01)=II
+40 QUIT
End DoDot:3
+41 ;I $P(X,D,1)="TARGET REGION" S RAQ(II,2)=$P(X,D,2) ;T6 don't file TR
+42 IF $PIECE(X,D,1)="PHANTOM TYPE"
SET RAQ(II,3)=$PIECE(X,D,2)
+43 ;p119
IF $PIECE(X,D,1)="CTDIVOL"
SET RAQ(II,4)=$SELECT($PIECE(X,D,2)>0:+$PIECE(X,D,2),1:"")
+44 ;p119
IF $PIECE(X,D,1)="DLP"
SET RAQ(II,5)=$SELECT($PIECE(X,D,2)>0:+$PIECE(X,D,2),1:"")
+45 ; $S added for fields 4 & 5 above to record a null value as an empty field
+46 ; +$P(X,D,2) used to turn 5.100000000 to 5.1
+47 ; reports will display values to their proper fractional part precision
+48 QUIT
End DoDot:2
+49 KILL RARY
SET RAII=""
+50 FOR
SET RAII=$ORDER(RAQ(RAII))
if RAII=""
QUIT
Begin DoDot:2
+51 ;update CT multiple
DO UPCT(.RAQ,RAII,RADOSE)
+52 QUIT
End DoDot:2
+53 KILL I,II,RAI,RAII,RAQ,X
+54 QUIT
End DoDot:1
+55 ;
+56 ;
+57 ;FLUORO from: ARRAY(n)=field name_D_value
+58 ; to: RAQ(field 70.3)=value
+59 ;else if RAIT="FLUORO"
IF '$TEST
Begin DoDot:1
+60 ;TOTAL TIME IN FLUOROSCOPY (2005.633,2) maps to
+61 ; TOTAL FLUOROSCOPY TIME (70.3,.07)
+62 ;
+63 ;CINE DOSE (RP) TOTAL (2005.633,12) + FLUORO DOSE (RP) TOTAL (2005.633,10)
+64 ; maps to the RIS' AIR KERMA (70.3,.05) field
+65 ;
+66 ;FLUORO DOSE AREA PRODUCT TOTAL (2005.633,11) +
+67 ; CINE DOSE AREA PRODUCT TOTAL (2005.633,13)
+68 ; maps to AIR KERMA AREA PRODUCT (70.3,.06)
+69 ;
+70 SET T="0^0^0"
+71 ;first piece RIS' AIR KERMA (70.3,.05)
+72 ;second piece RIS' AIR KERMA AREA PRODUCT (70.3,.06)
+73 ;third piece RIS' TOTAL FLUOROSCOPY TIME (70.3,.07)
+74 ;
+75 ;# rec indicator
SET RAI=$ORDER(RARY(0))
+76 FOR
SET RAI=$ORDER(RARY(RAI))
if RAI'>0
QUIT
Begin DoDot:2
+77 SET X=$GET(RARY(RAI))
+78 ;p119T6
if $PIECE(X,D,1)="CINE DOSE (RP) TOTAL"
SET $PIECE(T,U,1)=$PIECE(T,U,1)+(+$FNUMBER($PIECE(X,D,2),"",9))
+79 ;p119T6
if $PIECE(X,D,1)="FLUORO DOSE (RP) TOTAL"
SET $PIECE(T,U,1)=$PIECE(T,U,1)+(+$FNUMBER($PIECE(X,D,2),"",9))
+80 ;
+81 ;p119T6
if $PIECE(X,D,1)="FLUORO DOSE AREA PRODUCT TOTAL"
SET $PIECE(T,U,2)=$PIECE(T,U,2)+(+$FNUMBER($PIECE(X,D,2),"",9))
+82 ;p119T6
if $PIECE(X,D,1)="CINE DOSE AREA PRODUCT TOTAL"
SET $PIECE(T,U,2)=$PIECE(T,U,2)+(+$FNUMBER($PIECE(X,D,2),"",9))
+83 ;
+84 if $PIECE(X,D,1)="TOTAL TIME IN FLUOROSCOPY"
SET $PIECE(T,U,3)=$PIECE(T,U,3)+$PIECE(X,D,2)
+85 QUIT
End DoDot:2
+86 ;file fluoro data into file 70.3
+87 KILL RARY
DO EDTFL("",$PIECE(T,U,1),$PIECE(T,U,2),$PIECE(T,U,3),RADOSE)
+88 KILL RAI,T,X
+89 QUIT
End DoDot:1
+90 ;
+91 ;
+92 ;<<< update the EXAMINATIONS sub-file's >>>
+93 ; RADIATION ABSORBED DOSE field (#1.1)
+94 DO RADPTR(RADFN,RADTI,RACNI,RADOSE)
+95 QUIT
+96 ;
