Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSATP1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATP1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATP1.m
r613 r623 1 PRSATP1 ; HISC/REL,WOIFO/PLT - Daily Post verification ;11/28/2006 2 ;;4.0;PAID;**34,57,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;routine is called to validate data entered during the 5 ;screenman posting of an employees pay period 6 ; 7 K T S ZS="",TWO=$P($G(^PRST(457.1,+TC,0)),"^",5),DY2=TWO="Y" I TC2,'DY2 S TWO=$P($G(^PRST(457.1,+TC2,0)),"^",5),DY2=TWO="Y" 8 F K=1:4:25 I $P(Z,"^",K)'="" D 9 .S X=$P(Z,"^",K)_"^"_$P(Z,"^",K+1) I $P(Z,"^",K+1)="" D E8 Q 10 .D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0 11 .I Z2>1440,TWO'="Y","OT CT SB ON UA"'[$P(Z,"^",K+2) D E4 Q 12 .I Z2>2880 D E5 Q 13 .I $P(Z,"^",K+2)="" D E9 Q 14 .;check duplicate start time if no rs-type of time in exception string z for node 2 15 .I Z'["^RS",'(Z["HX"&("ON HW"[$P(Z,"^",K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) D E3 Q 16 .I $P(Z,"^",K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D E7 Q 17 .I $P(Z,"^",K+2)'="" S T(Z1)=$G(T(Z1))_$P(Z,U,K+2)_U,T(Z1,K)=Z2_"^"_$P(Z,"^",K,K+3) 18 .Q 19 I '$D(T) Q 20 ;check duplicate start time if rs in exception string z for node 2. 21 S Z1="" I Z["^RS",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) F S Z1=$O(T(Z1)) QUIT:Z1="" QUIT:Z["HX"&("^ON^HW^"[T(Z1)) I $L(T(Z1),U)>2 D QUIT:Z1="*" 22 . N A 23 . S A=T(Z1),A=U_A 24 . I $L(A,U)>4 S Z1="*" QUIT 25 . I A'["^RS^" S A=$P(A,"^ON")_$P(A,"^ON",2) S:A="" A="^ON" I "^CT^"'[A,"^OT^"'[A,Z'["^HX"!("^HW^"'[A) S Z1="*" QUIT 26 . I A["^RS^" S A=$P(A,"^RS")_$P(A,"^RS",2) S:A="" A="^RS" I "^CT^OT^RG^ON^HW^"'[A S Z1="*" QUIT 27 . QUIT 28 G:Z1="*" E3 29 ;exclude rs with ct, ot, rg, on, hw for error e2 check 30 I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) S Z1="" F S Z1=$O(T(Z1)) Q:Z1="" G:Z1'<T(Z1,$O(T(Z1,0))) E1 S Y=$O(T(Z1)) I Y,T(Z1,$O(T(Z1,0)))>Y G E2:'(T(Z1)["RS^"&("^CT^OT^RG^ON^HW^"[T(Y)))&'("^CT^OT^RG^ON^HW^"[T(Z1)&(T(Y)["RS^")) 31 S Z1="",LL=1 F S Z1=$O(T(Z1)) Q:Z1="" F K=0:0 S K=$O(T(Z1,K)) Q:K<1 D 32 .S $P(ZS,"^",LL)=$P(T(Z1,K),"^",2),$P(ZS,"^",LL+1)=$P(T(Z1,K),"^",3),$P(ZS,"^",LL+2)=$P(T(Z1,K),"^",4) S:$P(T(Z1,K),"^",5)'="" $P(ZS,"^",LL+3)=$P(T(Z1,K),"^",5) 33 .S LL=LL+4 Q 34 S Z1=$$GET^DDSVAL(DIE,.DA,70) 35 I Z1="" F K=1:4:25 G:$P(Z,"^",K+2)="AA" E6 I $P(Z,"^",K+2)="WP",$P(Z,"^",K+3)=3 G E10 36 ;loop thru posting checking for comptime w/out remarks code. 37 F K=1:4:25 G:($P(Z,"^",K+2)="CT")&($P(Z,"^",K+3)="") E11 38 F K=1:4:25 G:($P(Z,"^",K+2)="CU")&($P(Z,"^",K+3)="") E12 39 ;Now loop again checking to make sure compressed tours aren't 40 ;trying to post credit hours remarks. 41 I $$COMPR(PPI,DFN) F K=1:4:25 G:$$CTCH(Z,K) E13 42 Q 43 ;------------------------------------------------- 44 COMPR(P,D) ;return true if employee has a compressed tour indicator 45 ; this pay period 46 ; INPUT: P--pay period ien; D--Day number 47 ; 48 Q $P($G(^PRST(458,+P,"E",D,0)),"^",6)="C" 49 ;------------------------------------------------- 50 CTCH(Z,K) ;return true if comp/credit earned (CT) posted and 51 ; the remarks code is credit hours. 52 ; INPUT: Z--Posting node from file 458 53 ; K--segment of posting node 54 Q $P(Z,"^",K+2)="CT"&($P(Z,"^",K+3)="16") 55 ;------------------------------------------------- 56 ; 57 V0 I Z2>Z1 S:DY2=1&($O(T(0))>Z1) DY2=2 I DY2=2 S Z1=Z1+1440,Z2=Z2+1440 58 S:Z2'>Z1 Z2=Z2+1440,DY2=2 Q 59 E1 S STR="A start time is not less than a stop time." G E20 60 E2 S STR="End of one segment must not be greater than start of next." G E20 61 E3 S STR="Duplicate start times encountered." G E20 62 E4 S STR="Segment of second day encountered; no two-day tour specified." G E20 63 E5 S STR="Segment of third day encountered." G E20 64 E6 S STR="Remarks must be entered when AA is posted." G E20 65 E7 S STR="HW can only be posted with HX or on a Holiday." G E20 66 E8 S STR="Stop Time not entered for a segment." G E20 67 E9 S STR="Type of Time not entered for a segment." G E20 68 E10 S STR="Remarks must be entered for WP due to AWOL." G E20 69 E11 S STR="REMARKS CODE must be entered when CT is posted." G E20 70 E12 S STR="REMARKS CODE must be entered when CU is posted." G E20 71 E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." G E20 72 E20 K ZS,T S DDSERROR=1,TIM=0 D HLP^DDSUTL(.STR) Q 1 PRSATP1 ; HISC/REL-Daily Post verification ;2/28/2000 2 ;;4.0;PAID;**34,57**;Sep 21, 1995 3 ;routine is called to validate data entered during the 4 ;screenman posting of an employees pay period 5 ; 6 K T S ZS="",TWO=$P($G(^PRST(457.1,+TC,0)),"^",5),DY2=TWO="Y" I TC2,'DY2 S TWO=$P($G(^PRST(457.1,+TC2,0)),"^",5),DY2=TWO="Y" 7 F K=1:4:25 I $P(Z,"^",K)'="" D 8 .S X=$P(Z,"^",K)_"^"_$P(Z,"^",K+1) I $P(Z,"^",K+1)="" D E8 Q 9 .D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0 10 .I Z2>1440,TWO'="Y","OT CT SB ON UA"'[$P(Z,"^",K+2) D E4 Q 11 .I Z2>2880 D E5 Q 12 .I $P(Z,"^",K+2)="" D E9 Q 13 .I '(Z["HX"&("ON HW"[$P(Z,"^",K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) D E3 Q 14 .I $P(Z,"^",K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D E7 Q 15 .I $P(Z,"^",K+2)'="" S T(Z1,K)=Z2_"^"_$P(Z,"^",K,K+3) 16 .Q 17 I '$D(T) Q 18 I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) S Z1="" F S Z1=$O(T(Z1)) Q:Z1="" G:Z1'<T(Z1,$O(T(Z1,0))) E1 S Y=$O(T(Z1)) I Y,T(Z1,$O(T(Z1,0)))>Y G E2 19 S Z1="",LL=1 F S Z1=$O(T(Z1)) Q:Z1="" F K=0:0 S K=$O(T(Z1,K)) Q:K<1 D 20 .S $P(ZS,"^",LL)=$P(T(Z1,K),"^",2),$P(ZS,"^",LL+1)=$P(T(Z1,K),"^",3),$P(ZS,"^",LL+2)=$P(T(Z1,K),"^",4) S:$P(T(Z1,K),"^",5)'="" $P(ZS,"^",LL+3)=$P(T(Z1,K),"^",5) 21 .S LL=LL+4 Q 22 S Z1=$$GET^DDSVAL(DIE,.DA,70) 23 I Z1="" F K=1:4:25 G:$P(Z,"^",K+2)="AA" E6 I $P(Z,"^",K+2)="WP",$P(Z,"^",K+3)=3 G E10 24 ;loop thru posting checking for comptime w/out remarks code. 25 F K=1:4:25 G:($P(Z,"^",K+2)="CT")&($P(Z,"^",K+3)="") E11 26 F K=1:4:25 G:($P(Z,"^",K+2)="CU")&($P(Z,"^",K+3)="") E12 27 ;Now loop again checking to make sure compressed tours aren't 28 ;trying to post credit hours remarks. 29 I $$COMPR(PPI,DFN) F K=1:4:25 G:$$CTCH(Z,K) E13 30 Q 31 ;------------------------------------------------- 32 COMPR(P,D) ;return true if employee has a compressed tour indicator 33 ; this pay period 34 ; INPUT: P--pay period ien; D--Day number 35 ; 36 Q $P($G(^PRST(458,+P,"E",D,0)),"^",6)="C" 37 ;------------------------------------------------- 38 CTCH(Z,K) ;return true if comp/credit earned (CT) posted and 39 ; the remarks code is credit hours. 40 ; INPUT: Z--Posting node from file 458 41 ; K--segment of posting node 42 Q $P(Z,"^",K+2)="CT"&($P(Z,"^",K+3)="16") 43 ;------------------------------------------------- 44 ; 45 V0 I Z2>Z1 S:DY2=1&($O(T(0))>Z1) DY2=2 I DY2=2 S Z1=Z1+1440,Z2=Z2+1440 46 S:Z2'>Z1 Z2=Z2+1440,DY2=2 Q 47 E1 S STR="A start time is not less than a stop time." G E20 48 E2 S STR="End of one segment must not be greater than start of next." G E20 49 E3 S STR="Duplicate start times encountered." G E20 50 E4 S STR="Segment of second day encountered; no two-day tour specified." G E20 51 E5 S STR="Segment of third day encountered." G E20 52 E6 S STR="Remarks must be entered when AA is posted." G E20 53 E7 S STR="HW can only be posted with HX or on a Holiday." G E20 54 E8 S STR="Stop Time not entered for a segment." G E20 55 E9 S STR="Type of Time not entered for a segment." G E20 56 E10 S STR="Remarks must be entered for WP due to AWOL." G E20 57 E11 S STR="REMARKS CODE must be entered when CT is posted." G E20 58 E12 S STR="REMARKS CODE must be entered when CU is posted." G E20 59 E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." G E20 60 E20 K ZS,T S DDSERROR=1,TIM=0 D HLP^DDSUTL(.STR) Q
Note:
See TracChangeset
for help on using the changeset viewer.
