source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPESR1.m@ 1442

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

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1PRSPESR1 ;WOIFO/JAH - part time physicians ESR Edit ;11/04/04
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5ESRFRM(PRSIEN,PPI,PRSD) ;Run ScreenMan Form PRSA ESR EDIT on file 458
6 ;
7 N TOD,TOD2,TOUR,STAT,GLOB,PRSN1,PRSN2,PRSN4,PRSN5,PRSN6,Y31,PRSDTE
8 N MLALLOW,PRSML,PRSML2,DFN,Z,ZENT,DIE,DA,DDSFILE,STOP,Z
9 ;
10 S STAT=$$GETSTAT(PRSIEN,PPI,PRSD)
11 S TOD=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
12 S TOD2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,13)
13 ; NODES THAT WE MAY EDIT IN THE FORM
14 S PRSN1=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1)) ; tour segmts
15 S PRSN4=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4)) ; 2nd tour
16 S PRSN5=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)) ; esr wrk
17 S PRSN6=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,6)) ; daily esr remrks
18 ;
19 ; get ALL TOUR SGMNTS + meal for display
20 ;
21 S Y31=$$GETTOUR^PRSPESR3(PRSIEN,PRSD,TOD,PRSN1,PRSN4)
22 S PRSML=$P($G(^PRST(457.1,TOD,0)),U,3)
23 S MLALLOW=60
24 ;
25 ; If second tour, have meal time handy
26 I $G(TOD2)>0 D
27 . S PRSML2=$P($G(^PRST(457.1,TOD2,0)),U,3)
28 . S MLALLOW=120
29 ;
30 S PRSDTE=$P($G(^PRST(458,PPI,2)),U,PRSD)
31 ;
32 ; DFN needed for old call to lock record.
33 S DFN=PRSIEN I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) Q
34 ; ScreenMan
35 S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=PRSIEN,DA=PRSD
36 S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
37 ;
38 ; allowed types of time for ESR
39 ; days off only allow RG
40 S ZENT=$S(Y31="Day Off":"RG",1:"RG AL AA DL ML HX CP RL SL CB AD WP TV TR")
41 S DR="[PRSP ESR POST]" D ^DDS
42 ;
43 ; remove blank rows from ESR
44 S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
45 S ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)=$$BURP^PRSPESR2(Z)
46 D:GLOB]"" UNLOCK^PRSLIB00(GLOB)
47 Q
48 ;
49GETSTAT(PRSIEN,PPI,PRSD) ; func return status
50 ; esr daily status (#146) 1:NOT STARTED;2:PENDING;3:RESUBMIT;
51 ; 4:SIGNED;5:APPROVED;6:DAY OFF
52 Q $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),"^",1)
53 ;
54ESRVALID ; Validate Daily ESR data
55 ; called when PTP attempts to save ScrMn form PRSP ESR POST (F458)
56 ; DDSERROR set to prevent save.
57 ; DDSBR set takes user field
58 ;
59 ; Z - combo: global time segs + form edits.
60 ;
61 ; If data unchanged, skip validation and esig
62 ; But if status = Pend OR Resub, PTP may sign even if data unchanged.
63 N STR,WARNING
64 I $G(Z)'="",$G(Z)=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)),STAT'=2,STAT'=3 D Q
65 . D MSG^DDSUTL("...No edits to save")
66 ;
67 ; If DDSERROR (bad user data), return to ScreenMan
68 D CHKDATA
69 Q:$G(DDSERROR)
70 ;
71 ; display warning if any are found but don't stop user from signing
72 I $G(WARNING) D WARNMSG^PRSPESR3(STR)
73 ;
74 ; If user hits return at sign prompt, save as pending
75 ; If user types "^" don't save changes
76 ; If user signs, save.
77 ;
78 N X1
79 D SIG^XUSESIG
80 I X1="" D
81 . N PRSMSG
82 . S PRSMSG="CANCEL: ESR day changes were not saved."
83 . I $G(X)="^" D
84 .. S DDSERROR=1
85 .. D MSG^DDSUTL(PRSMSG)
86 . E D
87 .. N DIE,DR,DA
88 .. S DA(2)=$G(PPI),DA(1)=$G(PRSIEN),DA=$G(PRSD)
89 ..; if status is resubmit and they didn't sign then leave it resubmit
90 .. I STAT=3 D
91 ... S DR="146///RESUBMIT;149///MANUAL POST"
92 ... S PRSMSG="RESUBMIT: changes saved w/out signature, but status remains Resubmit."
93 .. E D
94 ... S DR="146///PENDING;149///MANUAL POST"
95 ... S PRSMSG="PENDING: ESR day changes saved w/out signature."
96 ... S STAT=2 ; form global var ESR DAILY STATUS gets PENDING
97 .. S DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
98 .. D ^DIE
99 .. K X ; reset X since it's saved to dataBse.
100 .. D MSG^DDSUTL(PRSMSG)
101 E D
102 .; update ESR DAILY STATUS and ESR LAST SIGN METHOD
103 . N PRSFDA,IENS,STAMP
104 . S STAMP=$$NOW^XLFDT()
105 .;
106 . S IENS=PRSD_","_PRSIEN_","_PPI_","
107 . S PRSFDA(458.02,IENS,146)=4
108 . S PRSFDA(458.02,IENS,147)=STAMP
109 . S PRSFDA(458.02,IENS,149)=1
110 . D FILE^DIE("","PRSFDA")
111 . D MSG^DIALOG()
112 .;
113 . K X ; reset X, it's saved to database.
114 . S STAT=4 ; form global var ESR DAILY STATUS gets SIGNED
115 . D MSG^DDSUTL("SIGNED: ESR data saved with signature.")
116 Q
117 ;
118CHKDATA ; called to validate screenman posting on ESR daily
119 ;
120 ; Z initialized to data that appears on the unedited form.
121 ; when a field on ScreenMan form changes the appropriate piece
122 ; of Z is updated in the post action change field in ScreenMan.
123 ; so Z contains the original data for a day plus any changes that
124 ; the user is trying to save.
125 ; each 5 pieces of z hold START, STOP, TYPE OF TIME, REMARKS, MEAL
126 ;
127 N T,K,ZS,NOTHING,MLP,DY2,MTOT,TWO,Z1,Z2,Y
128 S ZS=""
129 ;
130 ; 2 day tour?
131 S TWO=$P($G(^PRST(457.1,+TOD,0)),U,5)
132 S DY2=TWO="Y"
133 I TOD2,'DY2 S TWO=$P($G(^PRST(457.1,+TOD2,0)),U,5),DY2=TWO="Y"
134 ;
135 ;loop thru 5 columns, 7 time segments
136 ; quit if we encounter an error
137 F K=1:5:31 Q:$G(DDSERROR) D
138 .;
139 .; if absolutely nothing on any segments in the row or just a zero
140 .; in meal column then skip row.
141 .;
142 . S NOTHING=(($P(Z,U,K)="")&($P(Z,U,K+1)="")&($P(Z,U,K+2)="")&($P(Z,U,K+3)="")&(($P(Z,U,K+4)="")!($P(Z,U,K+4)=0)))
143 . Q:NOTHING
144 .;
145 .; missing start or stop
146 . I $P(Z,U,K)=""!($P(Z,U,K+1)="") D E8 S DDSERROR=1 Q
147 .;
148 .; 2nd day posting on 1 day tour (ALLOW RG POSTING ACROSS MID)
149 . S X=$P(Z,U,K)_U_$P(Z,U,K+1)
150 . D CNV^PRSATIM S Z1=$P(Y,U,1),Z2=$P(Y,U,2)
151 . D V0^PRSATP1
152 . I Z2>1440,TWO'="Y","RG OT CT SB ON UA"'[$P(Z,U,K+2) D Q
153 .. D E4
154 .. S DDSERROR=1
155 .;
156 .; posted more than 48 hrs (2880 min)
157 . I Z2>2880 D E5 S DDSERROR=1 Q
158 .;
159 .; no type of time
160 . I $P(Z,U,K+2)="" D E9 S DDSERROR=1 Q
161 .;
162 . I '(Z["HX"&("ON HW"[$P(Z,U,K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) S DDSERROR=1 D E3 Q
163 . I $P(Z,U,K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,12) S DDSERROR=1 D E7 Q
164 . I $P(Z,U,K+2)'="" S T(Z1,K)=Z2_U_$P(Z,U,K,K+3)
165 ;
166 ; T: 1st subscript is start time (minutes from midnight)
167 ; 2nd subsc is segment number on form (or in Z var)
168 ; piece 1 stop time in minutes from midnight.
169 ; for 3 segment postings will look like the following:
170 ; T(945,1)=1140^03:45P^07:00P^RG^
171 ; T(1140,6)=1305^07:00P^09:45P^RG^
172 ; T(1320,11)=1380^10:00P^11:00P^RG
173 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
174 I '$D(T) Q
175 ;
176 ; segment overlap
177 I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) D
178 . S Z1=""
179 . F S Z1=$O(T(Z1)) Q:Z1=""!($G(DDSERROR)) D
180 .. I Z1'<T(Z1,$O(T(Z1,0))) D
181 ... D E1
182 ... S DDSERROR=1
183 .. E D
184 ... S Y=$O(T(Z1))
185 ... I Y,T(Z1,$O(T(Z1,0)))>Y S DDSERROR=1 D E2
186 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
187 ;
188 ; leave outside time segments
189 I $$VALIDLV^PRSPESR2(PRSN1,.T),$$VALIDLV^PRSPESR2(PRSN4,.T) S DDSERROR=1 D E14,HLP^DDSUTL(.STR) Q
190 ;
191 S Z1=$$GET^DDSVAL(DIE,.DA,145)
192 ;
193 ; make sure we have some txt in remarks field when required
194 I Z1="" D
195 . F K=1:5:31 Q:$G(DDSERROR) D
196 .. I $P(Z,U,K+2)="AA" D E6 S DDSERROR=1 Q
197 .. I $P(Z,U,K+2)="WP",$P(Z,U,K+3)=3 D E10 S DDSERROR=1 Q
198 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
199 ;
200 ; check for too much total meal for whole day
201 S MTOT=0
202 F K=1:5:31 S MTOT=MTOT+$P(Z,U,K+4)
203 I MTOT>MLALLOW D E15 S DDSERROR=1 D HLP^DDSUTL(.STR) Q
204 ;
205 ; check for too much meal on any segment
206 F K=1:5:31 Q:$G(DDSERROR) D
207 . S MLP=$P(Z,U,K+4)
208 . I MLP>0 D
209 .. N WORK S WORK=$$ELAPSE^PRSPESR2(MLP,$P(Z,U,K),$P(Z,U,K+1))
210 .. I $E(WORK,1,1)="-"!(WORK="00:00")!(WORK=0) D E17 S DDSERROR=1
211 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
212 ;
213 ; check for comptime earned and used w/out remarks
214 F K=1:5:31 Q:$G(DDSERROR) D
215 . I ($P(Z,U,K+2)="CT")&($P(Z,U,K+3)="") D E11 S DDSERROR=1
216 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
217 ;
218 F K=1:5:31 Q:$G(DDSERROR) D
219 . I ($P(Z,U,K+2)="CU")&($P(Z,U,K+3)="") D E12 S DDSERROR=1
220 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
221 ;
222 ;make sure compressed tours don't post credit hrs remarks.
223 I $$COMPR^PRSATP1(PPI,DFN) D
224 . F K=1:5:31 Q:$G(DDSERROR) D
225 .. I $$CTCH^PRSATP1(Z,K) D E13 S DDSERROR=1
226 I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
227 Q
228E1 S STR="A start time is not less than a stop time." Q
229E2 S STR="End of one segment must not be greater than start of next." Q
230E3 S STR="Duplicate start times encountered." Q
231E4 S STR="Segment of second day encountered; no two-day tour specified." Q
232E5 S STR="Segment of third day encountered." Q
233E6 S STR="Remarks must be entered when AA is posted." Q
234E7 S STR="HW can only be posted with HX or on a Holiday." Q
235E8 S STR="Start or Stop Time not entered for a segment." Q
236E9 S STR="Type of Time not entered for a segment." Q
237E10 S STR="Remarks must be entered for WP due to AWOL." Q
238E11 S STR="REMARKS CODE must be entered when CT is posted." Q
239E12 S STR="REMARKS CODE must be entered when CU is posted." Q
240E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." Q
241E14 S STR="Leave cannot be posted outside tour." Q
242E15 S STR="Meal time cannot exceed "_MLALLOW_" minutes." Q
243E16 S STR="Warning: A segment crosses midnight and a subsequent segment appears to be earlier in the day. This is o.k. as long as all start times begin on the selected ESR day."
244E17 S STR="Meal time must be less than time on the segment it is posted with." Q
245 Q
Note: See TracBrowser for help on using the repository browser.