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
