source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLDRR3.m@ 1354

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1LRBLDRR3 ;DALISC/CYM DONOR AUDIT TRAIL ; 2/26/96 14:30
2 ;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 ;
5 ; Routine called by file 65.5 input template LRBLDCP
6 ; Multiple field arrays are built and totaled before and after
7 ; editing LRBLDCP to be used for comparison. If total after
8 ; editing is less than before editing, then the appropriate
9 ; fields contained in the deleted node are put onto the
10 ; audit trail for Blood Bank
11 ;
12BEG ; Counts all donation dates for a patient before editing and puts
13 ; into an array. Then counts total to be used for comparison later.
14 S (LRDATE,BEGDATE)=0
15 F S LRDATE=$O(^LRE(LRDONOR,5,LRDATE)) Q:LRDATE'>0 S BEGDATE=BEGDATE+1,BEG(LRDATE)=^LRE(LRDONOR,5,LRDATE,0)
16 Q
17DEL ; Counts all donation dates for a patient after editing. If the
18 ; total after editing is less than the total before editing,
19 ; the original deleted data is put into the audit trail.
20 S (LRDATE,AFTDATE)=0
21 F S LRDATE=$O(^LRE(LRDONOR,5,LRDATE)) Q:LRDATE'>0 S AFTDATE=AFTDATE+1
22 I AFTDATE<BEGDATE D
23 . Q:'$D(NODE)
24 . S O=$P(NODE,U),Z="65.54,.01" D AUDIT
25 . S O=$P(NODE,U,2),Z="65.54,1" D AUDIT
26 . S O=$P(NODE,U,3),Z="65.54,3" D AUDIT
27 . S O=$P(NODE,U,4),Z="65.54,4" D AUDIT
28 . S O=$P(NODE,U,5),Z="65.54,5" D AUDIT
29 . S O=$P(NODE,U,6),Z="65.54,.02" D AUDIT
30 . S O=$P(NODE,U,7),Z="65.54,.03" D AUDIT
31 . S O=$P(NODE,U,8),Z="65.54,.011" D AUDIT
32 . S O=$P(NODE,U,9),Z="65.54,6" D AUDIT
33 . S O=$P(NODE,U,10),Z="65.54,6.1" D AUDIT
34 . S O=$P(NODE,U,11),Z="65.54,1.1" D AUDIT
35 . S O=$P(NODE,U,12),Z="65.54,1.2" D AUDIT
36 . Q:'$D(NODE1)
37 . S O=$P(NODE1,U),Z="65.54,4.1" D AUDIT
38 . S O=$P(NODE1,U,2),Z="65.54,4.2" D AUDIT
39 . S O=$P(NODE1,U,3),Z="65.54,4.3" D AUDIT
40 . S O=$P(NODE1,U,4),Z="65.54,4.4" D AUDIT
41 . S O=$P(NODE1,U,5),Z="65.54,4.5" D AUDIT
42 . S O=$P(NODE1,U,6),Z="65.54,4.6" D AUDIT
43 . S O=$P(NODE1,U,7),Z="65.54,4.7" D AUDIT
44 . S O=$P(NODE1,U,8),Z="65.54,4.8" D AUDIT
45 . S O=$P(NODE1,U,9),Z="65.54,4.11" D AUDIT
46 . S O=$P(NODE1,U,10),Z="65.54,4.15" D AUDIT
47 Q
48 ;
49AUDIT I O]"" S X="Deleted" D EN^LRUD
50 Q
Note: See TracBrowser for help on using the repository browser.