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

RAMAINU.m

Go to the documentation of this file. 
  1. RAMAINU ;HISC/GJC-Radiology Utility File Maintenance (utility)
  1.  ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
  1.  ;Note: new routine with the release of RA*5*45
  1.  ;
  1. CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
  1.  ;is exercised. Called from input template: RA PROCEDURE EDIT
  1.  ;Input: DA=ien of new record being edited & RAX=procedure name
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y S RAYN=0
  1.  F  D  Q:+RAYN!($D(DIRUT)#2)
  1.  .K X,Y S DIR(0)="71,9" D ^DIR Q:$D(DIRUT)#2
  1.  .;Y=N^S where N=record ien & S=.01 value of the record
  1.  .W !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
  1.  .W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
  1.  .R RAYN:DTIME
  1.  .I '$T!(RAYN["^") S RAYN=-1 Q
  1.  .S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
  1.  .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."
  1.  .I  W !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
  1.  .S:"Yy"[RAYN RAYN="1^Y"
  1.  .S:"Nn"[RAYN RAYN=0
  1.  .Q
  1.  I $P(RAYN,U,2)="Y" S RAFDA(71,DA_",",9)=$P(Y,U) D FILE^DIE("","RAFDA")
  1.  Q
  1.  ;
  1. TRKCMB(DA,RACMB4) ;Contrast Medium/Media is used with this procedure.
  1.  ;Track the editing of this data. This subroutine saves off the 'before'
  1.  ;values in a local variable. The 'before' and 'after' values will be
  1.  ;compared. If they differ, then the 'before' value will be filed in
  1.  ;the audit log.
  1.  ; input: DA=IEN of the Rad/Nuc Med Procedure record
  1.  ;output: RACMB4=CM definitions for this procedure before edit
  1.  N I S I=0,RACMB4=""
  1.  F  S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I  D
  1.  .S RACMB4=RACMB4_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
  1.  .Q
  1.  Q
  1.  ;
  1. TRK70CMB(RADFN,RADTI,RACNI,RACMB4) ;Contrast Medium/Media is used with
  1.  ;this procedure. Track the editing of this data. This subroutine saves
  1.  ;off the 'before' values in a local variable. The 'before' and 'after'
  1.  ;values will be compared. If they differ, then the 'before' value will
  1.  ;be filed in the audit log.
  1.  ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
  1.  ;       RADTI=exam date/time (inverse)
  1.  ;       RACNI=ien of exam record (examinations sub-file 70.03)
  1.  ;output: RACMB4=CM definitions for this procedure before edit
  1.  N I S I=0,RACMB4=""
  1.  F  S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I  D
  1.  .S RACMB4=RACMB4_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
  1.  .Q
  1.  Q
  1.  ;
  1. TRKCMA(DA,RATRKCMB,RATRKCMA,RACMDIF) ;Contrast Medium/Media is used with this
  1.  ;procedure. Tracks the editing of this data. This subroutine saves
  1.  ;off the 'before' values.
  1.  ; input: DA=IEN of the Rad/Nuc Med Procedure record
  1.  ;        RATRKCMB=CM definitions for this procedure before edit
  1.  ;return: RATRKCMA=CM definitions for this procedure after edit
  1.  ;        RACMDIF=if before & after CM values differ, set to 1 else 0
  1.  N I,J S (I,RACMDIF)=0,RATRKCMA=""
  1.  F  S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I  D
  1.  .S RATRKCMA=RATRKCMA_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
  1.  .Q
  1.  ;
  1.  ;If the before & after values are null, no CM definitions exist.
  1.  I $L(RATRKCMB)=0,$L(RATRKCMA)=0 S RACMDIF=0 Q
  1.  ;
  1.  ;If the before value is null and the after value is not null file
  1.  ;the after value
  1.  I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D  Q
  1.  .S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
  1.  .Q
  1.  ;
  1.  ;If the before value is not null and the after value is null file
  1.  ;the after value (indicates that CM data has been deleted)
  1.  I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D  Q
  1.  .S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
  1.  .Q
  1.  ;
  1.  ;If the before and after values are non-null and the number of
  1.  ;characters differ between strings, store the after value and exit.
  1.  I $L(RATRKCMB)'=$L(RATRKCMA) S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA) Q
  1.  ;
  1.  ;If the before and after values have definition (non-null) and are of
  1.  ;the same length, check to see if they have the same characters in
  1.  ;their respective strings (character position not important). Only if
  1.  ;characters differ between the two strings do we file the after data.
  1.  F I=1:1:$L(RATRKCMB) D  Q:RACMDIF
  1.  .S J=$E(RATRKCMB,I) S:RATRKCMA'[J RACMDIF=1
  1.  .Q
  1.  D:RACMDIF FILEAU^RAMAINU1(DA,RATRKCMA)
  1.  Q
  1.  ;
  1. TRK70CMA(RADFN,RADTI,RACNI,RATRKCMB) ;Contrast Medium/Media is used with
  1.  ;this exam.
  1.  ;Tracks the editing of this data. This subroutine saves off the
  1.  ;'before' values.
  1.  ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
  1.  ;       RADTI=exam date/time (inverse)
  1.  ;       RACNI=ien of exam record (examinations sub-file 70.03)
  1.  ;       RATRKCMB=the before contrast media definition
  1.  N I,J,K S (I,K)=0,RATRKCMA=""
  1.  F  S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I  D
  1.  .S RATRKCMA=RATRKCMA_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
  1.  .Q
  1.  ;
  1.  ;If the before & after values are null, no CM definitions exist.
  1.  I $L(RATRKCMB)=0,$L(RATRKCMA)=0 Q
  1.  ;
  1.  ;If the before value is null and the after value is not null file
  1.  ;the after value
  1.  I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
  1.  ;
  1.  ;If the before value is not null and the after value is null file
  1.  ;the after value (indicates that CM data has been deleted)
  1.  I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
  1.  ;
  1.  ;If the before and after values are non-null and the number of
  1.  ;characters differ between strings, store the after value and exit.
  1.  I $L(RATRKCMB)'=$L(RATRKCMA) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
  1.  ;
  1.  ;If the before and after values have definition (non-null) and are of
  1.  ;the same length, check to see if they have the same characters in
  1.  ;their respective strings (character position not important). Only if
  1.  ;characters differ between the two strings do we file the after data.
  1.  F I=1:1:$L(RATRKCMB) D  Q:K
  1.  .S J=$E(RATRKCMB,I) S:RATRKCMA'[J K=1
  1.  .Q
  1.  D:K AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
  1.  Q
  1.  ;
  1. 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
  1.  ;'CONTRAST MEDIA USED?' is presented to the user by the 'RA EXAM EDIT'
  1.  ;& 'RA STATUS CHANGE' input templates.
  1.  ;
  1.  ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
  1.  ;returns: placeholder for input template
  1.  ;
  1.  I +$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0)) D
  1.  .W !?3,$C(7),"Deleting contrast media data associated with this exam.",!
  1.  .K ^RADPT(DA(2),"DT",DA(1),"P",DA,"CM") ;'B' xrefs deleted too!
  1.  .Q
  1.  Q "@225"
  1.  ;
  1. UPXCM(DA,X) ;set the 'CONTRAST MEDIA USED?' (#10) field to 'No' if contrast
  1.  ;media data is not associated with this exam.
  1.  ;called from the 'RA EXAM EDIT' & 'RA STATUS CHANGE' input templates.
  1.  ;
  1.  ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
  1.  ;        X='Y' for 'Yes', 'N' for 'No'
  1.  ;
  1.  K RASFM S RAIENS=DA_","_DA(1)_","_DA(2)_","
  1.  S RASFM(70.03,RAIENS,10)=X D UPDATE^DIE("","RASFM","RAIENS")
  1.  K RAIENS,RASFM
  1.  Q
  1.  ;
  1. 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,
  1.  ;assume the CM definition of the procedure and stuff the exam
  1.  ;record (usually done initially while editing the exam record for the
  1.  ;first time).
  1.  ;
  1.  ;Called from the following input templates:
  1.  ; RA EXAM EDIT & RA STATUS CHANGE
  1.  ;
  1.  ;input: DA array; DA(2)-RADFN, DA(1)-RADTI, & DA-RACNI
  1.  ;       RAPRI: IEN of the procedure being performed
  1.  ;
  1.  N I K RAD3,RAIENS,RASFM
  1.  S I=0 F  S I=$O(^RAMIS(71,RAPRI,"CM",I)) Q:'I  D
  1.  .S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$C(32)),-1)+1
  1.  .S RAIENS="+"_RAD3_","_DA_","_DA(1)_","_DA(2)_","
  1.  .S RASFM(70.3225,RAIENS,.01)=$P($G(^RAMIS(71,RAPRI,"CM",I,0)),U)
  1.  .D UPDATE^DIE("","RASFM","RAD3") K RAD3,RAIENS,RASFM
  1.  .Q
  1.  Q
  1.  ;