- PRSATP1 ; HISC/REL,WOIFO/PLT - Daily Post verification ;11/28/2006
- ;;4.0;PAID;**34,57,112**;Sep 21, 1995;Build 54
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;routine is called to validate data entered during the
- ;screenman posting of an employees pay period
- ;
- 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"
- F K=1:4:25 I $P(Z,"^",K)'="" D
- .S X=$P(Z,"^",K)_"^"_$P(Z,"^",K+1) I $P(Z,"^",K+1)="" D E8 Q
- .D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
- .I Z2>1440,TWO'="Y","OT CT SB ON UA"'[$P(Z,"^",K+2) D E4 Q
- .I Z2>2880 D E5 Q
- .I $P(Z,"^",K+2)="" D E9 Q
- .;check duplicate start time if no rs-type of time in exception string z for node 2
- .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
- .I $P(Z,"^",K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D E7 Q
- .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)
- .Q
- I '$D(T) Q
- ;check duplicate start time if rs in exception string z for node 2.
- 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="*"
- . N A
- . S A=T(Z1),A=U_A
- . I $L(A,U)>4 S Z1="*" QUIT
- . 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
- . 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
- . QUIT
- G:Z1="*" E3
- ;exclude rs with ct, ot, rg, on, hw for error e2 check
- 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^"))
- 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
- .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)
- .S LL=LL+4 Q
- S Z1=$$GET^DDSVAL(DIE,.DA,70)
- 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
- ;loop thru posting checking for comptime w/out remarks code.
- F K=1:4:25 G:($P(Z,"^",K+2)="CT")&($P(Z,"^",K+3)="") E11
- F K=1:4:25 G:($P(Z,"^",K+2)="CU")&($P(Z,"^",K+3)="") E12
- ;Now loop again checking to make sure compressed tours aren't
- ;trying to post credit hours remarks.
- I $$COMPR(PPI,DFN) F K=1:4:25 G:$$CTCH(Z,K) E13
- Q
- ;-------------------------------------------------
- COMPR(P,D) ;return true if employee has a compressed tour indicator
- ; this pay period
- ; INPUT: P--pay period ien; D--Day number
- ;
- Q $P($G(^PRST(458,+P,"E",D,0)),"^",6)="C"
- ;-------------------------------------------------
- CTCH(Z,K) ;return true if comp/credit earned (CT) posted and
- ; the remarks code is credit hours.
- ; INPUT: Z--Posting node from file 458
- ; K--segment of posting node
- Q $P(Z,"^",K+2)="CT"&($P(Z,"^",K+3)="16")
- ;-------------------------------------------------
- ;
- V0 I Z2>Z1 S:DY2=1&($O(T(0))>Z1) DY2=2 I DY2=2 S Z1=Z1+1440,Z2=Z2+1440
- S:Z2'>Z1 Z2=Z2+1440,DY2=2 Q
- E1 S STR="A start time is not less than a stop time." G E20
- E2 S STR="End of one segment must not be greater than start of next." G E20
- E3 S STR="Duplicate start times encountered." G E20
- E4 S STR="Segment of second day encountered; no two-day tour specified." G E20
- E5 S STR="Segment of third day encountered." G E20
- E6 S STR="Remarks must be entered when AA is posted." G E20
- E7 S STR="HW can only be posted with HX or on a Holiday." G E20
- E8 S STR="Stop Time not entered for a segment." G E20
- E9 S STR="Type of Time not entered for a segment." G E20
- E10 S STR="Remarks must be entered for WP due to AWOL." G E20
- E11 S STR="REMARKS CODE must be entered when CT is posted." G E20
- E12 S STR="REMARKS CODE must be entered when CU is posted." G E20
- E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." G E20
- E20 K ZS,T S DDSERROR=1,TIM=0 D HLP^DDSUTL(.STR) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATP1 4185 printed Feb 18, 2025@23:51:10 Page 2
- PRSATP1 ; HISC/REL,WOIFO/PLT - Daily Post verification ;11/28/2006
- +1 ;;4.0;PAID;**34,57,112**;Sep 21, 1995;Build 54
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;routine is called to validate data entered during the
- +4 ;screenman posting of an employees pay period
- +5 ;
- +6 KILL T
- SET ZS=""
- SET TWO=$PIECE($GET(^PRST(457.1,+TC,0)),"^",5)
- SET DY2=TWO="Y"
- IF TC2
- IF 'DY2
- SET TWO=$PIECE($GET(^PRST(457.1,+TC2,0)),"^",5)
- SET DY2=TWO="Y"
- +7 FOR K=1:4:25
- IF $PIECE(Z,"^",K)'=""
- Begin DoDot:1
- +8 SET X=$PIECE(Z,"^",K)_"^"_$PIECE(Z,"^",K+1)
- IF $PIECE(Z,"^",K+1)=""
- DO E8
- QUIT
- +9 DO CNV^PRSATIM
- SET Z1=$PIECE(Y,"^",1)
- SET Z2=$PIECE(Y,"^",2)
- DO V0
- +10 IF Z2>1440
- IF TWO'="Y"
- IF "OT CT SB ON UA"'[$PIECE(Z,"^",K+2)
- DO E4
- QUIT
- +11 IF Z2>2880
- DO E5
- QUIT
- +12 IF $PIECE(Z,"^",K+2)=""
- DO E9
- QUIT
- +13 ;check duplicate start time if no rs-type of time in exception string z for node 2
- +14 IF Z'["^RS"
- IF '(Z["HX"&("ON HW"[$PIECE(Z,"^",K+2)))
- IF '(Z["^ON"&(Z["OT"))
- IF '(Z["^ON"&(Z["CT"))
- IF $DATA(T(Z1))
- DO E3
- QUIT
- +15 IF $PIECE(Z,"^",K+2)="HW"
- IF Z'["HX"
- IF '$PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)
- DO E7
- QUIT
- +16 IF $PIECE(Z,"^",K+2)'=""
- SET T(Z1)=$GET(T(Z1))_$PIECE(Z,U,K+2)_U
- SET T(Z1,K)=Z2_"^"_$PIECE(Z,"^",K,K+3)
- +17 QUIT
- End DoDot:1
- +18 IF '$DATA(T)
- QUIT
- +19 ;check duplicate start time if rs in exception string z for node 2.
- +20 SET Z1=""
- IF Z["^RS"
- IF '(Z["^ON"&(Z["OT"))
- IF '(Z["^ON"&(Z["CT"))
- FOR
- SET Z1=$ORDER(T(Z1))
- if Z1=""
- QUIT
- if Z["HX"&("^ON^HW^"[T(Z1))
- QUIT
- IF $LENGTH(T(Z1),U)>2
- Begin DoDot:1
- +21 NEW A
- +22 SET A=T(Z1)
- SET A=U_A
- +23 IF $LENGTH(A,U)>4
- SET Z1="*"
- QUIT
- +24 IF A'["^RS^"
- SET A=$PIECE(A,"^ON")_$PIECE(A,"^ON",2)
- if A=""
- SET A="^ON"
- IF "^CT^"'[A
- IF "^OT^"'[A
- IF Z'["^HX"!("^HW^"'[A)
- SET Z1="*"
- QUIT
- +25 IF A["^RS^"
- SET A=$PIECE(A,"^RS")_$PIECE(A,"^RS",2)
- if A=""
- SET A="^RS"
- IF "^CT^OT^RG^ON^HW^"'[A
- SET Z1="*"
- QUIT
- +26 QUIT
- End DoDot:1
- if Z1="*"
- QUIT
- +27 if Z1="*"
- GOTO E3
- +28 ;exclude rs with ct, ot, rg, on, hw for error e2 check
- +29 IF Z'["HX"
- IF '(Z["^ON"&(Z["OT"))
- IF '(Z["^ON"&(Z["CT"))
- SET Z1=""
- FOR
- SET Z1=$ORDER(T(Z1))
- if Z1=""
- QUIT
- if Z1'<T(Z1,$ORDER(T(Z1,0)))
- GOTO E1
- SET Y=$ORDER(T(Z1))
- IF Y
- IF T(Z1,$ORDER(T(Z1,0)))>Y
- if '(T(Z1)["RS^"&("^CT^OT^RG^ON^HW^"[T(Y)))&'("^CT^OT^RG^ON^HW^"[T(Z1)&(T(Y)["RS^"))
- GOTO E2
- +30 SET Z1=""
- SET LL=1
- FOR
- SET Z1=$ORDER(T(Z1))
- if Z1=""
- QUIT
- FOR K=0:0
- SET K=$ORDER(T(Z1,K))
- if K<1
- QUIT
- Begin DoDot:1
- +31 SET $PIECE(ZS,"^",LL)=$PIECE(T(Z1,K),"^",2)
- SET $PIECE(ZS,"^",LL+1)=$PIECE(T(Z1,K),"^",3)
- SET $PIECE(ZS,"^",LL+2)=$PIECE(T(Z1,K),"^",4)
- if $PIECE(T(Z1,K),"^",5)'=""
- SET $PIECE(ZS,"^",LL+3)=$PIECE(T(Z1,K),"^",5)
- +32 SET LL=LL+4
- QUIT
- End DoDot:1
- +33 SET Z1=$$GET^DDSVAL(DIE,.DA,70)
- +34 IF Z1=""
- FOR K=1:4:25
- if $PIECE(Z,"^",K+2)="AA"
- GOTO E6
- IF $PIECE(Z,"^",K+2)="WP"
- IF $PIECE(Z,"^",K+3)=3
- GOTO E10
- +35 ;loop thru posting checking for comptime w/out remarks code.
- +36 FOR K=1:4:25
- if ($PIECE(Z,"^",K+2)="CT")&($PIECE(Z,"^",K+3)="")
- GOTO E11
- +37 FOR K=1:4:25
- if ($PIECE(Z,"^",K+2)="CU")&($PIECE(Z,"^",K+3)="")
- GOTO E12
- +38 ;Now loop again checking to make sure compressed tours aren't
- +39 ;trying to post credit hours remarks.
- +40 IF $$COMPR(PPI,DFN)
- FOR K=1:4:25
- if $$CTCH(Z,K)
- GOTO E13
- +41 QUIT
- +42 ;-------------------------------------------------
- COMPR(P,D) ;return true if employee has a compressed tour indicator
- +1 ; this pay period
- +2 ; INPUT: P--pay period ien; D--Day number
- +3 ;
- +4 QUIT $PIECE($GET(^PRST(458,+P,"E",D,0)),"^",6)="C"
- +5 ;-------------------------------------------------
- CTCH(Z,K) ;return true if comp/credit earned (CT) posted and
- +1 ; the remarks code is credit hours.
- +2 ; INPUT: Z--Posting node from file 458
- +3 ; K--segment of posting node
- +4 QUIT $PIECE(Z,"^",K+2)="CT"&($PIECE(Z,"^",K+3)="16")
- +5 ;-------------------------------------------------
- +6 ;
- V0 IF Z2>Z1
- if DY2=1&($ORDER(T(0))>Z1)
- SET DY2=2
- IF DY2=2
- SET Z1=Z1+1440
- SET Z2=Z2+1440
- +1 if Z2'>Z1
- SET Z2=Z2+1440
- SET DY2=2
- QUIT
- E1 SET STR="A start time is not less than a stop time."
- GOTO E20
- E2 SET STR="End of one segment must not be greater than start of next."
- GOTO E20
- E3 SET STR="Duplicate start times encountered."
- GOTO E20
- E4 SET STR="Segment of second day encountered; no two-day tour specified."
- GOTO E20
- E5 SET STR="Segment of third day encountered."
- GOTO E20
- E6 SET STR="Remarks must be entered when AA is posted."
- GOTO E20
- E7 SET STR="HW can only be posted with HX or on a Holiday."
- GOTO E20
- E8 SET STR="Stop Time not entered for a segment."
- GOTO E20
- E9 SET STR="Type of Time not entered for a segment."
- GOTO E20
- E10 SET STR="Remarks must be entered for WP due to AWOL."
- GOTO E20
- E11 SET STR="REMARKS CODE must be entered when CT is posted."
- GOTO E20
- E12 SET STR="REMARKS CODE must be entered when CU is posted."
- GOTO E20
- E13 SET STR="REMARKS CODE: Compressed tours can't earn credit hours."
- GOTO E20
- E20 KILL ZS,T
- SET DDSERROR=1
- SET TIM=0
- DO HLP^DDSUTL(.STR)
- QUIT
