- PRSASC2 ; HISC/REL-Post Environmental Diff. ;1/20/95 12:43
- ;;4.0;PAID;;Sep 21, 1995
- S Z=^PRST(458.3,DA,0),TYP=$P(Z,"^",7),D1=$P(Z,"^",3)
- S Y=$G(^PRST(458,"AD",+D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
- S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I STAT'="","X"[STAT G PRP
- D POST Q
- POST S X=$P(Z,"^",4)_"^"_$P(Z,"^",6) D CNV^PRSATIM S TIM=$P(Y,"^",2)-$P(Y,"^",1)-$P(Z,"^",5)/60 Q:TIM'>0
- K AUR S (Z,AUR(1))=$G(^PRST(458,PPI,"E",DFN,4)),L1=$S(DAY<8:1,1:7)
- F L2=L1:2:L1+4 Q:$P(Z,"^",L2)="" I $P(Z,"^",L2)=TYP Q
- S:'$P(Z,"^",L2) $P(Z,"^",L2)=TYP S TIM=TIM+$P(Z,"^",L2+1),$P(Z,"^",L2+1)=TIM
- S ^PRST(458,PPI,"E",DFN,4)=Z I STAT="P" K ^(5) D ONE^PRS8 S ^PRST(458,PPI,"E",DFN,5)=VAL
- Q
- PRP ; Prior Pay Period
- D POST I AUR(1)'=$G(^PRST(458,PPI,"E",DFN,4)) S AUT="H",AUS="S" D ^PRSAUD ; Notify Payroll
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSASC2 817 printed Apr 23, 2025@18:38:50 Page 2
- PRSASC2 ; HISC/REL-Post Environmental Diff. ;1/20/95 12:43
- +1 ;;4.0;PAID;;Sep 21, 1995
- +2 SET Z=^PRST(458.3,DA,0)
- SET TYP=$PIECE(Z,"^",7)
- SET D1=$PIECE(Z,"^",3)
- +3 SET Y=$GET(^PRST(458,"AD",+D1))
- SET PPI=$PIECE(Y,"^",1)
- SET DAY=$PIECE(Y,"^",2)
- +4 SET STAT=$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)
- IF STAT'=""
- IF "X"[STAT
- GOTO PRP
- +5 DO POST
- QUIT
- POST SET X=$PIECE(Z,"^",4)_"^"_$PIECE(Z,"^",6)
- DO CNV^PRSATIM
- SET TIM=$PIECE(Y,"^",2)-$PIECE(Y,"^",1)-$PIECE(Z,"^",5)/60
- if TIM'>0
- QUIT
- +1 KILL AUR
- SET (Z,AUR(1))=$GET(^PRST(458,PPI,"E",DFN,4))
- SET L1=$SELECT(DAY<8:1,1:7)
- +2 FOR L2=L1:2:L1+4
- if $PIECE(Z,"^",L2)=""
- QUIT
- IF $PIECE(Z,"^",L2)=TYP
- QUIT
- +3 if '$PIECE(Z,"^",L2)
- SET $PIECE(Z,"^",L2)=TYP
- SET TIM=TIM+$PIECE(Z,"^",L2+1)
- SET $PIECE(Z,"^",L2+1)=TIM
- +4 SET ^PRST(458,PPI,"E",DFN,4)=Z
- IF STAT="P"
- KILL ^(5)
- DO ONE^PRS8
- SET ^PRST(458,PPI,"E",DFN,5)=VAL
- +5 QUIT
- PRP ; Prior Pay Period
- +1 ; Notify Payroll
- DO POST
- IF AUR(1)'=$GET(^PRST(458,PPI,"E",DFN,4))
- SET AUT="H"
- SET AUS="S"
- DO ^PRSAUD
- +2 QUIT
