source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBLAUD1.m@ 800

Last change on this file since 800 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1LRBLAUD1 ;TOG/CYM -AUDIT TRAIL UTILITY ;4/30/97 14:00
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 ; This routine is called by file 65 edit template LRBLIDTM
6 ;
7 ; When a transfusion of TRANSFUSE is edited, the routine
8 ; gathers all information that is deleted along with the
9 ; disposition, puts into an array for later addition to the
10 ; audit trail
11 ;
12 ; Utility also allows for entries in the MODIFY TO/FROM field
13 ; to go onto the audit trail
14 ;
15DISP ; When editing Unit Disposition, gets
16 ; all associated data in files 65 and 63 that are also cleaned up
17 ; and saves variables in the case the Disposition is Edited and the
18 ; appropriate patient's transfusion record needs to be cleaned up.
19 ; If so, these entries are then added to the audit trail.
20 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)
21 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)
22 S LRPROVN=$P(LRPTRANS,U,6),LRTSNUM=$P(LRPTRANS,U,7),LRRXTYPE=$P(LRPTRANS,U,8) I LRPTR]"" D
23 . 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)
24 . 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)
25 Q
26 ;
27DISP1 ; Actual code that adds data removed from the system when a
28 ; disposition is deleted when using the option LRBLSED.
29 Q:$D(^LRD(65,DA,4))
30 S O=$G(LRDISDT),Z="65,4.2" D AUDIT
31 S O=$G(LRPERS),Z="65,4.3" I O]"" S X="Orig Entry Deleted" D EN^LRUD
32 S O=$G(LRDIPD),Z="65,4.4" D AUDIT
33 S O=$G(LRPTR),Z="65,6.1" D AUDIT
34 S O=$G(LRPHYS),Z="65,6.2" D AUDIT
35 S O=$G(LRTS),Z="65,6.3" D AUDIT
36 S O=$G(LRREC),Z="65,6.4" D AUDIT
37 S O=$G(LRREACT),Z="65,6.5" D AUDIT
38 S O=$G(LRPROVN),Z="65,6.6" D AUDIT
39 S O=$G(LRTSNUM),Z="65,6.7" D AUDIT
40 S O=$G(LRRXTYPE),Z="65,6.8" D AUDIT
41 Q:'$D(LRPTR) Q:LRPTR']""
42 S O=$G(LRTRDT),Z="63.017,.01" S DA(1)=LRPTR,DA=LRREC D AUDIT
43 S O=$G(LRCOMP),Z="63.017,.02" D AUDIT
44 S O=$G(LRCOMPID),Z="63.017,.03" D AUDIT
45 S O=$G(LRENTP),Z="63.017,.04" D AUDIT
46 S O=$G(LRUNABO),Z="63.017,.05" D AUDIT
47 S O=$G(LRUNRH),Z="63.017,.06" D AUDIT
48 S O=$G(LRPOOL),Z="63.017,.07" D AUDIT
49 S O=$G(LRRECRX),Z="63.017,.08" D AUDIT
50 S O=$G(LROLD),Z="63.017,.09" D AUDIT
51 S O=$G(LRVOL),Z="63.017,.1" D AUDIT
52 S O=$G(LRTYPE),Z="63.017,.11" D AUDIT
53 Q
54 ;
55AUDIT I O]"" S X="Deleted" D EN^LRUD
56 Q
57 ;
58K ; Kills variables created during editing of a disposition
59 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
60 Q
61 ;
62DISP4 ; Actual code used to evaluate when the DISPOSITION field (4.1)
63 ; is edited and the software edits/deletes associated
64 ; fields. Each field is evaluated and if there is a change
65 ; the changes are captured on the audit trail.
66 S LRM=$G(^LRD(65,DA,4))
67 S O=$G(LRDISDT),X=$P(LRM,U,2),Z="65,4.2" D CHECK
68 S O=$G(LRPERS),X=DUZ,Z="65,4.3" D CHECK
69 S O=$G(LRDIPD),X=$P(LRM,U,4),Z="65,4.4" D CHECK
70 S LRM=$G(^LRD(65,DA,6))
71 S O=$G(LRPTR),X=$P(LRM,U),Z="65,6.1" D CHECK
72 S O=$G(LRPHYS),X=$P(LRM,U,2),Z="65,6.2" D CHECK
73 S O=$G(LRTS),X=$P(LRM,U,3),Z="65,6.3" D CHECK
74 S O=$G(LRREC),X=$P(LRM,U,4),Z="65,6.4" D CHECK
75 S O=$G(LRREACT),X=$P(LRM,U,5),Z="65,6.5" D CHECK
76 S O=$G(LRPROVN),X=$P(LRM,U,6),Z="65,6.6" D CHECK
77 S O=$G(LRTSNUM),X=$P(LRM,U,7),Z="65,6.7" D CHECK
78 S O=$G(LRRXTYPE),X=$P(LRM,U,8),Z="65,6.8" D CHECK
79 I LRPTR]"" D DISP5
80 Q
81 ;
82DISP5 ; If Disposition is edited to TRANSFUSE, routine LRBLJED creates
83 ; a patient transfusion record in file 63. Following code adds
84 ; those changes to the audit trail.
85 S LRM=$G(^LR(LRPTR,1.6,LRREC,0))
86 S O=$G(LRTRDT),X=$P(LRM,U),Z="63.017,.01" S DA(1)=LRPTR,DA=LRREC D CHECK
87 S O=$G(LRCOMP),X=$P(LRM,U,2),Z="63.017,.02" D CHECK
88 S O=$G(LRCOMPID),X=$P(LRM,U,3),Z="63.017,.03" D CHECK
89 S O=$G(LRENTP),X=$P(LRM,U,4),Z="63.017,.04" D CHECK
90 S O=$G(LRUNABO),X=$P(LRM,U,5),Z="63.017,.05" D CHECK
91 S O=$G(LRUNRH),X=$P(LRM,U,6),Z="63.017,.06" D CHECK
92 S O=$G(LRPOOL),X=$P(LRM,U,7),Z="63.017,.07" D CHECK
93 S O=$G(LRRECRX),X=$P(LRM,U,8),Z="63.017,.08" D CHECK
94 S O=$G(LROLD),X=$P(LRM,U,9),Z="63.017,.09" D CHECK
95 S O=$G(LRVOL),X=$P(LRM,U,10),Z="63.017,.1" D CHECK
96 S O=$G(LRTYPE),X=$P(LRM,U,11),Z="63.017,.11" D CHECK
97 Q
98 ;
99MOD ; At the beginning of an edit session, collects all data
100 ; in the MODIFIED TO/FROM field multiple, puts into a
101 ; BEGM() array and counts total for later comparison.
102 S (MOD,BEGMOD)=0
103 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)
104 Q
105 ;
106MOD2 ; If a disposition of MODIFY is deleted, collects all data in the
107 ; MODIFY TO/FROM field multiple (from the BEGM() array), and adds
108 ; to the audit trail before the software deletes the entries.
109 Q:'$D(BEGM)
110 S DA(1)=DA,MOD=0 F S MOD=$O(^LRD(65,LRIEN,9,MOD)) Q:MOD'>0 D
111 . S LRM=^LRD(65,LRIEN,9,MOD,0)
112 . S O=$P(LRM,U),Z="65.091,.01" D AUDIT
113 . S O=$P(LRM,U,2),Z="65.091,.02" D AUDIT
114 . S O=$P(LRM,U,3),Z="65.091,.03" D AUDIT
115 Q
116 ;
117MOD3 ; Counts MODIFY TO/FROM entries after unit is modified.
118 ; If total entries after modification < total entries before
119 ; modification puts deleted entry onto the audit trail
120 S (MOD,AFTMOD)=0
121 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)
122 I AFTMOD<BEGMOD D
123 . S AUD=0
124 . F S AUD=$O(BEGM(LRIEN,9,AUD)) Q:AUD'>0 D
125 .. I '$D(^LRD(65,LRIEN,9,AUD)) D
126 ... S LRM=BEGM(LRIEN,9,AUD)
127 ... S O=$P(LRM,U),Z="65.091,.01" D AUDIT
128 ... S O=$P(LRM,U,2),Z="65.091,.02" D AUDIT
129 ... S O=$P(LRM,U,3),Z="65.091,.03" D AUDIT
130 I AFTMOD>BEGMOD D
131 . S AUD=0
132 . F S AUD=$O(AFTM(LRIEN,9,AUD)) Q:AUD'>0 D
133 .. I '$D(BEGM(LRIEN,9,AUD)) D
134 ... S LRM=^LRD(65,LRIEN,9,AUD,0)
135 ... S X=$P(LRM,U),Z="65.091,.01",O="" D EN^LRUD
136 ... S X=$P(LRM,U,2),Z="65.091,.02",O="" D EN^LRUD
137 Q
138CHECK I O'=X D EN^LRUD
139 Q
Note: See TracBrowser for help on using the repository browser.