| [613] | 1 | LRBLAUD ;TOG/CYM - AUDIT TRAIL MULTIPLE FIELDS 9/3/97 14:32
|
|---|
| 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 | ;
|
|---|
| 6 | ; Routine is called by file 65 edit template LRBLIXR
|
|---|
| 7 | ;
|
|---|
| 8 | ; Multiple field arrays are built and totaled before and after
|
|---|
| 9 | ; editing LRBLIXR to be used for comparison. If total after editing
|
|---|
| 10 | ; is less than before editing, then the entire node is put onto
|
|---|
| 11 | ; the Audit trail for Blood Bank.
|
|---|
| 12 | ;
|
|---|
| 13 | REL ; Gets original relocation episodes for a unit, sets into the
|
|---|
| 14 | ; BEGR() array and counts total for later comparison
|
|---|
| 15 | S (REL,BEGREL)=0
|
|---|
| 16 | F S REL=$O(^LRD(65,LRIEN,3,REL)) Q:REL'>0 S BEGREL=BEGREL+1,BEGR(REL)=^LRD(65,LRIEN,3,REL,0)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | REL1 ; Gets relocation episodes for unit after editing, sets into AFTR()
|
|---|
| 20 | ; array, counts total. If total after edit < original total, then
|
|---|
| 21 | ; entire deleted record is built onto the audit trail
|
|---|
| 22 | S (REL,AFTREL)=0
|
|---|
| 23 | F S REL=$O(^LRD(65,LRIEN,3,REL)) Q:REL'>0 S AFTREL=AFTREL+1,AFTR(REL)=^LRD(65,LRIEN,3,REL,0)
|
|---|
| 24 | I AFTREL<BEGREL D
|
|---|
| 25 | . S LRM=NODE
|
|---|
| 26 | . S O=$P(LRM,U),Z="65.03,.01" D AUDIT
|
|---|
| 27 | . S O=$P(LRM,U,2),Z="65.03,.02" D AUDIT
|
|---|
| 28 | . S O=$P(LRM,U,3),Z="65.03,.03" D AUDIT
|
|---|
| 29 | . S O=$P(LRM,U,4),Z="65.03,.04" D AUDIT
|
|---|
| 30 | . S O=$P(LRM,U,5),Z="65.03,.05" D AUDIT
|
|---|
| 31 | . S O=$P(LRM,U,6),Z="65.03,.06" D AUDIT
|
|---|
| 32 | . S O=$P(LRM,U,7),Z="65.03,.07" D AUDIT
|
|---|
| 33 | . K NODE
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | PAT ; Gets all unit's Patient Xmatched/Assigned episodes, sets into
|
|---|
| 37 | ; the BEGP() array & counts total for later comparison
|
|---|
| 38 | S (BEGPAT,PAT)=0
|
|---|
| 39 | F S PAT=$O(^LRD(65,LRIEN,2,PAT)) Q:PAT'>0 S BEGPAT=BEGPAT+1,BEGP(PAT)=^LRD(65,LRIEN,2,PAT,0)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | PAT1 ; Gets all Patients Xmatched/Assigned for a unit after editing and
|
|---|
| 43 | ; puts into AFTP() array. If total after editing < original total
|
|---|
| 44 | ; then the deleted patient Xmatched/Assigned node is built onto the
|
|---|
| 45 | ; audit trail. The input template then call line BLD3 to get the
|
|---|
| 46 | ; associated Blood Sample date/time multiple & include this on the
|
|---|
| 47 | ; audit trail also.
|
|---|
| 48 | S (PAT,AFTPAT)=0
|
|---|
| 49 | F S PAT=$O(^LRD(65,LRIEN,2,PAT)) Q:PAT'>0 S AFTPAT=AFTPAT+1,AFTP(PAT)=^LRD(65,LRIEN,2,PAT,0)
|
|---|
| 50 | I AFTPAT<BEGPAT D
|
|---|
| 51 | . S LRM=PNODE
|
|---|
| 52 | . S O=$P(LRM,U),Z="65.01,.01" D AUDIT
|
|---|
| 53 | . S O=$P(LRM,U,2),Z="65.01,.02" D AUDIT
|
|---|
| 54 | I AFTPAT<BEGPAT D BLD4
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | BLD ; Gets all original blood samples for a patient, sets into the
|
|---|
| 58 | ; BEGB() array and counts total for later comparison
|
|---|
| 59 | S (BLD,BEGBLD)=0
|
|---|
| 60 | 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)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | BLD1 ; Gets patient blood samples after editing, set into AFTB() array,
|
|---|
| 64 | ; counts total. If total after editing < original total, then the
|
|---|
| 65 | ; deleted node is built onto the audit trail.
|
|---|
| 66 | S (BLD,AFTBLD)=0
|
|---|
| 67 | 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)
|
|---|
| 68 | Q:'$D(BEGBLD) I AFTBLD<BEGBLD D BLD2 Q
|
|---|
| 69 | Q
|
|---|
| 70 | BLD2 ; Actual code that puts the Blood Sample Date/Time subfields
|
|---|
| 71 | ; into the audit trail.
|
|---|
| 72 | S LRM=BNODE
|
|---|
| 73 | S O=$P(LRM,U),Z="65.02,.01" D AUDIT
|
|---|
| 74 | S O=$P(LRM,U,2),Z="65.02,.02" D AUDIT
|
|---|
| 75 | S O=$P(LRM,U,3),Z="65.02,.03" D AUDIT
|
|---|
| 76 | S O=$P(LRM,U,4),Z="65.02,.04" D AUDIT
|
|---|
| 77 | S O=$P(LRM,U,5),Z="65.02,.05" D AUDIT
|
|---|
| 78 | S O=$P(LRM,U,7),Z="65.02,.07" D AUDIT
|
|---|
| 79 | S O=$P(LRM,U,8),Z="65.02,.08" D AUDIT
|
|---|
| 80 | S O=$P(LRM,U,9),Z="65.02,.09" D AUDIT
|
|---|
| 81 | S O=$P(LRM,U,10),Z="65.02,.1" D AUDIT
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | BLD3 ; Gets all Blood Sample date/time assigned to a particular
|
|---|
| 85 | ; LRDFN, sets into BEGB1() array, counts total. This is so
|
|---|
| 86 | ; that the audit trail is built for this submultiple node
|
|---|
| 87 | ; in the case that the entire Patient Xmatched/Assigned node
|
|---|
| 88 | ; is deleted.
|
|---|
| 89 | S (BLD1,BEGBLD1)=0
|
|---|
| 90 | 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
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | BLD4 ; If a Patients Xmatched/Assigned entry has been deleted, adds
|
|---|
| 94 | ; adds any Blood Sample Date/time entries for that deleted
|
|---|
| 95 | ; patient to the audit trail.
|
|---|
| 96 | I '$D(BEGB1) Q
|
|---|
| 97 | F BLD1=0:0 S BLD1=$O(BEGB1(BLD1)) Q:'BLD1 S BNODE=BEGB1(BLD1) D BLD2
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | AUDIT I O]"" S X="Deleted" D EN^LRUD
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | K ; Kills variables created during editing of a disposition
|
|---|
| 104 | 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
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | CHECK I O'=X D EN^LRUD
|
|---|
| 108 | Q
|
|---|
