source: FOIAVistA/tag/r/PAID-PRS/PRSATPE.m@ 949

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

WorldVistAEHR overlayed on FOIAVistA

File size: 4.7 KB
Line 
1PRSATPE ;HISC/REL-Find Exceptions ;12/08/05
2 ;;4.0;PAID;**26,34,69,102**;Sep 21, 1995
3 K ER S (ECNT,FATAL)=0,X0=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),STAT=$P($G(^(10)),"^",1)
4 N MLTIME S MLTIME=0
5 S TC=$P(X0,"^",2) I 'TC S ER(1)=$P($T(ERTX+1),";;",2),FATAL=1 G EX
6 I "1 3 4"'[TC,STAT="" S ER(1)=$P($T(ERTX+2),";;",2),FATAL=1 G EX
7 S X2=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) G:X2="" EX S X1=$G(^(1)),X4=$G(^(4))
8 K TM I X2["OT"!(X2["CT") D TM
9 K T F K=1:3 Q:$P(X1,"^",K)="" S Z=$P(X1,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D
10 .S X=$P(X1,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
11 .I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
12 .S T(Z1)="",T(Z2)="*" Q
13 I X4'="" F K=1:3 Q:$P(X4,"^",K)="" S Z=$P(X4,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D
14 .S X=$P(X4,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
15 .I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
16 .S T(Z1)="",T(Z2)="*" Q
17 ;
18 ; Checks for Daily employees
19 I "^"[$P(X2,"^",1,2) S TT=$P(X2,"^",3),K=1,DN=0,Y0="" G L0
20 F K=1:4:25 S X=$P(X2,"^",K,K+1) I "^"'[X D
21 .S TT=$P(X2,"^",K+2)
22 .D CNV^PRSATIM S Y0=Y,Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1 S TIM=Z2-Z1/60
23 .I TT="ML" S MLTIME=MLTIME+TIM
24 .S Z1=$O(T(Z1)) S:Z1'="" Z1=T(Z1)
25 .S Z2=$O(T(Z2-1)) S:Z2'="" Z2=T(Z2)
26 .I TT="UN" D UN^PRSATPH Q
27 .I "CT OT ON SB RG"[TT D OT Q
28 .D LV Q
29 ;
30 ; Check for a minimum of 1 hour ML
31 ;
32 I TT="ML",MLTIME<1 S ER(1)=$P($T(ERTX+14),";;",2),FATAL=1 G EX
33 ;
34EX Q
35V0 I Z2>Z1 S:$O(T(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440 Q
36 S Z2=Z2+1440 Q
37V1 S DN=0 I Z2>Z1 Q:"CT OT ON SB UN RG"[TT S:$O(T(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440,DN=2 Q
38 S Z2=Z2+1440,DN=1 Q
39OT ; Check OT/CT Request
40 I Z1'=""!(Z2'="") D O2 I $G(ERR)=6 S FATAL=1 D ERR
41 I DN=1,$O(T(1440))="" D NX^PRSATPH
42 I 'DN,$O(T(""))=""!($P(Y0,"^",1)'>$O(T(""))) D PR^PRSATPH
43 I "ON SB RG"[TT Q
44 ; check status of request(s)
45 S DTI=$P($G(^PRST(458,PPI,1)),U,DAY) Q:'DTI
46 S STAT="" ; init highest status var
47 S DA=0 F S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) Q:'DA D Q:STAT="A"
48 . S Z=$G(^PRST(458.2,DA,0))
49 . Q:$P(Z,"^",5)'=TT ; ignore different type
50 . I $F("RSA",$P(Z,U,8))>$F("RSA",STAT) S STAT=$P(Z,U,8) ; higher status
51 I STAT="" S ERR=3 D ERR Q ; none with requested or higher status
52 I STAT'="A" D Q ; none approved
53 . S ERR=$S(STAT="R":8,1:9) D ERR
54 . ; check posted hours vs requested since no approved request
55 . S TM(TT,"R")=$G(TM(TT,"R"))-TIM I TM(TT,"R")<0 S ERR=7 D ERR
56 ; check posted hours vs approved since we have an approved request
57 S TM(TT,"A")=$G(TM(TT,"A"))-TIM I TM(TT,"A")<0 S ERR=13 D ERR
58 Q
59O2 ; Check for valid with-in tour or cross-tour situations
60 I TT="ON"&(X2["HX") Q
61 ;I "OT CT"[TT,TIM'>1 Q
62 S ERR=6 Q
63TM ; Get OT,CT request,approve times
64 S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY),DA=0 Q:'DTI
65T1 S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) I 'DA Q
66 S Z=$G(^PRST(458.2,DA,0)),STAT=$P(Z,"^",8) I STAT'="","XD"[STAT G T1
67 S TT=$P(Z,"^",5) I TT'="OT",TT'="CT" G T1
68 S TM(TT,"R")=$G(TM(TT,"R"))+$P(Z,"^",6) ; requested sum
69 I STAT="A" S TM(TT,"A")=$G(TM(TT,"A"))+$P(Z,"^",6) ; approved sum
70 G T1
71LV ; Check Leave Request
72 I TC=3!(TC=4) Q
73 I TC=1,TT="HW" Q
74 I Z1'="*"!(Z2'="*") S ERR=5,FATAL=1 D ERR
75 ;
76L0 N REMARK S REMARK=$P(X2,"^",K+3)
77 Q:REMARK&(REMARK'=15&(REMARK'=16))
78 I "HX"[TT D HENCAP
79 Q:"RG CP NP HX HW TR TV"[TT
80 S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY) Q:'DTI S (DT1,DT2)=DTI
81 I DN D D2 S:DN=2 DT1=DT2
82 S DTIN=9999999-DT2,DA=0
83 F KK=0:0 S KK=$O(^PRST(458.1,"AD",DFN,KK)) G:KK=""!(KK>DTIN) L3 F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,KK,DA)) Q:DA="" I ^(DA)'>DT1 D L1 G:LF L4
84 Q
85L1 S Z=$G(^PRST(458.1,DA,0)),LF=0 Q:$P(Z,"^",7)'=TT S STAT=$P(Z,"^",9) I "XD"[STAT Q
86 G:Y0="" L2 S Z1=$P(Y0,"^",1),Z2=$P(Y0,"^",2)
87 S X=$P(Z,"^",4)_"^"_$P(Z,"^",6) D CNV^PRSATIM
88 I $P(Z,"^",3)=DT1,$P(Y,"^",1)>Z1 Q
89 I $P(Z,"^",5)=DT2,$P(Y,"^",2)<Z2 Q
90L2 I STAT'="A" S ERR=4 D ERR
91 S LF=1 Q
92L3 S ERR=3 D ERR Q
93L4 Q
94D2 I DAY<14 S DT2=$P($G(^PRST(458,PPI,1)),"^",DAY+1) Q
95 N X1,X2 S X1=DT1,X2=1 D C^%DTC S DT2=X Q
96 ;
97HENCAP ; Check for Holiday encapsulated by non-pay
98 N DAH,DBH,HOL,QUIT
99 S (DAH,DBH,HOL,QUIT)=""
100 D HENCAP^PRSATP4(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
101 Q:QUIT
102 Q:HOL=""
103 S ERR=15 D ERR Q ; Holiday in current PP
104 Q
105 ;
106ERR ; Set Error
107 S ECNT=ECNT+1,ER(ECNT)=TT_$P($T(ERTX+ERR),";;",2)_"^"_$P(X2,"^",K) Q
108ERTX ;;
1091 ;;No Tour Entered^
1102 ;;No Time Posted^
1113 ;; not Requested
1124 ;; Requested but not Approved
1135 ;; Posted outside of Tour Hours
1146 ;; Posted within Tour Hours
1157 ;; Posted exceeds Requested Hours
1168 ;; Requested but pending Supervisor Approval
1179 ;; Supervisor Approved but pending Director Approval
11810 ;; Overlaps with the start of the next day's Tour
11911 ;; Overlaps with the prior day's Tour
12012 ;; can only be posted against OT, CT, ON, & SB in Tour
12113 ;; Posted exceeds Approved Hours
12214 ;; The minimum charge for Military Leave is one hour
12315 ;; was encapsulated by non-pay
Note: See TracBrowser for help on using the repository browser.