RAMAINU1 ;HISC/GJC-Radiology Utility File Maintenance (utility)
;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
;Note: new routine with the release of RA*5*45
;
FILEAU(RAD0,RATRKCMB) ;File the 'when, where, and who' data when the contrast
;media definitions for our Rad/Nuc Med Procedure change via an edit.
;input: RADA=IEN of the Rad/Nuc Med Procedure record
; RATRKCMB=the before contrast media definition
S RAD1=$O(^RAMIS(71,RAD0,"AUD",$C(32)),-1)+1
;It is important to know when the user purges cm associations
;related to a procedure. In this case, we want to audit file to
;track subsequent cm purge events ignoring the case when the user
;initially associates cm with a procedure.
I RAD1=1,RATRKCMB="" K RAD1 Q
S RASFM(71.06,"+"_RAD1_","_RAD0_",",.01)=+$E($$NOW^XLFDT(),1,12)
S RASFM(71.06,"+"_RAD1_","_RAD0_",",2)=RATRKCMB
S RASFM(71.06,"+"_RAD1_","_RAD0_",",3)=$G(DUZ)
D UPDATE^DIE("","RASFM","RAD1") K RAD1,RASFM
Q
;
AUD70(RADFN,RADTI,RACNI,RATRKCMB) ;File the 'when, where, and who' data
;when the contrast media definitions for our Rad/Nuc Med exam change
;via an edit.
;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
; RADTI=exam date/time (inverse)
; RACNI=ien of exam record (examinations sub-file 70.03)
; RATRKCMB=the before contrast media definition
S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",$C(32)),-1)+1
;It is important to know when the user purges cm associations related
;to an exam. In this case, we want to audit file to track subsequent
;cm purge events ignoring the case when the user initially associates
;cm with an exam.
I RAD3=1,RATRKCMB="" K RAD3 Q
S RAIENS="+"_RAD3_","_RACNI_","_RADTI_","_RADFN_","
S RASFM(70.16,RAIENS,.01)=+$E($$NOW^XLFDT(),1,12)
S RASFM(70.16,RAIENS,2)=RATRKCMB
S RASFM(70.16,RAIENS,3)=$G(DUZ)
D UPDATE^DIE("","RASFM","RAD3") K RAD3,RAIENS,RASFM
Q
;
UPPCM(DA,X) ;Check that if contrast media data is associated with this
;procedure that the 'CONTRAST MEDIA USED' (#20) field is set
;to 'Yes'. If contrast media data is not associated with this
;procedure check that the 'CONTRAST MEDIA USED' field is set
;to 'No'. Called immediately after exiting the 'RA PROCEDURE EDIT'
;input template in RAMAIN2.
;
;input: DA=IEN of the record in file 71
; X=the internal value; 'N' - No, 'Y' - Yes, or '@' - delete
;
K RASFM S RASFM(71,DA_",",20)=X
D UPDATE^DIE("","RASFM") K RASFM
Q
;
CMINTEG(DA,X) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
;'CONTRAST MEDIA' fields for file 71.
;
;input: DA=ien of the record in file 71
; X=zero node of RAD/NUC MED PROCEDURE record
S RACM471=$O(^RAMIS(71,DA,"CM",0))
I RACM471,$P(X,U,20)'="Y" D ;cm assoc, contrast media used 'no'
.W !!?3,"'"_$E($P(X,U),1,45)_"' has contrast media associations:"
.S RAI=0 F S RAI=$O(^RAMIS(71,DA,"CM",RAI)) Q:'RAI D ;display CM
..S RAI(0)=$G(^RAMIS(71,DA,"CM",RAI,0))
..W !?5,$$EXTERNAL^DILFD(71.0125,.01,"",$P(RAI(0),U))
..Q
.W !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
.D UPPCM(DA,"Y") K RAI
.Q
I 'RACM471,$P(X,U,20)="Y" D ;no cm assoc, contrast media used 'yes'
.W !!?3,"'"_$E($P(X,U),1,45)_"' doesn't have contrast media associations;"
.W !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
.D UPPCM(DA,"N")
.Q
K RACM471 Q
;
XCMINTEG(DA) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
;'CONTRAST MEDIA' fields for file 70.
;
;input: DA=ien of the record in file 70 array; DA, DA(1), & DA(2)
;
S RAXCM0=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
S RAXCMP=$P(RAXCM0,U,2),RAXCMP=$$EXTERNAL^DILFD(70.03,2,"",RAXCMP)
S RACM470=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))
I RACM470,$P(RAXCM0,U,10)'="Y" D ;cm assoc, contrast media used 'no'
.W !!?3,"'"_$E(RAXCMP,1,45)_"' has contrast media associations:"
.S RAI=0
.F S RAI=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI)) Q:'RAI D ;display CM
..S RAI(0)=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI,0))
..W !?5,$$EXTERNAL^DILFD(70.3225,.01,"",$P(RAI(0),U))
..Q
.W !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
.D UPXCM^RAMAINU(.DA,"Y") K RAI
.Q
I 'RACM470,$P(RAXCM0,U,10)="Y" D ;no cm assoc, contrast media used 'yes'
.W !!?3,"'"_$E(RAXCMP,1,45)_"' doesn't have contrast media associations;"
.W !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
.D UPXCM^RAMAINU(.DA,"N")
.Q
K RACM470,RAXCM0,RAXCMP Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAINU1 4484 printed Dec 13, 2024@02:37:21 Page 2
RAMAINU1 ;HISC/GJC-Radiology Utility File Maintenance (utility)
+1 ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
+2 ;Note: new routine with the release of RA*5*45
+3 ;
FILEAU(RAD0,RATRKCMB) ;File the 'when, where, and who' data when the contrast
+1 ;media definitions for our Rad/Nuc Med Procedure change via an edit.
+2 ;input: RADA=IEN of the Rad/Nuc Med Procedure record
+3 ; RATRKCMB=the before contrast media definition
+4 SET RAD1=$ORDER(^RAMIS(71,RAD0,"AUD",$CHAR(32)),-1)+1
+5 ;It is important to know when the user purges cm associations
+6 ;related to a procedure. In this case, we want to audit file to
+7 ;track subsequent cm purge events ignoring the case when the user
+8 ;initially associates cm with a procedure.
+9 IF RAD1=1
IF RATRKCMB=""
KILL RAD1
QUIT
+10 SET RASFM(71.06,"+"_RAD1_","_RAD0_",",.01)=+$EXTRACT($$NOW^XLFDT(),1,12)
+11 SET RASFM(71.06,"+"_RAD1_","_RAD0_",",2)=RATRKCMB
+12 SET RASFM(71.06,"+"_RAD1_","_RAD0_",",3)=$GET(DUZ)
+13 DO UPDATE^DIE("","RASFM","RAD1")
KILL RAD1,RASFM
+14 QUIT
+15 ;
AUD70(RADFN,RADTI,RACNI,RATRKCMB) ;File the 'when, where, and who' data
+1 ;when the contrast media definitions for our Rad/Nuc Med exam change
+2 ;via an edit.
+3 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
+4 ; RADTI=exam date/time (inverse)
+5 ; RACNI=ien of exam record (examinations sub-file 70.03)
+6 ; RATRKCMB=the before contrast media definition
+7 SET RAD3=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",$CHAR(32)),-1)+1
+8 ;It is important to know when the user purges cm associations related
+9 ;to an exam. In this case, we want to audit file to track subsequent
+10 ;cm purge events ignoring the case when the user initially associates
+11 ;cm with an exam.
+12 IF RAD3=1
IF RATRKCMB=""
KILL RAD3
QUIT
+13 SET RAIENS="+"_RAD3_","_RACNI_","_RADTI_","_RADFN_","
+14 SET RASFM(70.16,RAIENS,.01)=+$EXTRACT($$NOW^XLFDT(),1,12)
+15 SET RASFM(70.16,RAIENS,2)=RATRKCMB
+16 SET RASFM(70.16,RAIENS,3)=$GET(DUZ)
+17 DO UPDATE^DIE("","RASFM","RAD3")
KILL RAD3,RAIENS,RASFM
+18 QUIT
+19 ;
UPPCM(DA,X) ;Check that if contrast media data is associated with this
+1 ;procedure that the 'CONTRAST MEDIA USED' (#20) field is set
+2 ;to 'Yes'. If contrast media data is not associated with this
+3 ;procedure check that the 'CONTRAST MEDIA USED' field is set
+4 ;to 'No'. Called immediately after exiting the 'RA PROCEDURE EDIT'
+5 ;input template in RAMAIN2.
+6 ;
+7 ;input: DA=IEN of the record in file 71
+8 ; X=the internal value; 'N' - No, 'Y' - Yes, or '@' - delete
+9 ;
+10 KILL RASFM
SET RASFM(71,DA_",",20)=X
+11 DO UPDATE^DIE("","RASFM")
KILL RASFM
+12 QUIT
+13 ;
CMINTEG(DA,X) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
+1 ;'CONTRAST MEDIA' fields for file 71.
+2 ;
+3 ;input: DA=ien of the record in file 71
+4 ; X=zero node of RAD/NUC MED PROCEDURE record
+5 SET RACM471=$ORDER(^RAMIS(71,DA,"CM",0))
+6 ;cm assoc, contrast media used 'no'
IF RACM471
IF $PIECE(X,U,20)'="Y"
Begin DoDot:1
+7 WRITE !!?3,"'"_$EXTRACT($PIECE(X,U),1,45)_"' has contrast media associations:"
+8 ;display CM
SET RAI=0
FOR
SET RAI=$ORDER(^RAMIS(71,DA,"CM",RAI))
if 'RAI
QUIT
Begin DoDot:2
+9 SET RAI(0)=$GET(^RAMIS(71,DA,"CM",RAI,0))
+10 WRITE !?5,$$EXTERNAL^DILFD(71.0125,.01,"",$PIECE(RAI(0),U))
+11 QUIT
End DoDot:2
+12 WRITE !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
+13 DO UPPCM(DA,"Y")
KILL RAI
+14 QUIT
End DoDot:1
+15 ;no cm assoc, contrast media used 'yes'
IF 'RACM471
IF $PIECE(X,U,20)="Y"
Begin DoDot:1
+16 WRITE !!?3,"'"_$EXTRACT($PIECE(X,U),1,45)_"' doesn't have contrast media associations;"
+17 WRITE !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
+18 DO UPPCM(DA,"N")
+19 QUIT
End DoDot:1
+20 KILL RACM471
QUIT
+21 ;
XCMINTEG(DA) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
+1 ;'CONTRAST MEDIA' fields for file 70.
+2 ;
+3 ;input: DA=ien of the record in file 70 array; DA, DA(1), & DA(2)
+4 ;
+5 SET RAXCM0=$GET(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
+6 SET RAXCMP=$PIECE(RAXCM0,U,2)
SET RAXCMP=$$EXTERNAL^DILFD(70.03,2,"",RAXCMP)
+7 SET RACM470=$ORDER(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))
+8 ;cm assoc, contrast media used 'no'
IF RACM470
IF $PIECE(RAXCM0,U,10)'="Y"
Begin DoDot:1
+9 WRITE !!?3,"'"_$EXTRACT(RAXCMP,1,45)_"' has contrast media associations:"
+10 SET RAI=0
+11 ;display CM
FOR
SET RAI=$ORDER(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI))
if 'RAI
QUIT
Begin DoDot:2
+12 SET RAI(0)=$GET(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI,0))
+13 WRITE !?5,$$EXTERNAL^DILFD(70.3225,.01,"",$PIECE(RAI(0),U))
+14 QUIT
End DoDot:2
+15 WRITE !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
+16 DO UPXCM^RAMAINU(.DA,"Y")
KILL RAI
+17 QUIT
End DoDot:1
+18 ;no cm assoc, contrast media used 'yes'
IF 'RACM470
IF $PIECE(RAXCM0,U,10)="Y"
Begin DoDot:1
+19 WRITE !!?3,"'"_$EXTRACT(RAXCMP,1,45)_"' doesn't have contrast media associations;"
+20 WRITE !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
+21 DO UPXCM^RAMAINU(.DA,"N")
+22 QUIT
End DoDot:1
+23 KILL RACM470,RAXCM0,RAXCMP
QUIT
+24 ;
