source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAINU.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1RAMAINU ;HISC/GJC-Radiology Utility File Maintenance (utility)
2 ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
3 ;Note: new routine with the release of RA*5*45
4 ;
5CPT(DA,RAX) ;Ask for CPT Code when the 'Procedure Enter/Edit' option
6 ;is exercised. Called from input template: RA PROCEDURE EDIT
7 ;Input: DA=ien of new record being edited & RAX=procedure name
8 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAFDA,RAYN,X,Y S RAYN=0
9 F D Q:+RAYN!($D(DIRUT)#2)
10 .K X,Y S DIR(0)="71,9" D ^DIR Q:$D(DIRUT)#2
11 .;Y=N^S where N=record ien & S=.01 value of the record
12 .W !!,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!,"procedure must be inactivated."
13 .W !!,"Are you adding '"_$P(Y,U,2)_"' as the CPT Code for the new Rad/Nuc Med Procedure",!,"'"_RAX_"'? NO// "
14 .R RAYN:DTIME
15 .I '$T!(RAYN["^") S RAYN=-1 Q
16 .S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
17 .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."
18 .I W !?5,"Note: If an erroneous CPT Code is accepted it cannot be changed; the",!?5,"procedure must be inactivated."
19 .S:"Yy"[RAYN RAYN="1^Y"
20 .S:"Nn"[RAYN RAYN=0
21 .Q
22 I $P(RAYN,U,2)="Y" S RAFDA(71,DA_",",9)=$P(Y,U) D FILE^DIE("","RAFDA")
23 Q
24 ;
25TRKCMB(DA,RACMB4) ;Contrast Medium/Media is used with this procedure.
26 ;Track the editing of this data. This subroutine saves off the 'before'
27 ;values in a local variable. The 'before' and 'after' values will be
28 ;compared. If they differ, then the 'before' value will be filed in
29 ;the audit log.
30 ; input: DA=IEN of the Rad/Nuc Med Procedure record
31 ;output: RACMB4=CM definitions for this procedure before edit
32 N I S I=0,RACMB4=""
33 F S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I D
34 .S RACMB4=RACMB4_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
35 .Q
36 Q
37 ;
38TRK70CMB(RADFN,RADTI,RACNI,RACMB4) ;Contrast Medium/Media is used with
39 ;this procedure. Track the editing of this data. This subroutine saves
40 ;off the 'before' values in a local variable. The 'before' and 'after'
41 ;values will be compared. If they differ, then the 'before' value will
42 ;be filed in the audit log.
43 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
44 ; RADTI=exam date/time (inverse)
45 ; RACNI=ien of exam record (examinations sub-file 70.03)
46 ;output: RACMB4=CM definitions for this procedure before edit
47 N I S I=0,RACMB4=""
48 F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I D
49 .S RACMB4=RACMB4_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
50 .Q
51 Q
52 ;
53TRKCMA(DA,RATRKCMB,RATRKCMA,RACMDIF) ;Contrast Medium/Media is used with this
54 ;procedure. Tracks the editing of this data. This subroutine saves
55 ;off the 'before' values.
56 ; input: DA=IEN of the Rad/Nuc Med Procedure record
57 ; RATRKCMB=CM definitions for this procedure before edit
58 ;return: RATRKCMA=CM definitions for this procedure after edit
59 ; RACMDIF=if before & after CM values differ, set to 1 else 0
60 N I,J S (I,RACMDIF)=0,RATRKCMA=""
61 F S I=$O(^RAMIS(71,DA,"CM",I)) Q:'I D
62 .S RATRKCMA=RATRKCMA_$P($G(^RAMIS(71,DA,"CM",I,0)),U)
63 .Q
64 ;
65 ;If the before & after values are null, no CM definitions exist.
66 I $L(RATRKCMB)=0,$L(RATRKCMA)=0 S RACMDIF=0 Q
67 ;
68 ;If the before value is null and the after value is not null file
69 ;the after value
70 I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D Q
71 .S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
72 .Q
73 ;
74 ;If the before value is not null and the after value is null file
75 ;the after value (indicates that CM data has been deleted)
76 I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D Q
77 .S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA)
78 .Q
79 ;
80 ;If the before and after values are non-null and the number of
81 ;characters differ between strings, store the after value and exit.
82 I $L(RATRKCMB)'=$L(RATRKCMA) S RACMDIF=1 D FILEAU^RAMAINU1(DA,RATRKCMA) Q
83 ;
84 ;If the before and after values have definition (non-null) and are of
85 ;the same length, check to see if they have the same characters in
86 ;their respective strings (character position not important). Only if
87 ;characters differ between the two strings do we file the after data.
88 F I=1:1:$L(RATRKCMB) D Q:RACMDIF
89 .S J=$E(RATRKCMB,I) S:RATRKCMA'[J RACMDIF=1
90 .Q
91 D:RACMDIF FILEAU^RAMAINU1(DA,RATRKCMA)
92 Q
93 ;
94TRK70CMA(RADFN,RADTI,RACNI,RATRKCMB) ;Contrast Medium/Media is used with
95 ;this exam.
96 ;Tracks the editing of this data. This subroutine saves off the
97 ;'before' values.
98 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
99 ; RADTI=exam date/time (inverse)
100 ; RACNI=ien of exam record (examinations sub-file 70.03)
101 ; RATRKCMB=the before contrast media definition
102 N I,J,K S (I,K)=0,RATRKCMA=""
103 F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I D
104 .S RATRKCMA=RATRKCMA_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0)),U)
105 .Q
106 ;
107 ;If the before & after values are null, no CM definitions exist.
108 I $L(RATRKCMB)=0,$L(RATRKCMA)=0 Q
109 ;
110 ;If the before value is null and the after value is not null file
111 ;the after value
112 I $L(RATRKCMB)=0,($L(RATRKCMA)>0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
113 ;
114 ;If the before value is not null and the after value is null file
115 ;the after value (indicates that CM data has been deleted)
116 I $L(RATRKCMB)>0,($L(RATRKCMA)=0) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
117 ;
118 ;If the before and after values are non-null and the number of
119 ;characters differ between strings, store the after value and exit.
120 I $L(RATRKCMB)'=$L(RATRKCMA) D AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA) Q
121 ;
122 ;If the before and after values have definition (non-null) and are of
123 ;the same length, check to see if they have the same characters in
124 ;their respective strings (character position not important). Only if
125 ;characters differ between the two strings do we file the after data.
126 F I=1:1:$L(RATRKCMB) D Q:K
127 .S J=$E(RATRKCMB,I) S:RATRKCMA'[J K=1
128 .Q
129 D:K AUD70^RAMAINU1(RADFN,RADTI,RACNI,RATRKCMA)
130 Q
131 ;
132PRGCM(DA) ;Purge contrast media data related to an exam when the user
133 ;answers 'No' to the 'CONTRAST MEDIA USED?' field (#10) prompt when
134 ;'CONTRAST MEDIA USED?' is presented to the user by the 'RA EXAM EDIT'
135 ;& 'RA STATUS CHANGE' input templates.
136 ;
137 ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
138 ;returns: placeholder for input template
139 ;
140 I +$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0)) D
141 .W !?3,$C(7),"Deleting contrast media data associated with this exam.",!
142 .K ^RADPT(DA(2),"DT",DA(1),"P",DA,"CM") ;'B' xrefs deleted too!
143 .Q
144 Q "@225"
145 ;
146UPXCM(DA,X) ;set the 'CONTRAST MEDIA USED?' (#10) field to 'No' if contrast
147 ;media data is not associated with this exam.
148 ;called from the 'RA EXAM EDIT' & 'RA STATUS CHANGE' input templates.
149 ;
150 ;input: DA=expressed as DA(2), DA(1), & DA IENs for file and sub-files
151 ; X='Y' for 'Yes', 'N' for 'No'
152 ;
153 K RASFM S RAIENS=DA_","_DA(1)_","_DA(2)_","
154 S RASFM(70.03,RAIENS,10)=X D UPDATE^DIE("","RASFM","RAIENS")
155 K RAIENS,RASFM
156 Q
157 ;
158STUFCM70(DA,RAPRI) ;If the exam record indicates that a contrast medium
159 ;or media was used, and the exam record does not identify the CM,
160 ;assume the CM definition of the procedure and stuff the exam
161 ;record (usually done initially while editing the exam record for the
162 ;first time).
163 ;
164 ;Called from the following input templates:
165 ; RA EXAM EDIT & RA STATUS CHANGE
166 ;
167 ;input: DA array; DA(2)-RADFN, DA(1)-RADTI, & DA-RACNI
168 ; RAPRI: IEN of the procedure being performed
169 ;
170 N I K RAD3,RAIENS,RASFM
171 S I=0 F S I=$O(^RAMIS(71,RAPRI,"CM",I)) Q:'I D
172 .S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$C(32)),-1)+1
173 .S RAIENS="+"_RAD3_","_DA_","_DA(1)_","_DA(2)_","
174 .S RASFM(70.3225,RAIENS,.01)=$P($G(^RAMIS(71,RAPRI,"CM",I,0)),U)
175 .D UPDATE^DIE("","RASFM","RAD3") K RAD3,RAIENS,RASFM
176 .Q
177 Q
178 ;
Note: See TracBrowser for help on using the repository browser.