Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRBLAUD1

LRBLAUD1.m

Go to the documentation of this file.
  1. LRBLAUD1 ;TOG/CYM -AUDIT TRAIL UTILITY ;4/30/97 14:00
  1. ;;5.2;LAB SERVICE;**90,247**;Sep 27, 1994
  1. ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
  1. ;
  1. ; This routine is called by file 65 edit template LRBLIDTM
  1. ;
  1. ; When a transfusion of TRANSFUSE is edited, the routine
  1. ; gathers all information that is deleted along with the
  1. ; disposition, puts into an array for later addition to the
  1. ; audit trail
  1. ;
  1. ; Utility also allows for entries in the MODIFY TO/FROM field
  1. ; to go onto the audit trail
  1. ;
  1. DISP ; When editing Unit Disposition, gets
  1. ; all associated data in files 65 and 63 that are also cleaned up
  1. ; and saves variables in the case the Disposition is Edited and the
  1. ; appropriate patient's transfusion record needs to be cleaned up.
  1. ; If so, these entries are then added to the audit trail.
  1. S LRDISP=$G(^LRD(65,DA,4)),LRDSP=$P(LRDISP,U),LRDISDT=$P(LRDISP,U,2),LRPERS=$P(LRDISP,U,3),LRDIPD=$P(LRDISP,U,4)
  1. S LRPTRANS=$G(^LRD(65,DA,6)),LRPTR=$P(LRPTRANS,U),LRPHYS=$P(LRPTRANS,U,2),LRTS=$P(LRPTRANS,U,3),LRREC=$P(LRPTRANS,U,4),LRREACT=$P(LRPTRANS,U,5)
  1. S LRPROVN=$P(LRPTRANS,U,6),LRTSNUM=$P(LRPTRANS,U,7),LRRXTYPE=$P(LRPTRANS,U,8) I LRPTR]"" D
  1. . S LRPTREC=$G(^LR(LRPTR,1.6,LRREC,0)),LRTRDT=$P(LRPTREC,U),LRCOMP=$P(LRPTREC,U,2),LRCOMPID=$P(LRPTREC,U,3),LRENTP=$P(LRPTREC,U,4),LRUNABO=$P(LRPTREC,U,5)
  1. . S LRUNRH=$P(LRPTREC,U,6),LRPOOL=$P(LRPTREC,U,7),LRRECRX=$P(LRPTREC,U,8),LROLD=$P(LRPTREC,U,9),LRVOL=$P(LRPTREC,U,10),LRTYPE=$P(LRPTREC,U,11)
  1. Q
  1. ;
  1. DISP1 ; Actual code that adds data removed from the system when a
  1. ; disposition is deleted when using the option LRBLSED.
  1. Q:$D(^LRD(65,DA,4))
  1. S O=$G(LRDISDT),Z="65,4.2" D AUDIT
  1. S O=$G(LRPERS),Z="65,4.3" I O]"" S X="Orig Entry Deleted" D EN^LRUD
  1. S O=$G(LRDIPD),Z="65,4.4" D AUDIT
  1. S O=$G(LRPTR),Z="65,6.1" D AUDIT
  1. S O=$G(LRPHYS),Z="65,6.2" D AUDIT
  1. S O=$G(LRTS),Z="65,6.3" D AUDIT
  1. S O=$G(LRREC),Z="65,6.4" D AUDIT
  1. S O=$G(LRREACT),Z="65,6.5" D AUDIT
  1. S O=$G(LRPROVN),Z="65,6.6" D AUDIT
  1. S O=$G(LRTSNUM),Z="65,6.7" D AUDIT
  1. S O=$G(LRRXTYPE),Z="65,6.8" D AUDIT
  1. Q:'$D(LRPTR) Q:LRPTR']""
  1. S O=$G(LRTRDT),Z="63.017,.01" S DA(1)=LRPTR,DA=LRREC D AUDIT
  1. S O=$G(LRCOMP),Z="63.017,.02" D AUDIT
  1. S O=$G(LRCOMPID),Z="63.017,.03" D AUDIT
  1. S O=$G(LRENTP),Z="63.017,.04" D AUDIT
  1. S O=$G(LRUNABO),Z="63.017,.05" D AUDIT
  1. S O=$G(LRUNRH),Z="63.017,.06" D AUDIT
  1. S O=$G(LRPOOL),Z="63.017,.07" D AUDIT
  1. S O=$G(LRRECRX),Z="63.017,.08" D AUDIT
  1. S O=$G(LROLD),Z="63.017,.09" D AUDIT
  1. S O=$G(LRVOL),Z="63.017,.1" D AUDIT
  1. S O=$G(LRTYPE),Z="63.017,.11" D AUDIT
  1. Q
  1. ;
  1. AUDIT I O]"" S X="Deleted" D EN^LRUD
  1. Q
  1. ;
  1. K ; Kills variables created during editing of a disposition
  1. K LRIEN,NODE2,LRDISDT,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,MOD,BEGMOD,AFTMOD,BEGM
  1. Q
  1. ;
  1. DISP4 ; Actual code used to evaluate when the DISPOSITION field (4.1)
  1. ; is edited and the software edits/deletes associated
  1. ; fields. Each field is evaluated and if there is a change
  1. ; the changes are captured on the audit trail.
  1. S LRM=$G(^LRD(65,DA,4))
  1. S O=$G(LRDISDT),X=$P(LRM,U,2),Z="65,4.2" D CHECK
  1. S O=$G(LRPERS),X=DUZ,Z="65,4.3" D CHECK
  1. S O=$G(LRDIPD),X=$P(LRM,U,4),Z="65,4.4" D CHECK
  1. S LRM=$G(^LRD(65,DA,6))
  1. S O=$G(LRPTR),X=$P(LRM,U),Z="65,6.1" D CHECK
  1. S O=$G(LRPHYS),X=$P(LRM,U,2),Z="65,6.2" D CHECK
  1. S O=$G(LRTS),X=$P(LRM,U,3),Z="65,6.3" D CHECK
  1. S O=$G(LRREC),X=$P(LRM,U,4),Z="65,6.4" D CHECK
  1. S O=$G(LRREACT),X=$P(LRM,U,5),Z="65,6.5" D CHECK
  1. S O=$G(LRPROVN),X=$P(LRM,U,6),Z="65,6.6" D CHECK
  1. S O=$G(LRTSNUM),X=$P(LRM,U,7),Z="65,6.7" D CHECK
  1. S O=$G(LRRXTYPE),X=$P(LRM,U,8),Z="65,6.8" D CHECK
  1. I LRPTR]"" D DISP5
  1. Q
  1. ;
  1. DISP5 ; If Disposition is edited to TRANSFUSE, routine LRBLJED creates
  1. ; a patient transfusion record in file 63. Following code adds
  1. ; those changes to the audit trail.
  1. S LRM=$G(^LR(LRPTR,1.6,LRREC,0))
  1. S O=$G(LRTRDT),X=$P(LRM,U),Z="63.017,.01" S DA(1)=LRPTR,DA=LRREC D CHECK
  1. S O=$G(LRCOMP),X=$P(LRM,U,2),Z="63.017,.02" D CHECK
  1. S O=$G(LRCOMPID),X=$P(LRM,U,3),Z="63.017,.03" D CHECK
  1. S O=$G(LRENTP),X=$P(LRM,U,4),Z="63.017,.04" D CHECK
  1. S O=$G(LRUNABO),X=$P(LRM,U,5),Z="63.017,.05" D CHECK
  1. S O=$G(LRUNRH),X=$P(LRM,U,6),Z="63.017,.06" D CHECK
  1. S O=$G(LRPOOL),X=$P(LRM,U,7),Z="63.017,.07" D CHECK
  1. S O=$G(LRRECRX),X=$P(LRM,U,8),Z="63.017,.08" D CHECK
  1. S O=$G(LROLD),X=$P(LRM,U,9),Z="63.017,.09" D CHECK
  1. S O=$G(LRVOL),X=$P(LRM,U,10),Z="63.017,.1" D CHECK
  1. S O=$G(LRTYPE),X=$P(LRM,U,11),Z="63.017,.11" D CHECK
  1. Q
  1. ;
  1. MOD ; At the beginning of an edit session, collects all data
  1. ; in the MODIFIED TO/FROM field multiple, puts into a
  1. ; BEGM() array and counts total for later comparison.
  1. S (MOD,BEGMOD)=0
  1. F S MOD=$O(^LRD(65,LRIEN,9,MOD)) Q:MOD'>0 S BEGMOD=BEGMOD+1,BEGM(LRIEN,9,MOD)=^LRD(65,LRIEN,9,MOD,0)
  1. Q
  1. ;
  1. MOD2 ; If a disposition of MODIFY is deleted, collects all data in the
  1. ; MODIFY TO/FROM field multiple (from the BEGM() array), and adds
  1. ; to the audit trail before the software deletes the entries.
  1. Q:'$D(BEGM)
  1. S DA(1)=DA,MOD=0 F S MOD=$O(^LRD(65,LRIEN,9,MOD)) Q:MOD'>0 D
  1. . S LRM=^LRD(65,LRIEN,9,MOD,0)
  1. . S O=$P(LRM,U),Z="65.091,.01" D AUDIT
  1. . S O=$P(LRM,U,2),Z="65.091,.02" D AUDIT
  1. . S O=$P(LRM,U,3),Z="65.091,.03" D AUDIT
  1. Q
  1. ;
  1. MOD3 ; Counts MODIFY TO/FROM entries after unit is modified.
  1. ; If total entries after modification < total entries before
  1. ; modification puts deleted entry onto the audit trail
  1. S (MOD,AFTMOD)=0
  1. F S MOD=$O(^LRD(65,LRIEN,9,MOD)) Q:MOD'>0 S AFTMOD=AFTMOD+1,AFTM(LRIEN,9,MOD)=^LRD(65,LRIEN,9,MOD,0)
  1. I AFTMOD<BEGMOD D
  1. . S AUD=0
  1. . F S AUD=$O(BEGM(LRIEN,9,AUD)) Q:AUD'>0 D
  1. .. I '$D(^LRD(65,LRIEN,9,AUD)) D
  1. ... S LRM=BEGM(LRIEN,9,AUD)
  1. ... S O=$P(LRM,U),Z="65.091,.01" D AUDIT
  1. ... S O=$P(LRM,U,2),Z="65.091,.02" D AUDIT
  1. ... S O=$P(LRM,U,3),Z="65.091,.03" D AUDIT
  1. I AFTMOD>BEGMOD D
  1. . S AUD=0
  1. . F S AUD=$O(AFTM(LRIEN,9,AUD)) Q:AUD'>0 D
  1. .. I '$D(BEGM(LRIEN,9,AUD)) D
  1. ... S LRM=^LRD(65,LRIEN,9,AUD,0)
  1. ... S X=$P(LRM,U),Z="65.091,.01",O="" D EN^LRUD
  1. ... S X=$P(LRM,U,2),Z="65.091,.02",O="" D EN^LRUD
  1. Q
  1. CHECK I O'=X D EN^LRUD
  1. Q