source: FOIAVistA/trunk/r/PAID-PRS/PRSPSAP3.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1PRSPSAP3 ;WOIFO/JAH - Supervisor Approve-update pt phys timecard ;01/05/05
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5MARK(ACT,PRSIEN,PPI) ; mark supervisors action on temp global
6 ; ESR STATUS
7 ; when updating a single record we overwrite. When updating
8 ; multiple records we will only update ones with no status.
9 N ITEM,OLDACT,REM,OLDREM
10 S ITEM=$P($G(ACT),U,2)
11 S ACT=$P($G(ACT),U)
12 I ITEM>0 D
13 . S PRSD=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,"B",ITEM))
14 . S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
15 .; add remarks to the resubmit action, otherwise remove old remarks
16 . I ACT="R" D
17 .. S OLDREM=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2))
18 .. S REM=$$GETREM(OLDREM)
19 .. I REM'="^" S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$G(REM)
20 . E D
21 .. K ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)
22 E D
23 . I ACT="R" S REM=$$GETREM()
24 . S PRSD=0
25 . F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0 D
26 .. S OLDACT=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1))
27 .. I OLDACT="" D
28 ... S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
29 ... I $G(ACT)="R" S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$G(REM)
30 Q
31GETREM(SNIDE) ; return supervisor remark for a resubmit request
32 ; WE CAN'T EDIT THE FIELD DIRECTLY BECAUSE THIS IS A TRANSACTION
33 ; AND NOTHING IS COMMITED TO THE DB UNTIL THEY SIGN
34 N DIR,DIRUT,REM,DTOUT,DUOUT,X,Y
35 S REM=""
36 S DIR(0)="458.02,148^O"
37 I $G(SNIDE)'="" S DIR("B")=SNIDE
38 S DIR("A")="Enter Remarks"
39 D ^DIR
40 S REM=$G(Y)
41 I $D(DTOUT)!$D(DUOUT) S REM="^"
42 Q REM
43 ;
44CANTPOST(ER,TCS,PPI,PRSIEN,PRSD,ESRN) ; GIVE SUPERVISOR CAN'T POST INFORMATION
45 ;
46 N I,LNCNT
47 D HDR(PRSIEN,PPI,PRSD)
48 W !!,"Time Discrepancies must be resolved. Timecard Status: "
49 W $S(TCS="P":"RELEASED TO PAYROLL",1:"TRANSMITTED TO AUSTIN")
50 W !,"Payroll must "
51 W $S(TCS="P":"return ",1:"initiate corrected ")
52 W "timecard or physician must resubmit ESR."
53 ;
54 W !!!,$$ASK^PRSLIB00(1)
55 D HDR(PRSIEN,PPI,PRSD)
56 ;
57 ;
58 W !!,?15,"TIME DISCREPANCIES BETWEEN TIMECARD AND ESR"
59 ;W !,?15,"-------------------------------------------"
60 W !,?6,"Error",?21,"Type of Time",?39,"Timecard Hrs",?57,"ESR Hrs"
61 W !,?2,"--------------------------------------------------------------"
62 S I=0 F S I=$O(ER(I)) Q:I'>0 D
63 . W !,?2,$P(ER(I),U,2),?26,$P(ER(I),U),?44,$P(ER(I),U,3),?60,$P(ER(I),U,4)
64 ;
65 W !!,?32,"ESR POSTING"
66 ;W !,?32,"-----------"
67 N ESR,DAYLNS,DTE,PDT,DAY
68 S PDT=$G(^PRST(458,PPI,2))
69 S DTE=$P(PDT,U,PRSD)
70 D GETESR^PRSPSAP1(.ESR,PPI,PRSIEN,PRSD)
71 D COLHDRS^PRSPSAP1
72 W ! F I=1:1:(IOM-1) W "-"
73 W ! D DAY^PRSPSAPU(.DAYLNS,PRSD_"^"_DTE,.ESR,PRSIEN,PPI)
74 W !!,?30,"TIMECARD POSTING"
75 ;W !,?30,"----------------"
76 W !,?7,"Date",?21,"Scheduled Tour",?46,"Tour Exceptions"
77 W !,?2,"------------------------------------------------------------"
78 N DFN S DAY=PRSD,DFN=PRSIEN D F0^PRSADP1
79 W !
80 Q
81 ;
82HDR(PRSIEN,PPI,PRSD) ;
83 W @IOF,!!,"ESR approval REJECTED for "
84 W $P($G(^PRSPC(PRSIEN,0)),"^")," on day ",PRSD," in PP "
85 W $P($G(^PRST(458,PPI,0)),U),"."
86 Q
87 ;
88 ;===================================================================
89 ;
90CMPESRTC(ERCNT,ERMSG,ESRN,TCN,PPI,PRSIEN,PRSD) ;compare the ESR to the timecard
91 ;
92 ; OUTPUT VARIABLE
93 ;
94 ; ERMSG: Array of mismatches in a 4 piece ^ message format
95 ; type of time ^ message ^ timecard total ^ ESR total
96 ;
97 ; LOCAL VARS
98 ; TT : Type of time code from type of time file (2 exceptions for
99 ; WP on timecard with remark 3, awol is "WPAWOL" OR
100 ; remarks 4, on suspension is "WPSUSP")
101 ; ERFND : flag that some mismatch was found
102 ; ESRT
103 ; TCT : total time
104 ;
105 N TT,ERFND,ESRT,TCT,PRSTA
106 ;
107 S (ERFND,ERMSG,ERCNT)=0
108 I ($G(PPI)'>0)!($G(PRSIEN)'>0)!($G(PRSD)'>0) D Q
109 . S ERMSG=U_"FATAL ERROR: Missing internal lookup parameters."_U_U
110 I $G(ESRN)="" S ESRN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
111 I $G(TCN)="" S TCN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
112 D ESRTCAR(.PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD)
113 ;
114 ;
115 ; Check for any leave posting mismatch (IGNORE WPAWOL, WPSUSP, RG)
116 S TT=""
117 F S TT=$O(PRSTA(TT)) Q:TT="" D
118 . Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
119 . S TCT=+$P(PRSTA(TT),U),ESRT=+$P(PRSTA(TT),U,2)
120 . I TCT'=ESRT D
121 .. S ERCNT=ERCNT+1
122 .. S ERMSG(ERCNT)=TT_U_"LEAVE mismatch"_U_TCT_U_ESRT,ERFND=1
123 ;
124 ; Check for problems with NON PAY. If non pay is on the timecard
125 ; then only NO WORK is accepatable on the ESR.
126 ;
127 I $P($G(PRSTA("NP")),U)>0 D
128 . S TT=""
129 . F S TT=$O(PRSTA(TT)) Q:TT=""!(ERFND) D
130 .. S ESRT=+$P(PRSTA(TT),U,2)
131 .. I +ESRT>0 D
132 ... S ERCNT=ERCNT+1
133 ... S ERMSG(ERCNT)=TT_U_"NON PAY mismatch"_U_U_ESRT
134 Q
135 ;
136 ;===================================================================
137 ;
138ESRTCAR(PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD) ;
139 ; return an array subscripted by types of time (TT) for each TT
140 ; found in either the ESR or timecard. Piece 1 of each TT subscript
141 ; represents the timcard and piece 2 represents the ESR.
142 ; Both pieces contain the total hours in decimal format of that TT.
143 ;
144 ;
145 ; loop through the timecard and the ESR totaling the various types of
146 ; time for each. Exceptions are as follows:
147 ; 1. when timecard has WP with remarks AWOL or On Suspension then
148 ; don't add to WP total, since this can never be recorded on
149 ; the ESR, instead store on special node ("WPAWOL") or ("WPSUSP")
150 ;
151 ; INPUT VARIABLES
152 ;
153 ; ESRN : electronic subsidiary record posting node
154 ; TCN : timecard posting node
155 ; PPI, PRSIEN, PRSD : package standard
156 ;
157 ;
158 ;LOCAL variables
159 ; TCPT : timecard posting type (worked or absent all day or except)
160 ; TOD : Tour of duty pointer
161 ; PRSML : Length of meal in minutes
162 ; PRSTA : Time Array subscripted by type of time code (piece one is
163 ; the timecard total time and piece 2 is esr total time
164 ; MTT : Type of time associated with the meal
165 ; ZNODE : zero node from timecard for tour pointers and lengths
166 ;
167 ;
168 N TCPT,TOD,PRSML,ZNODE,T1LEN,T2LEN,NETRG,TCEXAMT
169 N TSEG,TT,BEG,END,MEAL,HRS,SEGHRS,TRC
170 K PRSTA
171 ;
172 S ZNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
173 ;
174 ; get tour length in case we need to determine amount of time
175 ; for the tour when we don't have exceptions on the timecard or
176 ; we need the implied RG
177 ;
178 S T1LEN=$P(ZNODE,U,8)
179 S T2LEN=$P(ZNODE,U,14)
180 ;
181 ;
182 ;ESR
183 ;
184 ;
185 F I=1:5:31 D
186 . S TSEG=$P(ESRN,U,I,I+4)
187 . S TT=$P(TSEG,U,3)
188 .;
189 .;this line may need to be removed since we are simply looking
190 .; at all types of time at this stage (also would make this call
191 .; more useful as an API to get all types of time)
192 .;
193 . Q:"^RG^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
194 . S HRS=$P($G(PRSTA(TT)),U,2)
195 . S BEG=$P(TSEG,U)
196 . S END=$P(TSEG,U,2)
197 . S MEAL=$P(TSEG,U,5)
198 . S SEGHRS=$$AMT^PRSPSAPU(BEG,END,MEAL)
199 . S $P(PRSTA(TT),U,2)=SEGHRS+HRS
200 ;
201 ; if timecard isn't posted there's no point in going on
202 Q:(+$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,2)'>0)
203 ;
204 ;Timecard with exceptions (no full day work or leave)
205 ;
206 S TCPT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,4)
207 I '((TCPT=1)!(TCPT=2)) D
208 . F I=1:4:24 D
209 .. S TSEG=$P(TCN,U,I,I+3)
210 .. S TT=$P(TSEG,U,3)
211 .. S TRC=$P(TSEG,U,4)
212 ..; check for awol and store separate from other WP
213 .. I TT="WP" S TT=$S(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
214 .. Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
215 .. S HRS=$P($G(PRSTA(TT)),U)
216 .. S BEG=$P(TSEG,U)
217 .. S END=$P(TSEG,U,2)
218 .. S SEGHRS=$$AMT^PRSPSAPU(BEG,END,0)
219 .. S $P(PRSTA(TT),U)=SEGHRS+HRS
220 E D
221 .;
222 .; if timecard is posted w/exception or work for the full day
223 .; then use the tour 1 and 2 lengths to record hours
224 .;
225 . I TCPT=2 D
226 ..; full day exception posted: get type of time and remarks
227 .. S TT="" F I=1:4:24 Q:TT'="" S TT=$P(TCN,U,I+2),TRC=$P(TCN,U,I+3)
228 .. I TT="WP" S TT=$S(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
229 . ;
230 . ; full day work
231 . I TCPT=1 S TT="RG"
232 .;
233 . S $P(PRSTA(TT),U)=T1LEN+T2LEN
234 ;
235 ; RG should not be coded on the PTP's timecard but we will tabulate
236 ; the implied RG by reducing the tour length by any exceptions totals
237 ;
238 I $P($G(PRSTA("RG")),U)="" D
239 . S NETRG=T1LEN+T2LEN
240 . S TT=""
241 . F S TT=$O(PRSTA(TT)) Q:TT="" D
242 ..; only times that reduce RG are included
243 ..; (WP, WPAWOL, WPSUSP & NP) reduce RG
244 .. Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^TR^TV^"[(U_TT_U)
245 .. Q:TT="RG"
246 .. S TCEXAMT=$P(PRSTA(TT),U)
247 .. S NETRG=NETRG-TCEXAMT
248 . S $P(PRSTA("RG"),U)=NETRG
249 ;
250 Q
Note: See TracBrowser for help on using the repository browser.