| 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
 | 
|---|