source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLOG.m@ 1270

Last change on this file since 1270 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1LRLOG ;SLC/STAFF - Edit Log ;10/15/03 09:08
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4TIMESTMP(PAT,SUB,CDT,USER,TIMESTMP) ; set a timestamp entry in edit log
5 ; from LRPX,LRPXRM
6 ;N DATA,NUM
7 ;S PAT=+$G(PAT)
8 ;S SUB=$G(SUB)
9 ;S CDT=$G(CDT)
10 ;Q:'PAT Q:'$L(SUB) Q:'CDT
11 ;I '$G(TIMESTMP) S TIMESTMP=$$NOW^XLFDT
12 ;S USER=$G(USER)
13 ;S NUM=+$P(^LRLOG(0),U,3)
14 ;S DATA=TIMESTMP_U_PAT_U_SUB_U_CDT_U_USER
15 ;L +^LRLOG(0):20 I '$T Q
16 ;S NUM=1+$P(^LRLOG(0),U,3)
17 ;F Q:'$D(^LRLOG(NUM)) S NUM=NUM+1
18 ;S $P(^LRLOG(0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
19 ;S ^LRLOG(NUM)=DATA
20 ;L -^LRLOG(0)
21 ;S ^LRLOG("B",TIMESTMP,NUM)=""
22 ;S ^LRLOG("P",PAT,TIMESTMP,NUM)=""
23 Q
24 ;
25INIT ; initialize setup of edit log
26 ; sets last edit as timestamp on old data
27 ; does not set user
28 ;N CDT,DATA,DFN,I,IDT,LRDFN,RELEASE,SUB,TIMESTMP
29 ;S I=0 F S I=$O(^LRLOG(I)) Q:I="" K ^LRLOG(I)
30 ;S $P(^LRLOG(0),U,3,4)="0^0"
31 ;S LRDFN=.9
32 ;F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D
33 ;. S DFN=$$DFN^LRPXAPIU(LRDFN)
34 ;. I 'DFN Q
35 ;. S SUB="CH"
36 ;. S IDT=0
37 ;. F S IDT=$O(^LR(LRDFN,SUB,IDT)) Q:IDT<1 D
38 ;.. S DATA=$G(^LR(LRDFN,SUB,IDT,0))
39 ;.. I '$L(DATA) Q
40 ;.. S TIMESTMP=+$P(DATA,U,3)
41 ;.. I 'TIMESTMP Q
42 ;.. S CDT=+DATA
43 ;.. I 'CDT Q
44 ;.. D TIMESTMP(DFN,SUB,CDT,,TIMESTMP)
45 ;. S SUB="MI"
46 ;. S IDT=0
47 ;. F S IDT=$O(^LR(LRDFN,SUB,IDT)) Q:IDT<1 D
48 ;.. S DATA=$G(^LR(LRDFN,SUB,IDT,0))
49 ;.. I '$L(DATA) Q
50 ;.. S CDT=+DATA
51 ;.. I 'CDT Q
52 ;.. S TIMESTMP=+$P(DATA,U,3)
53 ;.. F I=1,5,8,11,16 I $G(^LR(LRDFN,SUB,IDT,I))>TIMESTMP S TIMESTMP=+^(I)
54 ;.. I 'TIMESTMP Q
55 ;.. D TIMESTMP(DFN,SUB,CDT,,TIMESTMP)
56 ;. F SUB="CY","EM","SP" D
57 ;.. S IDT=0
58 ;.. F S IDT=$O(^LR(LRDFN,SUB,IDT)) Q:IDT<1 D
59 ;... S DATA=$G(^LR(LRDFN,SUB,IDT,0))
60 ;... I '$L(DATA) Q
61 ;... S TIMESTMP=+$P(DATA,U,3)
62 ;... I 'TIMESTMP Q
63 ;... S RELEASE=+$P(DATA,U,11)
64 ;... I 'RELEASE Q
65 ;... I RELEASE>TIMESTMP S TIMESTMP=RELEASE
66 ;... S CDT=+DATA
67 ;... I 'CDT Q
68 ;... D TIMESTMP(DFN,SUB,CDT,,TIMESTMP)
69 ;. S SUB="AU"
70 ;. S DATA=$G(^LR(LRDFN,SUB))
71 ;. I 'DATA Q
72 ;. S TIMESTMP=+$P(DATA,U,3)
73 ;. I 'TIMESTMP Q
74 ;. S RELEASE=+$P(DATA,U,15)
75 ;. I 'RELEASE Q
76 ;. I RELEASE>TIMESTMP S TIMESTMP=RELEASE
77 ;. S CDT=$$DOD^LRPXAPIU(DFN)
78 ;. I 'CDT Q
79 ;. D TIMESTMP(DFN,SUB,CDT,,TIMESTMP)
80 Q
81 ;
82DATEINTG(DATE1,DATE2,CNT) ; check integrity on patient's that were edited during a time range
83 ; returns ^TMP("LRLOG",$J),^TMP("LRLOG PATS",$J) - must kill after use
84 ;N DFN,NUMBER
85 ;S DATE1=+$G(DATE1,1),DATE2=+$G(DATE2,9999999)
86 ;D PATS(DATE1,DATE2,.CNT)
87 ;I 'CNT S ^TMP("LRLOG",$J)="0^0" Q
88 ;S (CNT,DFN,NUMBER)=0
89 ;F S DFN=$O(^TMP("LRLOG PATS",$J,DFN)) Q:DFN<1 D
90 ;. D PATINTEG(DFN,.CNT)
91 ;. S NUMBER=NUMBER+1
92 ;S ^TMP("LRLOG",$J)=CNT_U_NUMBER
93 Q
94 ;
95PATS(DATE1,DATE2,CNT) ; get patients that were edited during a time range
96 ; returns ^TMP("LRLOG PATS",$J) - must kill after use
97 ;N BEGCDT,CDT,DATA,DFN,ENDCDT,NUM,TSDT
98 ;K ^TMP("LRLOG PATS",$J)
99 ;S BEGCDT=9999999,(CNT,ENDCDT)=0
100 ;S TSDT=$G(DATE1)-.00001
101 ;F S TSDT=$O(^LRLOG("B",TSDT)) Q:TSDT<1 Q:TSDT>DATE2 D
102 ;. S NUM=0
103 ;. F S NUM=$O(^LRLOG("B",TSDT,NUM)) Q:NUM<1 D
104 ;.. S DATA=$G(^LRLOG(NUM))
105 ;.. S DFN=+$P(DATA,U,2)
106 ;.. S CDT=+$P(DATA,U,4)
107 ;.. I CDT<BEGCDT S BEGCDT=CDT
108 ;.. I CDT>ENDCDT S ENDCDT=CDT
109 ;.. Q:'DFN Q:'CDT
110 ;.. I '$D(^TMP("LRLOG PATS",$J,DFN)) S CNT=CNT+1
111 ;.. S ^TMP("LRLOG PATS",$J,DFN)=BEGCDT_U_ENDCDT
112 ;.. S ^TMP("LRLOG PATS",$J,DFN,NUM)=""
113 ;S ^TMP("LRLOG PATS",$J)=CNT
114 Q
115 ;
116PATINTEG(DFN,CNT) ; check integrity of a patient
117 ; returns ^TMP("LRLOG",$J) - must kill after use
118 ;K ^TMP("LRLOG",$J,DFN)
119 ;S CNT=+$G(CNT)
120 ;D CHKPAT^LRPXCHK(DFN)
121 ;I $D(^TMP("LRLOG",$J,DFN)) S CNT=CNT+1
122 Q
123 ;
124TESTP ; test for patient integrity
125 ;N DIC,X,Y K DIC
126 ;S DIC=2,DIC(0)="AEMOQ"
127 ;D ^DIC I Y<1 Q
128 ;D PATINTEG(+Y)
129 ;K ^TMP("LRLOG",$J)
130 Q
131 ;
132TESTD ; test for integrity of patients that were edited during a date range
133 ;N CNT,DFN,ERR,FROM,TO
134 ;D GETDATE^LRPXAPPU(.FROM,.TO,.ERR) I ERR Q
135 ;S CNT=0
136 ;D DATEINTG(FROM,TO,.CNT)
137 ;S DFN=0
138 ;F S DFN=$O(^TMP("LRLOG PATS",$J,DFN)) Q:DFN<.5 W !,DFN," ",$P(^DPT(DFN,0),U)," checked"
139 ;K ^TMP("LRLOG",$J),^TMP("LRLOG PATS",$J)
140 Q
141 ;
142LTS() ; $$() -> last timestamp ien
143 ;N TSDT
144 ;S TSDT=+$O(^LRLOG("B",""),-1)
145 ;Q +$O(^LRLOG("B",TSDT,0))
146 Q 0 ;remove after testing
147 ;
148LPTS(DFN) ; $$(dfn) -> patient's last timestamp ien
149 ;N TSDT
150 ;S DFN=+$G(DFN)
151 ;S TSDT=+$O(^LRLOG("P",DFN,""),-1)
152 ;Q +$O(^LRLOG("P",DFN,TSDT,0))
153 Q 0 ;remove after testing
154 ;
155TSDT(TSDT,TS) ; API - returns array of timestamps for a timestamp date/time
156 ;N NUM K TS
157 ;S TSDT=+$G(TSDT)
158 ;S NUM=0
159 ;F S NUM=$O(^LRLOG("B",TSDT,NUM)) Q:NUM<1 S TS(NUM)=""
160 Q
161 ;
162PTSDT(DFN,TSDT,TS) ; API - returns patient's array of timestamps for a timestamp date/time
163 ;N NUM K TS
164 ;S DFN=+$G(DFN),TSDT=+$G(TSDT)
165 ;S NUM=0
166 ;F S NUM=$O(^LRLOG("P",DFN,TSDT,NUM)) Q:NUM<1 S TS(NUM)=""
167 Q
168 ;
169NTSDT(TSDT) ; $$(timestamp date/time) -> next timestamp ien from a timestamp date/time
170 ;S TSDT=+$G(TSDT)
171 ;Q +$O(^LRLOG("B",TSDT),-1)
172 Q 0 ;remove after testing
173 ;
174NPTSDT(DFN,TSDT) ; $$(dfn,timestamp date/time) -> patient's next timestamp date/time
175 ;S DFN=+$G(DFN),TSDT=+$G(TSDT)
176 ;Q +$O(^LRLOG("P",DFN,TSDT),-1)
177 Q 0 ;remove after testing
178 ;
179LOG(TS) ; $$(timestamp ien) -> timestamp entry: timestamp^dfn^sub^cdt^user
180 ;Q $G(^LRLOG(+$G(TS)))
181 Q 0 ;remove after testing
182 ;
Note: See TracBrowser for help on using the repository browser.