LRBLAUD ;TOG/CYM - AUDIT TRAIL MULTIPLE FIELDS 9/3/97 14:32
;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
;
;
; Routine is called by file 65 edit template LRBLIXR
;
; Multiple field arrays are built and totaled before and after
; editing LRBLIXR to be used for comparison. If total after editing
; is less than before editing, then the entire node is put onto
; the Audit trail for Blood Bank.
;
REL ; Gets original relocation episodes for a unit, sets into the
; BEGR() array and counts total for later comparison
S (REL,BEGREL)=0
F S REL=$O(^LRD(65,LRIEN,3,REL)) Q:REL'>0 S BEGREL=BEGREL+1,BEGR(REL)=^LRD(65,LRIEN,3,REL,0)
Q
;
REL1 ; Gets relocation episodes for unit after editing, sets into AFTR()
; array, counts total. If total after edit < original total, then
; entire deleted record is built onto the audit trail
S (REL,AFTREL)=0
F S REL=$O(^LRD(65,LRIEN,3,REL)) Q:REL'>0 S AFTREL=AFTREL+1,AFTR(REL)=^LRD(65,LRIEN,3,REL,0)
I AFTREL<BEGREL D
. S LRM=NODE
. S O=$P(LRM,U),Z="65.03,.01" D AUDIT
. S O=$P(LRM,U,2),Z="65.03,.02" D AUDIT
. S O=$P(LRM,U,3),Z="65.03,.03" D AUDIT
. S O=$P(LRM,U,4),Z="65.03,.04" D AUDIT
. S O=$P(LRM,U,5),Z="65.03,.05" D AUDIT
. S O=$P(LRM,U,6),Z="65.03,.06" D AUDIT
. S O=$P(LRM,U,7),Z="65.03,.07" D AUDIT
. K NODE
Q
;
PAT ; Gets all unit's Patient Xmatched/Assigned episodes, sets into
; the BEGP() array & counts total for later comparison
S (BEGPAT,PAT)=0
F S PAT=$O(^LRD(65,LRIEN,2,PAT)) Q:PAT'>0 S BEGPAT=BEGPAT+1,BEGP(PAT)=^LRD(65,LRIEN,2,PAT,0)
Q
;
PAT1 ; Gets all Patients Xmatched/Assigned for a unit after editing and
; puts into AFTP() array. If total after editing < original total
; then the deleted patient Xmatched/Assigned node is built onto the
; audit trail. The input template then call line BLD3 to get the
; associated Blood Sample date/time multiple & include this on the
; audit trail also.
S (PAT,AFTPAT)=0
F S PAT=$O(^LRD(65,LRIEN,2,PAT)) Q:PAT'>0 S AFTPAT=AFTPAT+1,AFTP(PAT)=^LRD(65,LRIEN,2,PAT,0)
I AFTPAT<BEGPAT D
. S LRM=PNODE
. S O=$P(LRM,U),Z="65.01,.01" D AUDIT
. S O=$P(LRM,U,2),Z="65.01,.02" D AUDIT
I AFTPAT<BEGPAT D BLD4
Q
;
BLD ; Gets all original blood samples for a patient, sets into the
; BEGB() array and counts total for later comparison
S (BLD,BEGBLD)=0
F S BLD=$O(^LRD(65,LRIEN,2,LRDFN,1,BLD)) Q:BLD'>0 S BEGBLD=BEGBLD+1,BEGB(BLD)=^LRD(65,LRIEN,2,LRDFN,1,BLD,0)
Q
;
BLD1 ; Gets patient blood samples after editing, set into AFTB() array,
; counts total. If total after editing < original total, then the
; deleted node is built onto the audit trail.
S (BLD,AFTBLD)=0
F S BLD=$O(^LRD(65,LRIEN,2,LRDFN,1,BLD)) Q:BLD'>0 S AFTBLD=AFTBLD+1,AFTB(BLD)=^LRD(65,LRIEN,2,LRDFN,1,BLD,0)
Q:'$D(BEGBLD) I AFTBLD<BEGBLD D BLD2 Q
Q
BLD2 ; Actual code that puts the Blood Sample Date/Time subfields
; into the audit trail.
S LRM=BNODE
S O=$P(LRM,U),Z="65.02,.01" D AUDIT
S O=$P(LRM,U,2),Z="65.02,.02" D AUDIT
S O=$P(LRM,U,3),Z="65.02,.03" D AUDIT
S O=$P(LRM,U,4),Z="65.02,.04" D AUDIT
S O=$P(LRM,U,5),Z="65.02,.05" D AUDIT
S O=$P(LRM,U,7),Z="65.02,.07" D AUDIT
S O=$P(LRM,U,8),Z="65.02,.08" D AUDIT
S O=$P(LRM,U,9),Z="65.02,.09" D AUDIT
S O=$P(LRM,U,10),Z="65.02,.1" D AUDIT
Q
;
BLD3 ; Gets all Blood Sample date/time assigned to a particular
; LRDFN, sets into BEGB1() array, counts total. This is so
; that the audit trail is built for this submultiple node
; in the case that the entire Patient Xmatched/Assigned node
; is deleted.
S (BLD1,BEGBLD1)=0
F S BLD1=$O(^LRD(65,LRIEN,2,LRDFN,1,BLD1)) Q:BLD1'>0 S BEGB1(BLD1)=^LRD(65,LRIEN,2,LRDFN,1,BLD1,0),BEGBLD1=BEGBLD1+1
Q
;
BLD4 ; If a Patients Xmatched/Assigned entry has been deleted, adds
; adds any Blood Sample Date/time entries for that deleted
; patient to the audit trail.
I '$D(BEGB1) Q
F BLD1=0:0 S BLD1=$O(BEGB1(BLD1)) Q:'BLD1 S BNODE=BEGB1(BLD1) D BLD2
Q
;
AUDIT I O]"" S X="Deleted" D EN^LRUD
Q
;
K ; Kills variables created during editing of a disposition
K LRDISP,LRDSP,LRDIST,LRPERS,LRPTRANS,LRDIPD,LRPTR,LRPHYS,LRTS,LRREC,LRREACT,LRPROVN,LRTSNUM,LRRXTYPE,LRPTREC,LRTRDT,LRCOMP,LRCOMPID,LRENTP,LRUNABO,LRUNRH,LRPOOL,LRRECRX,LROLD,LRVOL,LRTYPE
Q
;
CHECK I O'=X D EN^LRUD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLAUD 4451 printed Oct 16, 2024@18:10:59 Page 2
LRBLAUD ;TOG/CYM - AUDIT TRAIL MULTIPLE FIELDS 9/3/97 14:32
+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 ;
+5 ; Routine is called by file 65 edit template LRBLIXR
+6 ;
+7 ; Multiple field arrays are built and totaled before and after
+8 ; editing LRBLIXR to be used for comparison. If total after editing
+9 ; is less than before editing, then the entire node is put onto
+10 ; the Audit trail for Blood Bank.
+11 ;
REL ; Gets original relocation episodes for a unit, sets into the
+1 ; BEGR() array and counts total for later comparison
+2 SET (REL,BEGREL)=0
+3 FOR
SET REL=$ORDER(^LRD(65,LRIEN,3,REL))
if REL'>0
QUIT
SET BEGREL=BEGREL+1
SET BEGR(REL)=^LRD(65,LRIEN,3,REL,0)
+4 QUIT
+5 ;
REL1 ; Gets relocation episodes for unit after editing, sets into AFTR()
+1 ; array, counts total. If total after edit < original total, then
+2 ; entire deleted record is built onto the audit trail
+3 SET (REL,AFTREL)=0
+4 FOR
SET REL=$ORDER(^LRD(65,LRIEN,3,REL))
if REL'>0
QUIT
SET AFTREL=AFTREL+1
SET AFTR(REL)=^LRD(65,LRIEN,3,REL,0)
+5 IF AFTREL<BEGREL
Begin DoDot:1
+6 SET LRM=NODE
+7 SET O=$PIECE(LRM,U)
SET Z="65.03,.01"
DO AUDIT
+8 SET O=$PIECE(LRM,U,2)
SET Z="65.03,.02"
DO AUDIT
+9 SET O=$PIECE(LRM,U,3)
SET Z="65.03,.03"
DO AUDIT
+10 SET O=$PIECE(LRM,U,4)
SET Z="65.03,.04"
DO AUDIT
+11 SET O=$PIECE(LRM,U,5)
SET Z="65.03,.05"
DO AUDIT
+12 SET O=$PIECE(LRM,U,6)
SET Z="65.03,.06"
DO AUDIT
+13 SET O=$PIECE(LRM,U,7)
SET Z="65.03,.07"
DO AUDIT
+14 KILL NODE
End DoDot:1
+15 QUIT
+16 ;
PAT ; Gets all unit's Patient Xmatched/Assigned episodes, sets into
+1 ; the BEGP() array & counts total for later comparison
+2 SET (BEGPAT,PAT)=0
+3 FOR
SET PAT=$ORDER(^LRD(65,LRIEN,2,PAT))
if PAT'>0
QUIT
SET BEGPAT=BEGPAT+1
SET BEGP(PAT)=^LRD(65,LRIEN,2,PAT,0)
+4 QUIT
+5 ;
PAT1 ; Gets all Patients Xmatched/Assigned for a unit after editing and
+1 ; puts into AFTP() array. If total after editing < original total
+2 ; then the deleted patient Xmatched/Assigned node is built onto the
+3 ; audit trail. The input template then call line BLD3 to get the
+4 ; associated Blood Sample date/time multiple & include this on the
+5 ; audit trail also.
+6 SET (PAT,AFTPAT)=0
+7 FOR
SET PAT=$ORDER(^LRD(65,LRIEN,2,PAT))
if PAT'>0
QUIT
SET AFTPAT=AFTPAT+1
SET AFTP(PAT)=^LRD(65,LRIEN,2,PAT,0)
+8 IF AFTPAT<BEGPAT
Begin DoDot:1
+9 SET LRM=PNODE
+10 SET O=$PIECE(LRM,U)
SET Z="65.01,.01"
DO AUDIT
+11 SET O=$PIECE(LRM,U,2)
SET Z="65.01,.02"
DO AUDIT
End DoDot:1
+12 IF AFTPAT<BEGPAT
DO BLD4
+13 QUIT
+14 ;
BLD ; Gets all original blood samples for a patient, sets into the
+1 ; BEGB() array and counts total for later comparison
+2 SET (BLD,BEGBLD)=0
+3 FOR
SET BLD=$ORDER(^LRD(65,LRIEN,2,LRDFN,1,BLD))
if BLD'>0
QUIT
SET BEGBLD=BEGBLD+1
SET BEGB(BLD)=^LRD(65,LRIEN,2,LRDFN,1,BLD,0)
+4 QUIT
+5 ;
BLD1 ; Gets patient blood samples after editing, set into AFTB() array,
+1 ; counts total. If total after editing < original total, then the
+2 ; deleted node is built onto the audit trail.
+3 SET (BLD,AFTBLD)=0
+4 FOR
SET BLD=$ORDER(^LRD(65,LRIEN,2,LRDFN,1,BLD))
if BLD'>0
QUIT
SET AFTBLD=AFTBLD+1
SET AFTB(BLD)=^LRD(65,LRIEN,2,LRDFN,1,BLD,0)
+5 if '$DATA(BEGBLD)
QUIT
IF AFTBLD<BEGBLD
DO BLD2
QUIT
+6 QUIT
BLD2 ; Actual code that puts the Blood Sample Date/Time subfields
+1 ; into the audit trail.
+2 SET LRM=BNODE
+3 SET O=$PIECE(LRM,U)
SET Z="65.02,.01"
DO AUDIT
+4 SET O=$PIECE(LRM,U,2)
SET Z="65.02,.02"
DO AUDIT
+5 SET O=$PIECE(LRM,U,3)
SET Z="65.02,.03"
DO AUDIT
+6 SET O=$PIECE(LRM,U,4)
SET Z="65.02,.04"
DO AUDIT
+7 SET O=$PIECE(LRM,U,5)
SET Z="65.02,.05"
DO AUDIT
+8 SET O=$PIECE(LRM,U,7)
SET Z="65.02,.07"
DO AUDIT
+9 SET O=$PIECE(LRM,U,8)
SET Z="65.02,.08"
DO AUDIT
+10 SET O=$PIECE(LRM,U,9)
SET Z="65.02,.09"
DO AUDIT
+11 SET O=$PIECE(LRM,U,10)
SET Z="65.02,.1"
DO AUDIT
+12 QUIT
+13 ;
BLD3 ; Gets all Blood Sample date/time assigned to a particular
+1 ; LRDFN, sets into BEGB1() array, counts total. This is so
+2 ; that the audit trail is built for this submultiple node
+3 ; in the case that the entire Patient Xmatched/Assigned node
+4 ; is deleted.
+5 SET (BLD1,BEGBLD1)=0
+6 FOR
SET BLD1=$ORDER(^LRD(65,LRIEN,2,LRDFN,1,BLD1))
if BLD1'>0
QUIT
SET BEGB1(BLD1)=^LRD(65,LRIEN,2,LRDFN,1,BLD1,0)
SET BEGBLD1=BEGBLD1+1
+7 QUIT
+8 ;
BLD4 ; If a Patients Xmatched/Assigned entry has been deleted, adds
+1 ; adds any Blood Sample Date/time entries for that deleted
+2 ; patient to the audit trail.
+3 IF '$DATA(BEGB1)
QUIT
+4 FOR BLD1=0:0
SET BLD1=$ORDER(BEGB1(BLD1))
if 'BLD1
QUIT
SET BNODE=BEGB1(BLD1)
DO BLD2
+5 QUIT
+6 ;
AUDIT IF O]""
SET X="Deleted"
DO EN^LRUD
+1 QUIT
+2 ;
K ; Kills variables created during editing of a disposition
+1 KILL LRDISP,LRDSP,LRDIST,LRPERS,LRPTRANS,LRDIPD,LRPTR,LRPHYS,LRTS,LRREC,LRREACT,LRPROVN,LRTSNUM,LRRXTYPE,LRPTREC,LRTRDT,LRCOMP,LRCOMPID,LRENTP,LRUNABO,LRUNRH,LRPOOL,LRRECRX,LROLD,LRVOL,LRTYPE
+2 QUIT
+3 ;
CHECK IF O'=X
DO EN^LRUD
+1 QUIT
