- LRBLAUD ; IHS/DIR/AAB - AUDIT TRAIL MULTIPLE FIELDS 9/3/97 14:32 ; [ 9/3/97 9:28 AM ]
- ;;5.2;LR;**1003**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**90**;Sep 27, 1994
- ;
- ;
- ; 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
- LRBLAUD ; IHS/DIR/AAB - AUDIT TRAIL MULTIPLE FIELDS 9/3/97 14:32 ; [ 9/3/97 9:28 AM ]
- +1 ;;5.2;LR;**1003**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**90**;Sep 27, 1994
- +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
