- 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 Feb 19, 2025@00:01:12 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 ;