RAMAINU ;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
;
CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
;is exercised. Called from input template: RA PROCEDURE EDIT
;Input: DA=ien of new record being edited & RAX=procedure name
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y S RAYN=0
F D Q:+RAYN!($D(DIRUT)#2)
.K X,Y S DIR(0)="71,9" D ^DIR Q:$D(DIRUT)#2
.;Y=N^S where N=record ien & S=.01 value of the record
.W !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
.W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
.R RAYN:DTIME
.I '$T!(RAYN["^") S RAYN=-1 Q
.S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
.I "YyNn"'[RAYN W !?3,"Enter 'Y' to accept the CPT Code, or 'N' to reject the CPT Code or '^' to",!?3,"exit without selecting a CPT Code."
.I W !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
.S:"Yy"[RAYN RAYN="1^Y"
.S:"Nn"[RAYN RAYN=0
.Q
I $P(RAYN,U,2)="Y" S RAFDA(71,DA_",",9)=$P(Y,U) D FILE^DIE("","RAFDA")
Q
;
TRKCMB(DA,RACMB4) ;Contrast Medium/Media is used with this procedure.
;Track the editing of this data. This subroutine saves off the 'before'
;values in a local variable. The 'before' and 'after' values will be
;compared. If they differ, then the 'before' value will be filed in
;the audit log.
; input: DA=IEN of the Rad/Nuc Med Procedure record
;output: RACMB4=CM definitions for this procedure before edit
N I S I=0,RACMB4=""
F S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I D
.S RACMB4=RACMB4_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
.Q
Q
;
TRK70CMB(RADFN,RADTI,RACNI,RACMB4) ;Contrast Medium/Media is used with
;this procedure. Track the editing of this data. This subroutine saves
;off the 'before' values in a local variable. The 'before' and 'after'
;values will be compared. If they differ, then the 'before' value will
;be filed in the audit log.
;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)
;output: RACMB4=CM definitions for this procedure before edit
N I S I=0,RACMB4=""
F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I D
.S RACMB4=RACMB4_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
.Q
Q
;
TRKCMA(DA,RATRKCMB,RATRKCMA,RACMDIF) ;Contrast Medium/Media is used with this
;procedure. Tracks the editing of this data. This subroutine saves
;off the 'before' values.
; input: DA=IEN of the Rad/Nuc Med Procedure record
; RATRKCMB=CM definitions for this procedure before edit
;return: RATRKCMA=CM definitions for this procedure after edit
; RACMDIF=if before & after CM values differ, set to 1 else 0
N I,J S (I,RACMDIF)=0,RATRKCMA=""
F S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I D
.S RATRKCMA=RATRKCMA_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
.Q
;
;If the before & after values are null, no CM definitions exist.
I $L(RATRKCMB)=0,$L(RATRKCMA)=0 S RACMDIF=0 Q
;
;If the before value is null and the after value is not null file
;the after value
I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D Q
.S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
.Q
;
;If the before value is not null and the after value is null file
;the after value (indicates that CM data has been deleted)
I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D Q
.S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
.Q
;
;If the before and after values are non-null and the number of
;characters differ between strings, store the after value and exit.
I $L(RATRKCMB)'=$L(RATRKCMA) S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA) Q
;
;If the before and after values have definition (non-null) and are of
;the same length, check to see if they have the same characters in
;their respective strings (character position not important). Only if
;characters differ between the two strings do we file the after data.
F I=1:1:$L(RATRKCMB) D Q:RACMDIF
.S J=$E(RATRKCMB,I) S:RATRKCMA'[J RACMDIF=1
.Q
D:RACMDIF FILEAU^RAMAINU1(DA,RATRKCMA)
Q
;
TRK70CMA(RADFN,RADTI,RACNI,RATRKCMB) ;Contrast Medium/Media is used with
;this exam.
;Tracks the editing of this data. This subroutine saves off the
;'before' values.
;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
N I,J,K S (I,K)=0,RATRKCMA=""
F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I D
.S RATRKCMA=RATRKCMA_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
.Q
;
;If the before & after values are null, no CM definitions exist.
I $L(RATRKCMB)=0,$L(RATRKCMA)=0 Q
;
;If the before value is null and the after value is not null file
;the after value
I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
;
;If the before value is not null and the after value is null file
;the after value (indicates that CM data has been deleted)
I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
;
;If the before and after values are non-null and the number of
;characters differ between strings, store the after value and exit.
I $L(RATRKCMB)'=$L(RATRKCMA) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
;
;If the before and after values have definition (non-null) and are of
;the same length, check to see if they have the same characters in
;their respective strings (character position not important). Only if
;characters differ between the two strings do we file the after data.
F I=1:1:$L(RATRKCMB) D Q:K
.S J=$E(RATRKCMB,I) S:RATRKCMA'[J K=1
.Q
D:K AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
Q
;
PRGCM(DA) ;Purge contrast media data related to an exam when the user
;answers 'No' to the 'CONTRAST MEDIA USED?' field (#10) prompt when
;'CONTRAST MEDIA USED?' is presented to the user by the 'RA EXAM EDIT'
;& 'RA STATUS CHANGE' input templates.
;
;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
;returns: placeholder for input template
;
I +$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0)) D
.W !?3,$C(7),"Deleting contrast media data associated with this exam.",!
.K ^RADPT(DA(2),"DT",DA(1),"P",DA,"CM") ;'B' xrefs deleted too!
.Q
Q "@225"
;
UPXCM(DA,X) ;set the 'CONTRAST MEDIA USED?' (#10) field to 'No' if contrast
;media data is not associated with this exam.
;called from the 'RA EXAM EDIT' & 'RA STATUS CHANGE' input templates.
;
;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
; X='Y' for 'Yes', 'N' for 'No'
;
K RASFM S RAIENS=DA_","_DA(1)_","_DA(2)_","
S RASFM(70.03,RAIENS,10)=X D UPDATE^DIE("","RASFM","RAIENS")
K RAIENS,RASFM
Q
;
STUFCM70(DA,RAPRI) ;If the exam record indicates that a contrast medium
;or media was used, and the exam record does not identify the CM,
;assume the CM definition of the procedure and stuff the exam
;record (usually done initially while editing the exam record for the
;first time).
;
;Called from the following input templates:
; RA EXAM EDIT & RA STATUS CHANGE
;
;input: DA array; DA(2)-RADFN, DA(1)-RADTI, & DA-RACNI
; RAPRI: IEN of the procedure being performed
;
N I K RAD3,RAIENS,RASFM
S I=0 F S I=$O(^RAMIS(71,RAPRI,"CM",I)) Q:'I D
.S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$C(32)),-1)+1
.S RAIENS="+"_RAD3_","_DA_","_DA(1)_","_DA(2)_","
.S RASFM(70.3225,RAIENS,.01)=$P($G(^RAMIS(71,RAPRI,"CM",I,0)),U)
.D UPDATE^DIE("","RASFM","RAD3") K RAD3,RAIENS,RASFM
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAINU 7849 printed Sep 23, 2025@20:13:25 Page 2
RAMAINU ;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 ;
CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
+1 ;is exercised. Called from input template: RA PROCEDURE EDIT
+2 ;Input: DA=ien of new record being edited & RAX=procedure name
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y
SET RAYN=0
+4 FOR
Begin DoDot:1
+5 KILL X,Y
SET DIR(0)="71,9"
DO ^DIR
if $DATA(DIRUT)#2
QUIT
+6 ;Y=N^S where N=record ien & S=.01 value of the record
+7 WRITE !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
+8 WRITE !!,"Are you adding '"_$PIECE(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
+9 READ RAYN:DTIME
+10 IF '$TEST!(RAYN["^")
SET RAYN=-1
QUIT
+11 SET RAYN=$EXTRACT(RAYN)
if RAYN=""
SET RAYN="N"
+12 IF "YyNn"'[RAYN
WRITE !?3,"Enter 'Y' to accept the CPT Code, or 'N' to reject the CPT Code or '^' to",!?3,"exit without selecting a CPT Code."
+13 IF $TEST
WRITE !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
+14 if "Yy"[RAYN
SET RAYN="1^Y"
+15 if "Nn"[RAYN
SET RAYN=0
+16 QUIT
End DoDot:1
if +RAYN!($DATA(DIRUT)#2)
QUIT
+17 IF $PIECE(RAYN,U,2)="Y"
SET RAFDA(71,DA_",",9)=$PIECE(Y,U)
DO FILE^DIE("","RAFDA")
+18 QUIT
+19 ;
TRKCMB(DA,RACMB4) ;Contrast Medium/Media is used with this procedure.
+1 ;Track the editing of this data. This subroutine saves off the 'before'
+2 ;values in a local variable. The 'before' and 'after' values will be
+3 ;compared. If they differ, then the 'before' value will be filed in
+4 ;the audit log.
+5 ; input: DA=IEN of the Rad/Nuc Med Procedure record
+6 ;output: RACMB4=CM definitions for this procedure before edit
+7 NEW I
SET I=0
SET RACMB4=""
+8 FOR
SET I=$ORDER(^RAMIS(71,DA,"CM",I))
if 'I
QUIT
Begin DoDot:1
+9 SET RACMB4=RACMB4_$PIECE($GET(^RAMIS(71,DA,"CM",I,0)),U)
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
TRK70CMB(RADFN,RADTI,RACNI,RACMB4) ;Contrast Medium/Media is used with
+1 ;this procedure. Track the editing of this data. This subroutine saves
+2 ;off the 'before' values in a local variable. The 'before' and 'after'
+3 ;values will be compared. If they differ, then the 'before' value will
+4 ;be filed in the audit log.
+5 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
+6 ; RADTI=exam date/time (inverse)
+7 ; RACNI=ien of exam record (examinations sub-file 70.03)
+8 ;output: RACMB4=CM definitions for this procedure before edit
+9 NEW I
SET I=0
SET RACMB4=""
+10 FOR
SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I))
if 'I
QUIT
Begin DoDot:1
+11 SET RACMB4=RACMB4_$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
TRKCMA(DA,RATRKCMB,RATRKCMA,RACMDIF) ;Contrast Medium/Media is used with this
+1 ;procedure. Tracks the editing of this data. This subroutine saves
+2 ;off the 'before' values.
+3 ; input: DA=IEN of the Rad/Nuc Med Procedure record
+4 ; RATRKCMB=CM definitions for this procedure before edit
+5 ;return: RATRKCMA=CM definitions for this procedure after edit
+6 ; RACMDIF=if before & after CM values differ, set to 1 else 0
+7 NEW I,J
SET (I,RACMDIF)=0
SET RATRKCMA=""
+8 FOR
SET I=$ORDER(^RAMIS(71,DA,"CM",I))
if 'I
QUIT
Begin DoDot:1
+9 SET RATRKCMA=RATRKCMA_$PIECE($GET(^RAMIS(71,DA,"CM",I,0)),U)
+10 QUIT
End DoDot:1
+11 ;
+12 ;If the before & after values are null, no CM definitions exist.
+13 IF $LENGTH(RATRKCMB)=0
IF $LENGTH(RATRKCMA)=0
SET RACMDIF=0
QUIT
+14 ;
+15 ;If the before value is null and the after value is not null file
+16 ;the after value
+17 IF $LENGTH(RATRKCMB)=0
IF ($LENGTH(RATRKCMA)>0)
Begin DoDot:1
+18 SET RACMDIF=1
DO FILEAU^RAMAINU1(DA,RATRKCMA)
+19 QUIT
End DoDot:1
QUIT
+20 ;
+21 ;If the before value is not null and the after value is null file
+22 ;the after value (indicates that CM data has been deleted)
+23 IF $LENGTH(RATRKCMB)>0
IF ($LENGTH(RATRKCMA)=0)
Begin DoDot:1
+24 SET RACMDIF=1
DO FILEAU^RAMAINU1(DA,RATRKCMA)
+25 QUIT
End DoDot:1
QUIT
+26 ;
+27 ;If the before and after values are non-null and the number of
+28 ;characters differ between strings, store the after value and exit.
+29 IF $LENGTH(RATRKCMB)'=$LENGTH(RATRKCMA)
SET RACMDIF=1
DO FILEAU^RAMAINU1(DA,RATRKCMA)
QUIT
+30 ;
+31 ;If the before and after values have definition (non-null) and are of
+32 ;the same length, check to see if they have the same characters in
+33 ;their respective strings (character position not important). Only if
+34 ;characters differ between the two strings do we file the after data.
+35 FOR I=1:1:$LENGTH(RATRKCMB)
Begin DoDot:1
+36 SET J=$EXTRACT(RATRKCMB,I)
if RATRKCMA'[J
SET RACMDIF=1
+37 QUIT
End DoDot:1
if RACMDIF
QUIT
+38 if RACMDIF
DO FILEAU^RAMAINU1(DA,RATRKCMA)
+39 QUIT
+40 ;
TRK70CMA(RADFN,RADTI,RACNI,RATRKCMB) ;Contrast Medium/Media is used with
+1 ;this exam.
+2 ;Tracks the editing of this data. This subroutine saves off the
+3 ;'before' values.
+4 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
+5 ; RADTI=exam date/time (inverse)
+6 ; RACNI=ien of exam record (examinations sub-file 70.03)
+7 ; RATRKCMB=the before contrast media definition
+8 NEW I,J,K
SET (I,K)=0
SET RATRKCMA=""
+9 FOR
SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I))
if 'I
QUIT
Begin DoDot:1
+10 SET RATRKCMA=RATRKCMA_$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
+11 QUIT
End DoDot:1
+12 ;
+13 ;If the before & after values are null, no CM definitions exist.
+14 IF $LENGTH(RATRKCMB)=0
IF $LENGTH(RATRKCMA)=0
QUIT
+15 ;
+16 ;If the before value is null and the after value is not null file
+17 ;the after value
+18 IF $LENGTH(RATRKCMB)=0
IF ($LENGTH(RATRKCMA)>0)
DO AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
QUIT
+19 ;
+20 ;If the before value is not null and the after value is null file
+21 ;the after value (indicates that CM data has been deleted)
+22 IF $LENGTH(RATRKCMB)>0
IF ($LENGTH(RATRKCMA)=0)
DO AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
QUIT
+23 ;
+24 ;If the before and after values are non-null and the number of
+25 ;characters differ between strings, store the after value and exit.
+26 IF $LENGTH(RATRKCMB)'=$LENGTH(RATRKCMA)
DO AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
QUIT
+27 ;
+28 ;If the before and after values have definition (non-null) and are of
+29 ;the same length, check to see if they have the same characters in
+30 ;their respective strings (character position not important). Only if
+31 ;characters differ between the two strings do we file the after data.
+32 FOR I=1:1:$LENGTH(RATRKCMB)
Begin DoDot:1
+33 SET J=$EXTRACT(RATRKCMB,I)
if RATRKCMA'[J
SET K=1
+34 QUIT
End DoDot:1
if K
QUIT
+35 if K
DO AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
+36 QUIT
+37 ;
PRGCM(DA) ;Purge contrast media data related to an exam when the user
+1 ;answers 'No' to the 'CONTRAST MEDIA USED?' field (#10) prompt when
+2 ;'CONTRAST MEDIA USED?' is presented to the user by the 'RA EXAM EDIT'
+3 ;& 'RA STATUS CHANGE' input templates.
+4 ;
+5 ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
+6 ;returns: placeholder for input template
+7 ;
+8 IF +$ORDER(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))
Begin DoDot:1
+9 WRITE !?3,$CHAR(7),"Deleting contrast media data associated with this exam.",!
+10 ;'B' xrefs deleted too!
KILL ^RADPT(DA(2),"DT",DA(1),"P",DA,"CM")
+11 QUIT
End DoDot:1
+12 QUIT "@225"
+13 ;
UPXCM(DA,X) ;set the 'CONTRAST MEDIA USED?' (#10) field to 'No' if contrast
+1 ;media data is not associated with this exam.
+2 ;called from the 'RA EXAM EDIT' & 'RA STATUS CHANGE' input templates.
+3 ;
+4 ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
+5 ; X='Y' for 'Yes', 'N' for 'No'
+6 ;
+7 KILL RASFM
SET RAIENS=DA_","_DA(1)_","_DA(2)_","
+8 SET RASFM(70.03,RAIENS,10)=X
DO UPDATE^DIE("","RASFM","RAIENS")
+9 KILL RAIENS,RASFM
+10 QUIT
+11 ;
STUFCM70(DA,RAPRI) ;If the exam record indicates that a contrast medium
+1 ;or media was used, and the exam record does not identify the CM,
+2 ;assume the CM definition of the procedure and stuff the exam
+3 ;record (usually done initially while editing the exam record for the
+4 ;first time).
+5 ;
+6 ;Called from the following input templates:
+7 ; RA EXAM EDIT & RA STATUS CHANGE
+8 ;
+9 ;input: DA array; DA(2)-RADFN, DA(1)-RADTI, & DA-RACNI
+10 ; RAPRI: IEN of the procedure being performed
+11 ;
+12 NEW I
KILL RAD3,RAIENS,RASFM
+13 SET I=0
FOR
SET I=$ORDER(^RAMIS(71,RAPRI,"CM",I))
if 'I
QUIT
Begin DoDot:1
+14 SET RAD3=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$CHAR(32)),-1)+1
+15 SET RAIENS="+"_RAD3_","_DA_","_DA(1)_","_DA(2)_","
+16 SET RASFM(70.3225,RAIENS,.01)=$PIECE($GET(^RAMIS(71,RAPRI,"CM",I,0)),U)
+17 DO UPDATE^DIE("","RASFM","RAD3")
KILL RAD3,RAIENS,RASFM
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
