- LRBLDRR3 ; IHS/DIR/AAB - DONOR AUDIT TRAIL 2/26/96 14:30 ; [ 2/26/96 10:10 AM ]
- ;;5.2;LR;**1003**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**90**;Sep 27, 1994
- ;
- ; 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
- LRBLDRR3 ; IHS/DIR/AAB - DONOR AUDIT TRAIL 2/26/96 14:30 ; [ 2/26/96 10:10 AM ]
- +1 ;;5.2;LR;**1003**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**90**;Sep 27, 1994
- +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
