source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDVSIT.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
RevLine 
[628]1SDVSIT ;MJK/ALB - Visit Tracking Processing ; 3/28/01 2:12pm
2 ;;5.3;Scheduling;**27,44,75,96,132,161,219**;Aug 13, 1993
3 ;
4AEUPD(SDVIEN,SDATYPE,SDOEP) ; -- update one entry in multiple
5 ; input: SDVIEN := Visit file pointer
6 ; SDATYPE := Appointment Type [optional]
7 ; SDOEP := ien of ^SCE that is the parent encounter [optional]
8 ;
9 N SDOE,DA,DR,DE,DQ,DIE,SD0,SDVSIT,SDT,SDLOCK,SDCL0
10 ;
11 G AEUPDQ:'$G(^AUPNVSIT(+$G(SDVIEN),0)) S SD0=^(0)
12 S SDT=+SD0
13 S SDVSIT("DFN")=$P(SD0,U,5)
14 I ('SDVSIT("DFN")) G AEUPDQ
15 ;
16 ; -- set lock data and lock
17 S SDLOCK("DFN")=$P(SD0,U,5)
18 S SDLOCK("EVENT DATE/TIME")=SDT
19 D LOCK(.SDLOCK)
20 ;
21 ; -- quit if encounter does exist for visit
22 IF $O(^SCE("AVSIT",SDVIEN,0)) G AEUPDQ
23 ;
24 S SDVSIT("DIV")=+$P($G(^SC(+$P(SD0,U,22),0)),U,15)
25 S SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))
26 I ('SDVSIT("DIV")) G AEUPDQ
27 ;
28 S SDVSIT("CLN")=+$P(SD0,U,8)
29 ; -- this may not be needed any longer but doesn't hurt (mjk)
30 I $P($G(^DIC(40.7,+$P(SD0,U,8),0)),U,2)=900 S SDVSIT("CLN")=+$P($G(^SC(+$P(SD0,U,22),0)),U,7)
31 I 'SDVSIT("CLN") G AEUPDQ
32 ;
33 S:$P(SD0,U,22) SDVSIT("LOC")=$P(SD0,U,22)
34 S:$P(SD0,U,21) SDVSIT("ELG")=$P(SD0,U,21)
35 S SDVSIT("TYP")=$G(SDATYPE)
36 S SDVSIT("PAR")=$G(SDOEP)
37 S SDVSIT("ORG")=2
38 S SDVSIT("REF")=""
39 S SDOE=$$SDOE(SDT,.SDVSIT,SDVIEN,$G(SDOEP))
40 S SDCL0=$G(^SC(+SDVSIT("LOC"),0))
41 D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
42AEUPDQ D UNLOCK(.SDLOCK)
43 Q
44 ;
45APPT(DFN,SDT,SDCL,SDVIEN) ; -- process appt
46 ; input DFN = ien of patient file entry
47 ; SDT = visit date internal format
48 ; SDCL = ien of hospital location file entry
49 ; SDVIEN = Visit file pointer [optional]
50 ;
51 N SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK
52 ;
53 ; -- set lock data and lock
54 S SDLOCK("DFN")=DFN
55 S SDLOCK("EVENT DATE/TIME")=SDT
56 D LOCK(.SDLOCK)
57 ;
58 ; -- set node vars
59 S SDPT=$G(^DPT(DFN,"S",SDT,0))
60 S SDCL0=$G(^SC(SDCL,0)),SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
61 S SDSC=$G(^SC(SDCL,"S",SDT,1,SDDA,0))
62 S SDVSIT("CLN")=$P(SDCL0,U,7),SDVSIT("DIV")=$$DIV($P(SDCL0,U,15))
63 ;
64 ; -- do checks
65 I 'SDPT!('SDSC)!($P(SDCL0,U,3)'="C") G APPTQ
66 I SDCL,+SDPT'=SDCL G APPTQ
67 I $P(SDPT,U,20) G APPTQ
68 I 'SDVSIT("CLN")!('SDVSIT("DIV")) G APPTQ
69 ;
70 ; -- set the rest
71 S SDVSIT("DFN")=DFN,SDVSIT("LOC")=SDCL
72 S:$P(SDSC,U,10) SDVSIT("ELG")=$P(SDSC,U,10)
73 S:$P(SDPT,U,16) SDVSIT("TYP")=$P(SDPT,U,16)
74 ;
75 ; -- call logic to add opt encounter(s)
76 S SDVSIT("ORG")=1,SDVSIT("REF")=SDDA,SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
77 I SDOE D
78 .N DA,DIE,DR
79 .S DA=SDT,DA(1)=DFN,DR="21////"_SDOE,DIE="^DPT("_DFN_",""S""," D ^DIE
80 ;
81 D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
82 ;
83APPTQ D UNLOCK(.SDLOCK)
84 Q
85 ;
86CSTOP(SDOE,SDCL0,SDVSIT,SDT) ;Process credit stop
87 ;Input: SDOE=encounter ien
88 ;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
89 ;Input: SDVSIT=visit data array (pass by reference)
90 ;Input: SDT=encounter date/time
91 ; -- does clinic have a credit stop code?
92 ; -- process only if non non-count and not equal to credit
93 ;
94 I SDOE,$P(SDCL0,U,18),($P(SDCL0,U,18)'=SDVSIT("CLN")),($P(SDCL0,U,17)'="Y") D
95 . N X,SDVIENSV,SDVIENOR
96 . S X=$G(^DIC(40.7,$P(SDCL0,U,18),0))
97 .; -- is stop code active?
98 . I $S('$P(X,U,3):1,1:SDT<$P(X,U,3)) D
99 . . S SDVSIT("CLN")=$P(SDCL0,U,18)
100 . . S SDVIENOR=$G(SDVSIT("ORG"))
101 . . S SDVSIT("ORG")=4
102 . . S SDVSIT("PAR")=SDOE
103 . . S SDVIENSV=$G(SDVSIT("VST"))
104 . . K SDVSIT("VST")
105 . . S X=$$SDOE(SDT,.SDVSIT)
106 . . IF X D LOGDATA^SDAPIAP(X)
107 . .;
108 . .; -- restore SDVSIT
109 . . S SDVSIT("CLN")=$P(SDCL0,U,7)
110 . . S SDVSIT("ORG")=SDVIENOR
111 . . S SDVSIT("VST")=SDVIENSV
112 . . K SDVSIT("PAR")
113 . . Q
114 . Q
115 Q
116 ;
117DISP(DFN,SDT,SDVIEN) ; -- process disposition
118 ; input DFN = ien of patient file entry
119 ; SDT = visit date internal format
120 ; SDIV = ien of med ctr file entry
121 ; SDVIEN = Visit file pointer [optional]
122 ;
123 N SDVSIT,SDOE,DA,DIE,DR,SDIS,SDDA,SDLOCK
124 ;
125 ; -- set lock data and lock
126 S SDLOCK("DFN")=DFN
127 S SDLOCK("EVENT DATE/TIME")=SDT
128 D LOCK(.SDLOCK)
129 ;
130 ; -- set up array and other vars
131 D ARRAY(.DFN,.SDT,.SDDA,.SDIS,.SDVSIT)
132 ;
133 ; -- do checks
134 I $P(SDIS,U,2)=2!($P(SDIS,U,2)="")!($P(SDIS,U,18)) G DISPQ
135 I 'SDVSIT("CLN")!('SDVSIT("DIV")) G DISPQ
136 ;
137 ; -- call logic to add opt encounter/visit
138 S SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
139 I SDOE S DA=SDDA,DA(1)=DFN,DR="18////"_SDOE,DIE="^DPT("_DFN_",""DIS""," D ^DIE
140DISPQ D UNLOCK(.SDLOCK)
141 Q
142 ;
143ARRAY(DFN,SDT,SDDA,SDIS,SDVSIT) ; -- setup sdvsit for disposition
144 S SDDA=9999999-SDT
145 S SDIS=$G(^DPT(DFN,"DIS",SDDA,0))
146 S SDVSIT("CLN")=$O(^DIC(40.7,"C",102,0))
147 S SDVSIT("DIV")=$$DIV(+$P(SDIS,U,4))
148 S:$P(SDIS,U,13) SDVSIT("ELG")=$P(SDIS,U,13)
149 S SDVSIT("DFN")=DFN
150 S SDVSIT("ORG")=3
151 S SDVSIT("REF")=SDDA
152 S SDVSIT("VST")=""
153 S SDVSIT("TYP")=9
154 Q
155 ;
156LOCK(SDLOCK) ; -- lock "ADFN" node
157 L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
158 Q
159 ;
160UNLOCK(SDLOCK) ; -- unlock "ADFN" node
161 L -^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
162 Q
163 ;
164DIV(DIV) ; -- determine med div
165 I $P($G(^DG(43,1,"GL")),U,2),$D(^DG(40.8,+DIV,0)) G DIVQ ; multi-div?
166 S DIV=+$O(^DG(40.8,0))
167DIVQ Q DIV
168 ;
169 ; -- see bottom of SDVSIT0 for additional doc
170 ;
171SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
172 S SDVSIT("VST")=$G(SDVIEN)
173 IF 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT)
174 Q $$NEW^SDVSIT0(SDT,.SDVSIT)
175 ;
176 ;
177DATECHCK(DATETIME) ;Validate FileMan date/time
178 ;Input : DATETIME - Date and optional time in FileMan format
179 ;Output : DATETIME - Valid date/time in FileMan format
180 ;Notes : If time was not included on input, time will not be included
181 ; on output
182 ; : If time rolls past midnight, 235959 (one second before
183 ; midnight) will be used
184 ; : Current date/time will be returned on NULL input
185 ; : Current date will be used if input date is not valid
186 ;
187 ;Check input
188 Q:($G(DATETIME)="") $$NOW^XLFDT()
189 ;Declare variables
190 N DATE,TIME,HR,MIN,SEC,X,Y,%DT
191 ;Break out date & time
192 S DATE=$P(DATETIME,".",1)
193 S TIME=$P(DATETIME,".",2)_"000000"
194 ;Validate date
195 S X=DATE
196 S %DT="X"
197 D ^%DT
198 ;Date not valid - use current date
199 S:(Y<0) DATE=$$DT^XLFDT()
200 ;No time - return date
201 Q:('TIME) DATE
202 ;Break out hours, minutes, and seconds
203 S HR=$E(TIME,1,2)
204 S MIN=$E(TIME,3,4)
205 S SEC=$E(TIME,5,6)
206 ;Validate seconds - increment minutes if needed
207 S:(SEC>59) MIN=MIN+1,SEC=SEC-60
208 ;Validate minutes - increment hours if needed
209 S:(MIN>59) HR=HR+1,MIN=MIN-60
210 ;Validate hours - revert to one second before midnight
211 S:(HR>23) HR=23,MIN=59,SEC=59
212 ;Append leading zeros to hours, minutes, and seconds
213 S HR="00"_HR
214 S HR=$E(HR,($L(HR)-1),$L(HR))
215 S MIN="00"_MIN
216 S MIN=$E(MIN,($L(MIN)-1),$L(MIN))
217 S SEC="00"_SEC
218 S SEC=$E(SEC,($L(SEC)-1),$L(SEC))
219 ;Rebuild time
220 S TIME=HR_MIN_SEC
221 ;Done - return date and time (trailing zeros removed)
222 Q +(DATE_"."_TIME)
Note: See TracBrowser for help on using the repository browser.