LRBLDRR3 ;DALISC/CYM DONOR AUDIT TRAIL ; 2/26/96 14:30
;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
;
; Routine called by file 65.5 input template LRBLDCP
; Multiple field arrays are built and totaled before and after
; editing LRBLDCP to be used for comparison. If total after
; editing is less than before editing, then the appropriate
; fields contained in the deleted node are put onto the
; audit trail for Blood Bank
;
BEG ; Counts all donation dates for a patient before editing and puts
; into an array. Then counts total to be used for comparison later.
S (LRDATE,BEGDATE)=0
F S LRDATE=$O(^LRE(LRDONOR,5,LRDATE)) Q:LRDATE'>0 S BEGDATE=BEGDATE+1,BEG(LRDATE)=^LRE(LRDONOR,5,LRDATE,0)
Q
DEL ; Counts all donation dates for a patient after editing. If the
; total after editing is less than the total before editing,
; the original deleted data is put into the audit trail.
S (LRDATE,AFTDATE)=0
F S LRDATE=$O(^LRE(LRDONOR,5,LRDATE)) Q:LRDATE'>0 S AFTDATE=AFTDATE+1
I AFTDATE<BEGDATE D
. Q:'$D(NODE)
. S O=$P(NODE,U),Z="65.54,.01" D AUDIT
. S O=$P(NODE,U,2),Z="65.54,1" D AUDIT
. S O=$P(NODE,U,3),Z="65.54,3" D AUDIT
. S O=$P(NODE,U,4),Z="65.54,4" D AUDIT
. S O=$P(NODE,U,5),Z="65.54,5" D AUDIT
. S O=$P(NODE,U,6),Z="65.54,.02" D AUDIT
. S O=$P(NODE,U,7),Z="65.54,.03" D AUDIT
. S O=$P(NODE,U,8),Z="65.54,.011" D AUDIT
. S O=$P(NODE,U,9),Z="65.54,6" D AUDIT
. S O=$P(NODE,U,10),Z="65.54,6.1" D AUDIT
. S O=$P(NODE,U,11),Z="65.54,1.1" D AUDIT
. S O=$P(NODE,U,12),Z="65.54,1.2" D AUDIT
. Q:'$D(NODE1)
. S O=$P(NODE1,U),Z="65.54,4.1" D AUDIT
. S O=$P(NODE1,U,2),Z="65.54,4.2" D AUDIT
. S O=$P(NODE1,U,3),Z="65.54,4.3" D AUDIT
. S O=$P(NODE1,U,4),Z="65.54,4.4" D AUDIT
. S O=$P(NODE1,U,5),Z="65.54,4.5" D AUDIT
. S O=$P(NODE1,U,6),Z="65.54,4.6" D AUDIT
. S O=$P(NODE1,U,7),Z="65.54,4.7" D AUDIT
. S O=$P(NODE1,U,8),Z="65.54,4.8" D AUDIT
. S O=$P(NODE1,U,9),Z="65.54,4.11" D AUDIT
. S O=$P(NODE1,U,10),Z="65.54,4.15" D AUDIT
Q
;
AUDIT I O]"" S X="Deleted" D EN^LRUD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLDRR3 2161 printed Nov 22, 2024@17:20:58 Page 2
LRBLDRR3 ;DALISC/CYM DONOR AUDIT TRAIL ; 2/26/96 14:30
+1 ;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 ;
+4 ; Routine called by file 65.5 input template LRBLDCP
+5 ; Multiple field arrays are built and totaled before and after
+6 ; editing LRBLDCP to be used for comparison. If total after
+7 ; editing is less than before editing, then the appropriate
+8 ; fields contained in the deleted node are put onto the
+9 ; audit trail for Blood Bank
+10 ;
BEG ; Counts all donation dates for a patient before editing and puts
+1 ; into an array. Then counts total to be used for comparison later.
+2 SET (LRDATE,BEGDATE)=0
+3 FOR
SET LRDATE=$ORDER(^LRE(LRDONOR,5,LRDATE))
if LRDATE'>0
QUIT
SET BEGDATE=BEGDATE+1
SET BEG(LRDATE)=^LRE(LRDONOR,5,LRDATE,0)
+4 QUIT
DEL ; Counts all donation dates for a patient after editing. If the
+1 ; total after editing is less than the total before editing,
+2 ; the original deleted data is put into the audit trail.
+3 SET (LRDATE,AFTDATE)=0
+4 FOR
SET LRDATE=$ORDER(^LRE(LRDONOR,5,LRDATE))
if LRDATE'>0
QUIT
SET AFTDATE=AFTDATE+1
+5 IF AFTDATE<BEGDATE
Begin DoDot:1
+6 if '$DATA(NODE)
QUIT
+7 SET O=$PIECE(NODE,U)
SET Z="65.54,.01"
DO AUDIT
+8 SET O=$PIECE(NODE,U,2)
SET Z="65.54,1"
DO AUDIT
+9 SET O=$PIECE(NODE,U,3)
SET Z="65.54,3"
DO AUDIT
+10 SET O=$PIECE(NODE,U,4)
SET Z="65.54,4"
DO AUDIT
+11 SET O=$PIECE(NODE,U,5)
SET Z="65.54,5"
DO AUDIT
+12 SET O=$PIECE(NODE,U,6)
SET Z="65.54,.02"
DO AUDIT
+13 SET O=$PIECE(NODE,U,7)
SET Z="65.54,.03"
DO AUDIT
+14 SET O=$PIECE(NODE,U,8)
SET Z="65.54,.011"
DO AUDIT
+15 SET O=$PIECE(NODE,U,9)
SET Z="65.54,6"
DO AUDIT
+16 SET O=$PIECE(NODE,U,10)
SET Z="65.54,6.1"
DO AUDIT
+17 SET O=$PIECE(NODE,U,11)
SET Z="65.54,1.1"
DO AUDIT
+18 SET O=$PIECE(NODE,U,12)
SET Z="65.54,1.2"
DO AUDIT
+19 if '$DATA(NODE1)
QUIT
+20 SET O=$PIECE(NODE1,U)
SET Z="65.54,4.1"
DO AUDIT
+21 SET O=$PIECE(NODE1,U,2)
SET Z="65.54,4.2"
DO AUDIT
+22 SET O=$PIECE(NODE1,U,3)
SET Z="65.54,4.3"
DO AUDIT
+23 SET O=$PIECE(NODE1,U,4)
SET Z="65.54,4.4"
DO AUDIT
+24 SET O=$PIECE(NODE1,U,5)
SET Z="65.54,4.5"
DO AUDIT
+25 SET O=$PIECE(NODE1,U,6)
SET Z="65.54,4.6"
DO AUDIT
+26 SET O=$PIECE(NODE1,U,7)
SET Z="65.54,4.7"
DO AUDIT
+27 SET O=$PIECE(NODE1,U,8)
SET Z="65.54,4.8"
DO AUDIT
+28 SET O=$PIECE(NODE1,U,9)
SET Z="65.54,4.11"
DO AUDIT
+29 SET O=$PIECE(NODE1,U,10)
SET Z="65.54,4.15"
DO AUDIT
End DoDot:1
+30 QUIT
+31 ;
AUDIT IF O]""
SET X="Deleted"
DO EN^LRUD
+1 QUIT
