ACRFSS6.m

ACRFSS6 ;IHS/OIRM/DSD/THL,AEF - EDIT PAY ROLL PERIOD; [ 09/23/2005   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 ;;ROUTINE TO EDIT PAY ROLL PERIOD INFORMATION

EN S ACREMP=$P(^ACRDOC(ACRDOCDA,"PR"),U)

 S ACREMPPP=$S($P(^ACRAU(ACREMP,1),U,3)'="CO":26,1:12)

 N ACRY

 S ACRSSDA=$O(^ACRSS("C",ACRDOCDA,0))

 I 'ACRSSDA D

 .S ACRJ=1

 .W !!,"NO PAYROLL ENTRIES ON FILE FOR THIS EMPLOYEE"

 .D ADD

 .D ADD^ACRFSS61

 F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)

EXIT S ACRSSTOT=ACRYTD

 S ACRSS6=""

 K ACRPR,ACRPRDA,ACRDA,ACRY,ACRII,ACRI,ACRX,ACRQUIT,ACRYTD,ACREMP,ACREMPPP,ACRPRAMT,ACRPR

 Q

EN1 D DISPLAY

 I $D(ACRREV) D  Q

 .S ACRQUIT=""

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 S DIR(0)="SO^1:Edit Pay Period"_$S((ACRJ/2)<(ACREMPPP+1):";2:Add Pay Period",1:"")_";3:Delete Pay Period"

 S DIR("A")="Which Option ===> "

 D DIR^ACRFDIC

 I X=1 D  Q

 .D EDIT^ACRFSS61

 .K ACRQUIT

 I X=2,(ACRJ/2)<(ACREMPPP+1) D  Q

 .D ADD^ACRFSS61

 .K ACRQUIT

 I X=3 D

 .S ACRDEL=""

 .D EDIT^ACRFSS61

 .K ACRDEL,ACRQUIT

 Q

DISPLAY I $E(IOST,1,2)="C-" D

 .W @IOF

 .W !?10,@ACRON,"PAY ROLL SUMMARY",@ACROF," FOR ",@ACRON

 .;W $P(^VA(200,$P(^ACRDOC(ACRDOCDA,"PR"),U),0),U),@ACROF  ;ACR*2.1*19.02 IM16848

 .W $$NAME2^ACRFUTL1($P(^ACRDOC(ACRDOCDA,"PR"),U)),@ACROF  ;ACR*2.1*19.02 IM16848

 W !!,"PER"

 W ?16,"SALARY"

 W ?25,"| PER"

 W ?43,"SALARY"

 W ?52,"| PER"

 W ?70,"SALARY"

 W !,"IOD"

 W ?5,"AMOUNT"

 W ?14,"YR-TO-DATE"

 W ?25,"| IOD"

 W ?32,"AMOUNT"

 W ?41,"YR-TO-DATE"

 W ?52,"| IOD"

 W ?59,"AMOUNT"

 W ?68,"YR-TO-DATE"

 W !,"--- --------- ----------"

 W ?25,"| --- --------- ----------"

 W ?52,"| --- --------- ----------"

 S (ACRYTD,ACRPRDA)=0

 F ACRJ=1:1 S ACRPRDA=$O(^ACRSS("C",ACRDOCDA,ACRPRDA)) Q:'ACRPRDA  D DP1

 F ACRI=1:2:(ACRJ-2) I ACRI#2=1 S ACRII=$S(ACRI>1:(ACRI+1)/2,1:1) D W

 Q

W S ACRX=$S(ACRII#3=1:"!",ACRII#3=2:"?25,""| """,1:"?52,""| """)

 W @ACRX,ACRII

 S ACRXX=$P(ACRPR(ACRI),U,2)+$P(ACRPR(ACRI+1),U,2)

 S ACRX=$S(ACRII#3=1:"?4",ACRII#3=2:"?31",1:"?58")

 W @ACRX,$J($FN(ACRXX,"P",2),9)

 S ACRX=$S(ACRII#3=1:"?15",ACRII#3=2:"?41",1:"?68")

 W @ACRX,$J($FN($P(ACRPR(ACRI+1),U,3),"P",2),10)

 Q

DP1 S ACRPRAMT=$P(^ACRSS(ACRPRDA,"DT"),U,4)

 S ACRYTD=ACRYTD+ACRPRAMT

 S ACRPR(ACRJ)=ACRPRDA_"^"_ACRPRAMT_"^"_ACRYTD

 Q

EMP S DIR(0)="Y"

 S DIR("A")="Edit Employee Data"

 S DIR("B")="NO"

 D DIR^ACRFDIC

 Q:Y'=1

 N DR

 S DIE="^ACRSS("

 S DR="S DIE(""NO^"")=""NO"";.05T;.04T;K DIE(""NO^"");13AMT FOR PAY PERIOD..: "

 W !

 D DIE^ACRFDIC

 Q

ADD ;S ACRDOC=$E($P(^VA(200,ACREMP,0),U),1,8)_"-"_ACRFDNFY  ;ACR*2.1*19.02 IM16848

 S ACRDOC=$E($$NAME2^ACRFUTL1(ACREMP),1,8)_"-"_ACRFDNFY  ;ACR*2.1*19.02 IM16848

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR=".14////"_ACRDOC

 D DIE^ACRFDIC

 Q

ACRFSS6   ;IHS/OIRM/DSD/THL,AEF - EDIT PAY ROLL PERIOD; [ 09/23/2005   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 +2       ;;ROUTINE TO EDIT PAY ROLL PERIOD INFORMATION

EN         SET ACREMP=$PIECE(^ACRDOC(ACRDOCDA,"PR"),U)

 +1        SET ACREMPPP=$SELECT($PIECE(^ACRAU(ACREMP,1),U,3)'="CO":26,1:12)

 +2        NEW ACRY

 +3        SET ACRSSDA=$ORDER(^ACRSS("C",ACRDOCDA,0))

 +4        IF 'ACRSSDA

               Begin DoDot:1

 +5                SET ACRJ=1

 +6                WRITE !!,"NO PAYROLL ENTRIES ON FILE FOR THIS EMPLOYEE"

 +7                DO ADD

 +8                DO ADD^ACRFSS61

               End DoDot:1

 +9        FOR 

               DO EN1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

EXIT       SET ACRSSTOT=ACRYTD

 +1        SET ACRSS6=""

 +2        KILL ACRPR,ACRPRDA,ACRDA,ACRY,ACRII,ACRI,ACRX,ACRQUIT,ACRYTD,ACREMP,ACREMPPP,ACRPRAMT,ACRPR

 +3        QUIT 

EN1        DO DISPLAY

 +1        IF $DATA(ACRREV)

               Begin DoDot:1

 +2                SET ACRQUIT=""

 +3                DO PAUSE^ACRFWARN

 +4                SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +5        SET DIR(0)="SO^1:Edit Pay Period"_$SELECT((ACRJ/2)<(ACREMPPP+1):";2:Add Pay Period",1:"")_";3:Delete Pay Period"

 +6        SET DIR("A")="Which Option ===> "

 +7        DO DIR^ACRFDIC

 +8        IF X=1

               Begin DoDot:1

 +9                DO EDIT^ACRFSS61

 +10               KILL ACRQUIT

               End DoDot:1

               QUIT 

 +11       IF X=2

               IF (ACRJ/2)<(ACREMPPP+1)

                   Begin DoDot:1

 +12                   DO ADD^ACRFSS61

 +13                   KILL ACRQUIT

                   End DoDot:1

                   QUIT 

 +14       IF X=3

               Begin DoDot:1

 +15               SET ACRDEL=""

 +16               DO EDIT^ACRFSS61

 +17               KILL ACRDEL,ACRQUIT

               End DoDot:1

 +18       QUIT 

DISPLAY    IF $EXTRACT(IOST,1,2)="C-"

               Begin DoDot:1

 +1                WRITE @IOF

 +2                WRITE !?10,@ACRON,"PAY ROLL SUMMARY",@ACROF," FOR ",@ACRON

 +3       ;W $P(^VA(200,$P(^ACRDOC(ACRDOCDA,"PR"),U),0),U),@ACROF  ;ACR*2.1*19.02 IM16848

 +4       ;ACR*2.1*19.02 IM16848

                   WRITE $$NAME2^ACRFUTL1($PIECE(^ACRDOC(ACRDOCDA,"PR"),U)),@ACROF

               End DoDot:1

 +5        WRITE !!,"PER"

 +6        WRITE ?16,"SALARY"

 +7        WRITE ?25,"| PER"

 +8        WRITE ?43,"SALARY"

 +9        WRITE ?52,"| PER"

 +10       WRITE ?70,"SALARY"

 +11       WRITE !,"IOD"

 +12       WRITE ?5,"AMOUNT"

 +13       WRITE ?14,"YR-TO-DATE"

 +14       WRITE ?25,"| IOD"

 +15       WRITE ?32,"AMOUNT"

 +16       WRITE ?41,"YR-TO-DATE"

 +17       WRITE ?52,"| IOD"

 +18       WRITE ?59,"AMOUNT"

 +19       WRITE ?68,"YR-TO-DATE"

 +20       WRITE !,"--- --------- ----------"

 +21       WRITE ?25,"| --- --------- ----------"

 +22       WRITE ?52,"| --- --------- ----------"

 +23       SET (ACRYTD,ACRPRDA)=0

 +24       FOR ACRJ=1:1

               SET ACRPRDA=$ORDER(^ACRSS("C",ACRDOCDA,ACRPRDA))

               IF 'ACRPRDA

                   QUIT 

               DO DP1

 +25       FOR ACRI=1:2:(ACRJ-2)

               IF ACRI#2=1

                   SET ACRII=$SELECT(ACRI>1:(ACRI+1)/2,1:1)

                   DO W

 +26       QUIT 

W          SET ACRX=$SELECT(ACRII#3=1:"!",ACRII#3=2:"?25,""| """,1:"?52,""| """)

 +1        WRITE @ACRX,ACRII

 +2        SET ACRXX=$PIECE(ACRPR(ACRI),U,2)+$PIECE(ACRPR(ACRI+1),U,2)

 +3        SET ACRX=$SELECT(ACRII#3=1:"?4",ACRII#3=2:"?31",1:"?58")

 +4        WRITE @ACRX,$JUSTIFY($FNUMBER(ACRXX,"P",2),9)

 +5        SET ACRX=$SELECT(ACRII#3=1:"?15",ACRII#3=2:"?41",1:"?68")

 +6        WRITE @ACRX,$JUSTIFY($FNUMBER($PIECE(ACRPR(ACRI+1),U,3),"P",2),10)

 +7        QUIT 

DP1        SET ACRPRAMT=$PIECE(^ACRSS(ACRPRDA,"DT"),U,4)

 +1        SET ACRYTD=ACRYTD+ACRPRAMT

 +2        SET ACRPR(ACRJ)=ACRPRDA_"^"_ACRPRAMT_"^"_ACRYTD

 +3        QUIT 

EMP        SET DIR(0)="Y"

 +1        SET DIR("A")="Edit Employee Data"

 +2        SET DIR("B")="NO"

 +3        DO DIR^ACRFDIC

 +4        IF Y'=1

               QUIT 

 +5        NEW DR

 +6        SET DIE="^ACRSS("

 +7        SET DR="S DIE(""NO^"")=""NO"";.05T;.04T;K DIE(""NO^"");13AMT FOR PAY PERIOD..: "

 +8        WRITE !

 +9        DO DIE^ACRFDIC

 +10       QUIT 

ADD       ;S ACRDOC=$E($P(^VA(200,ACREMP,0),U),1,8)_"-"_ACRFDNFY  ;ACR*2.1*19.02 IM16848

 +1       ;ACR*2.1*19.02 IM16848

           SET ACRDOC=$EXTRACT($$NAME2^ACRFUTL1(ACREMP),1,8)_"-"_ACRFDNFY

 +2        SET DA=ACRDOCDA

 +3        SET DIE="^ACRDOC("

 +4        SET DR=".14////"_ACRDOC

 +5        DO DIE^ACRFDIC

 +6        QUIT