PRSASC2.m

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 ---PRSASC2   817     printed  Apr 09, 2024@21:28:03                                                                                                                                                                                                      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