| [613] | 1 | LRBLDRR3 ;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 | ;
|
|---|
| 12 | BEG ; 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
|
|---|
| 17 | DEL ; 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 | ;
|
|---|
| 49 | AUDIT I O]"" S X="Deleted" D EN^LRUD
|
|---|
| 50 | Q
|
|---|
