source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAINU1.m@ 1726

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RAMAINU1 ;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 ;
5FILEAU(RAD0,RATRKCMB) ;File the 'when, where, and who' data when the contrast
6 ;media definitions for our Rad/Nuc Med Procedure change via an edit.
7 ;input: RADA=IEN of the Rad/Nuc Med Procedure record
8 ; RATRKCMB=the before contrast media definition
9 S RAD1=$O(^RAMIS(71,RAD0,"AUD",$C(32)),-1)+1
10 ;It is important to know when the user purges cm associations
11 ;related to a procedure. In this case, we want to audit file to
12 ;track subsequent cm purge events ignoring the case when the user
13 ;initially associates cm with a procedure.
14 I RAD1=1,RATRKCMB="" K RAD1 Q
15 S RASFM(71.06,"+"_RAD1_","_RAD0_",",.01)=+$E($$NOW^XLFDT(),1,12)
16 S RASFM(71.06,"+"_RAD1_","_RAD0_",",2)=RATRKCMB
17 S RASFM(71.06,"+"_RAD1_","_RAD0_",",3)=$G(DUZ)
18 D UPDATE^DIE("","RASFM","RAD1") K RAD1,RASFM
19 Q
20 ;
21AUD70(RADFN,RADTI,RACNI,RATRKCMB) ;File the 'when, where, and who' data
22 ;when the contrast media definitions for our Rad/Nuc Med exam change
23 ;via an edit.
24 ;input: RADFN=DFN of the Rad/Nuc Med patient (file 2)
25 ; RADTI=exam date/time (inverse)
26 ; RACNI=ien of exam record (examinations sub-file 70.03)
27 ; RATRKCMB=the before contrast media definition
28 S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"AUD",$C(32)),-1)+1
29 ;It is important to know when the user purges cm associations related
30 ;to an exam. In this case, we want to audit file to track subsequent
31 ;cm purge events ignoring the case when the user initially associates
32 ;cm with an exam.
33 I RAD3=1,RATRKCMB="" K RAD3 Q
34 S RAIENS="+"_RAD3_","_RACNI_","_RADTI_","_RADFN_","
35 S RASFM(70.16,RAIENS,.01)=+$E($$NOW^XLFDT(),1,12)
36 S RASFM(70.16,RAIENS,2)=RATRKCMB
37 S RASFM(70.16,RAIENS,3)=$G(DUZ)
38 D UPDATE^DIE("","RASFM","RAD3") K RAD3,RAIENS,RASFM
39 Q
40 ;
41UPPCM(DA,X) ;Check that if contrast media data is associated with this
42 ;procedure that the 'CONTRAST MEDIA USED' (#20) field is set
43 ;to 'Yes'. If contrast media data is not associated with this
44 ;procedure check that the 'CONTRAST MEDIA USED' field is set
45 ;to 'No'. Called immediately after exiting the 'RA PROCEDURE EDIT'
46 ;input template in RAMAIN2.
47 ;
48 ;input: DA=IEN of the record in file 71
49 ; X=the internal value; 'N' - No, 'Y' - Yes, or '@' - delete
50 ;
51 K RASFM S RASFM(71,DA_",",20)=X
52 D UPDATE^DIE("","RASFM") K RASFM
53 Q
54 ;
55CMINTEG(DA,X) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
56 ;'CONTRAST MEDIA' fields for file 71.
57 ;
58 ;input: DA=ien of the record in file 71
59 ; X=zero node of RAD/NUC MED PROCEDURE record
60 S RACM471=$O(^RAMIS(71,DA,"CM",0))
61 I RACM471,$P(X,U,20)'="Y" D ;cm assoc, contrast media used 'no'
62 .W !!?3,"'"_$E($P(X,U),1,45)_"' has contrast media associations:"
63 .S RAI=0 F S RAI=$O(^RAMIS(71,DA,"CM",RAI)) Q:'RAI D ;display CM
64 ..S RAI(0)=$G(^RAMIS(71,DA,"CM",RAI,0))
65 ..W !?5,$$EXTERNAL^DILFD(71.0125,.01,"",$P(RAI(0),U))
66 ..Q
67 .W !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
68 .D UPPCM(DA,"Y") K RAI
69 .Q
70 I 'RACM471,$P(X,U,20)="Y" D ;no cm assoc, contrast media used 'yes'
71 .W !!?3,"'"_$E($P(X,U),1,45)_"' doesn't have contrast media associations;"
72 .W !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
73 .D UPPCM(DA,"N")
74 .Q
75 K RACM471 Q
76 ;
77XCMINTEG(DA) ;ensure data consistency between the 'CONTRAST MEDIA USED' &
78 ;'CONTRAST MEDIA' fields for file 70.
79 ;
80 ;input: DA=ien of the record in file 70 array; DA, DA(1), & DA(2)
81 ;
82 S RAXCM0=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
83 S RAXCMP=$P(RAXCM0,U,2),RAXCMP=$$EXTERNAL^DILFD(70.03,2,"",RAXCMP)
84 S RACM470=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))
85 I RACM470,$P(RAXCM0,U,10)'="Y" D ;cm assoc, contrast media used 'no'
86 .W !!?3,"'"_$E(RAXCMP,1,45)_"' has contrast media associations:"
87 .S RAI=0
88 .F S RAI=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI)) Q:'RAI D ;display CM
89 ..S RAI(0)=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",RAI,0))
90 ..W !?5,$$EXTERNAL^DILFD(70.3225,.01,"",$P(RAI(0),U))
91 ..Q
92 .W !?3,"Updating the 'CONTRAST MEDIA USED' field to 'Yes'."
93 .D UPXCM^RAMAINU(.DA,"Y") K RAI
94 .Q
95 I 'RACM470,$P(RAXCM0,U,10)="Y" D ;no cm assoc, contrast media used 'yes'
96 .W !!?3,"'"_$E(RAXCMP,1,45)_"' doesn't have contrast media associations;"
97 .W !?3,"updating the 'CONTRAST MEDIA USED' field to 'No'."
98 .D UPXCM^RAMAINU(.DA,"N")
99 .Q
100 K RACM470,RAXCM0,RAXCMP Q
101 ;
Note: See TracBrowser for help on using the repository browser.