ACRFPR ;IHS/DSD/THL,AEF - PAYROLL DATA; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;
;UTILITY TO ENTER/EDIT PAYROLL DATA
;
EN D EXIT
D EN1
EXIT K ACRCDATE,ACRODATE,ACRCANDA,ACRCAN,ACRFY,ACRQUIT,ACROUT,ACRCN,ACRPPN,ACRBY,ACRGP,ACRNE,ACROH,ACROP,ACRSSN,ACRCN,ACRDATE,ACRAU,ACRDOC,ACRDOCDA,ACRI,ACRJ,ACRLBDA,ACRMAX,ACRSS2,ACRSSDT,ACRX,ACRXX,ACRY
K ^TMP("ACRPR",$J)
Q
EN1 ;EDIT PERSONNEL DATA
W @IOF
W !?10,"PAYROLL DATA ENTRY UTILITY"
S DIR(0)="FOA^6:6"
S DIR("A")="Payroll Control NO.: "
W !!
D DIR^ACRFDIC
I Y'?6N S ACRQUIT="" Q
S ACRCN=Y
S DIR(0)="NOA^1:52"
S DIR("A")="Payroll Period.....: "
D DIR^ACRFDIC
I 'Y S ACRQUIT="" Q
S ACRPPN=Y
S DIR(0)="DOA^::E"
S DIR("A")="GS Pay Period Ends.: "
D DIR^ACRFDIC
Q:Y'?7N
S ACRCDATE=Y
S DIR(0)="DOA^::E"
S DIR("A")="CO Pay Period Ends.: "
D DIR^ACRFDIC
Q:Y'?7N
S ACRODATE=Y
S DIR(0)="NO^1000:9999"
S DIR("A")="Fiscal Year........: "
S DIR("B")=$S($E(ACRODATE,4,5)<10:$E(ACRODATE,1,3)+1700,1:($E(ACRODATE,1,3)+1)+1700)
D DIR^ACRFDIC
I Y'?4N S ACRQUIT="" Q
S ACRFY=Y
F D CAN Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
CAN ;SELECT CAN NUMBER
S DIC="^ACRLOCB("
S DIC(0)="AEQZ"
S DIC("A")="Payroll CAN........: "
S DIC("S")="I $P($G(^ACRLOCB(+Y,""DT"")),U)=ACRFY"
S D="DCAN"
D IX^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ACRLBDA=+Y
S ACRCANDA=$P(^ACRLOCB(ACRLBDA,"DT"),U,9)
S ACRCAN=$P(^AUTTCAN(ACRCANDA,0),U)
D NEWPAY
I '$O(^ACRAU("CAN",ACRCANDA,0)) D Q
.W !!,"No employees for this payroll CAN."
.D PAUSE^ACRFWARN
D DATA
K ACRQUIT
Q:$D(ACROUT)
D PPSUM
W !!,"NEXT"
Q
DATA ;FIND EMPLOYEES AND EDIT PAYROLL INFO
F D D1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
D1 N ACRAUDA
S (ACRAUDA,ACRJ)=0
F S ACRAUDA=$O(^ACRAU("CAN",ACRCANDA,ACRAUDA)) Q:'ACRAUDA D
.;S ACRAU=$P(^VA(200,ACRAUDA,0),U) ;ACR*2.1*19.02 IM16848
.S ACRAU=$$NAME2^ACRFUTL1(ACRAUDA) ;ACR*2.1*19.02 IM16848
.Q:ACRAU=""
.S ACRSSN=$P($G(^VA(200,ACRAUDA,1)),U,9)
.Q:ACRSSN=""
.S ^TMP("ACRPR",$J,ACRSSN)=ACRAUDA_U_ACRAU
Q:'$D(^TMP("ACRPR",$J))
D EMPLIST
Q:$D(ACRQUIT)
D SELECT
Q
EMPLIST D EMPLH
K ACRSSN
S ACRJ=0
S ACRSSN=""
F S ACRSSN=$O(^TMP("ACRPR",$J,ACRSSN)) Q:ACRSSN=""!$D(ACRQUIT) D
.S ACRJ=ACRJ+1
.S ACRSSN(ACRJ)=^TMP("ACRPR",$J,ACRSSN)_U_ACRSSN
S ACRMAX=ACRJ
S ACRJ=0
S ACRSSN=""
F S ACRSSN=$O(^TMP("ACRPR",$J,ACRSSN)) Q:ACRSSN=""!$D(ACRQUIT) D
.S ACRJ=ACRJ+1
.W !,ACRJ,?4,ACRSSN,?14,$E($P(ACRSSN(ACRJ),U,2),1,20)
.K ACR,ACROH,ACROT,ACRBH
.D EDATA:$D(ACRDOCDA)
.I $G(ACR(1))]"" W ?35,$J($FN(ACR(1),"P",2),8),?44,$J(ACROH,3),?49,$J($FN(ACROT,"P",2),7),?58,$J(ACRBH,3),?62,$J($FN(ACR(1)+ACR(2),"P",2),10),?72,$J($FN(ACR(2),"P",2),7)
.I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D EMPLH
Q
EDATA ;FIND EMPLYEE PAYROLL INFO FOR THE PAY PERIOD
S ACRAUDA=+ACRSSN(ACRJ)
N ACRSSDA,ACRJ
S (ACRSSDA,ACRJ)=0
F S ACRSSDA=$O(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRJ=ACRJ+1
.S ACRSSDT=$G(^ACRSS(ACRSSDA,"DT"))
.S ACRSS2=$G(^ACRSS(ACRSSDA,2))
.I ACRJ=1 S ACR(1)=$P(ACRSSDT,U,4),ACROH=$P(ACRSS2,U,7),ACROT=$P(ACRSS2,U,8),ACRBH=$P(ACRSS2,U,9)
.I ACRJ=2 S ACR(2)=$P(ACRSSDT,U,4)
Q
EMPLH ;EMPLOYEE LIST HEAD
D PPSUM
D PPCAN
W !!,?35,"GROSS",?44,"OVERTIME",?58,"BASE",?63,"NET",?72,"FRINGE"
W !,"NO.",?4,"SSN",?14,"EMPLOYEE",?35,"PAY",?44,"HRS",?49,"PAY",?58,"HRS",?63,"EXPEND",?72,"BENEFITS"
W !,"---",?4,"---------",?14,"--------------------",?35,"--------",?44,"----",?49,"-------",?58,"----",?63,"--------",?72,"-------"
Q
PPSUM ;PAYPERIOD SUMMARY
W @IOF
W !?4,"Payroll Control NO.: ",ACRCN
W !?4,"Payroll Period.....: ",ACRPPN
W !?4,"Pay Period Ends....: "
F Y=ACRCDATE,ACRODATE X ^DD("DD") W Y,?$X+3
W !?4,"Fiscal Year........: ",ACRFY
Q
PPCAN ;PAY PERIOD CAN
W !?4,"Payroll CAN........: ",ACRCAN
Q
SELECT ;SELECT TYPE OF ACTION AND EMPLOYEES
S DIR(0)="SO^1:EDIT Existing Payroll entry;2:ADD New Payroll entry;3:REMOVE Payroll entry"
S DIR("A")="Which One"
W !
D DIR^ACRFDIC
I Y<1 S ACRQUIT="" Q
I Y=1 D EDIT Q
I Y=2 D ADD Q
I Y=3 D REMOVE Q
Q
PDAT ;EP;TO REVIEW EMPLOYEE DATA
Q
EDIT ;
D WHICH
Q:'$G(ACRXX)
N ACRJ
F ACRJ=1:1 S ACRX=$P(ACRXX,",",ACRJ) Q:'ACRX I $D(ACRSSN(ACRX)) S ACRAUDA=+ACRSSN(ACRX) D E1
Q
E1 ;EDIT EACH ENTRY
Q:'$G(ACRAUDA)
;W !!,"Edit existing data for: ",$P($G(^VA(200,ACRAUDA,0)),U) ;ACR*2.1*19.02 IM16848
W !!,"Edit existing data for: ",$$NAME2^ACRFUTL1(ACRAUDA) ;ACR*2.1*19.02 IM16848
W !," For Fiscal Year: ",ACRFY," Pay Period: ",ACRPPN," Control NO.: ",ACRCN
N ACRJ,ACRSSDA
S (ACRSSDA,ACRJ)=0
F S ACRSSDA=$O(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRJ=ACRJ+1
.S DA=ACRSSDA
.S DIE="^ACRSS("
.I ACRJ=1 S DR="12GROSS PAY...........;36T;37T;38T"
.E S DR="12BENEFITS............"
.D DIE^ACRFDIC
.D E11
Q
E11 S DA=ACRSSDA
S DIE="^ACRSS("
S DR="18////"_$P(^ACRSS(ACRSSDA,"DT"),U,4)_";16.1////"_$P(^("DT"),U,4)
D DIE^ACRFDIC
Q
WHICH S DIR(0)="LOA^1:"_ACRMAX
S DIR("A")="Which one(s): "
W !
D DIR^ACRFDIC
Q:'+Y
S ACRXX=Y
Q
REMOVE D WHICH
Q:'$G(ACRXX)
S DIR(0)="YO"
S DIR("A")="Are you certain you want to"
S DIR("A")="REMOVE entr"_$S($P(ACRXX,",",2):"ies",1:"y")_" "_ACRXX
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
N ACRJ
F ACRJ=1:1 S ACRX=$P(ACRXX,",",ACRJ) Q:'ACRX D R1
Q
R1 ;REMOVE ENTRIES
N ACRSSDA
S ACRSSDA=0
F S ACRSSDA=$O(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA)) Q:'ACRSSDA D
.S DA=ACRSSDA
.S DIK="^ACRSS("
.D DIK^ACRFDIC
Q
ADD ;
S ACRI=0
F S ACRI=$O(ACRSSN(ACRI)) Q:'ACRI!$D(ACRQUIT) D
.S ACRAUDA=+ACRSSN(ACRI)
.Q:'ACRAUDA
.Q:$O(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,0))
.D NEW
K ACRQUIT
Q
NEW ;
S ACRAU=ACRSSN(ACRI)
S ACRAUDA=+ACRAU
S ACRDATE=$P(^ACRAU(ACRAUDA,1),U,3)
I ACRDATE="CO" S ACRDATE=ACRODATE
E S ACRDATE=ACRCDATE
D PPSUM
D PPCAN
;W !!,"PAYROLL DATA FOR: ",@ACRON,$P(^VA(200,ACRAUDA,0),U),@ACROF,! ;ACR*2.1*19.02 IM16848
W !!,"PAYROLL DATA FOR: ",@ACRON,$$NAME2^ACRFUTL1(ACRAUDA),@ACROF,! ;ACR*2.1*19.02 IM16848
S DIR(0)="NOA^0:99999.99:2"
S DIR("A")="GROSS PAY.....: "
D DIR^ACRFDIC
Q:Y<1
S ACR(1)=Y
S DIR(0)="NOA^0:80"
S DIR("A")="OVERTIME HOURS: "
D DIR^ACRFDIC
S ACROH=Y
S DIR(0)="NOA^0:9999.99:2"
S DIR("A")="OVERTIME PAY..: "
D DIR^ACRFDIC
S ACROT=Y
S DIR(0)="NOA^0:80"
S DIR("A")="BASE HOURS....: "
S DIR("B")=$S($P($G(^ACRAU(+$G(ACRAUDA),1)),U,3)="CO":160,1:80)
D DIR^ACRFDIC
S ACRBH=Y
Q:Y<1
S DIR(0)="NOA^0:99999.99:2"
S DIR("A")="NET EXPEND....: "
D DIR^ACRFDIC
S ACR(2)=Y
Q:Y<1
D CONFIRM
I $D(ACRQUIT) K ACRQUIT Q
F ACRJ=1,2 D FILE
Q
FILE S X=ACRJ
S DIC="^ACRSS("
S DIC(0)="L"
S ACROBJDA=1
S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROBJDA_";.05////"_ACRCANDA_";.06////"_ACRLBDA_";.13////"_ACRFY_";.17////"_ACRAUDA_";.2////"_ACRDOCDA_";1////"_ACRCN_";5////"_ACRPPN_";10////1;11///EA;15.3////"_ACRDATE
I ACRJ=1 S DIC("DR")=DIC("DR")_";12////"_ACR(1)_";18////"_ACR(1)_";16.1////"_ACR(1)_";36////"_ACROH_";37////"_ACROT_";38////"_ACRBH
I ACRJ=2 S ACRX=ACR(2)-ACR(1) S DIC("DR")=DIC("DR")_";12////"_ACRX_";18////"_ACRX_";16.1////"_ACRX
D FILE^ACRFDIC
S ACRSSDA=+Y
Q
CONFIRM ;CONFIRM PAYROLL DATA
S DIR(0)="YO"
S DIR("A")="File PAYROLL DATA"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
S:Y'=1 ACRQUIT=""
Q
NEWPAY ;CREATE PAY ENTRY FOR NEW PAY PERIOD AND NEW DEPARTMENT ACCOUNT
S ACRDOC=ACRFY_"-"_ACRCN
S ACRDOCDA=$O(^ACRDOC("B",ACRDOC,0))
Q:ACRDOCDA
K ACRDOCDA
S X=ACRDOC
S DIC="^ACRDOC("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRCN_";.03////"_DT_";.04////18;.06////"_ACRLBDA_";.13////60;.14////"_ACRFY_"-"_ACRCN_";130080////"_ACRCDATE_";130090////"_ACRODATE
D FILE^ACRFDIC
I Y<1 G NEWPAY
S ACRDOCDA=+Y
PN1 S X=ACRDOCDA
S DIC="^ACROBL("
S DIC(0)="L"
S DIC("DR")=".03////"_ACRLBDA_".05////"_DUZ_";.06////"_DT_";.1////60;1////"_ACRDOCDA_";120////SALARIES FOR FY: "_ACRFY_";121////CONTROL NO.: "_ACRCN_", PAY PERIOD: "_ACRPPN
D FILE^ACRFDIC
I Y<1 G PN1
Q
PINFO ;EP;TO ENTER PERSONNEL INFO
F D PI1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACROUT
Q
PI1 S DIC="^ACRAU("
S DIC(0)="AEMQZ"
S DIC("A")="Employee's Name.....: "
D PIH
D DIC^ACRFDIC
I Y<1 S ACRQUIT="" Q
S DA=+Y
S DIE="^ACRAU("
S DR="[ACR PERSONNEL INFO]"
D DDS^ACRFDIC
I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
Q
PIH W @IOF
W !?20,"Enter Employee Personnel Information",!!
Q
ACRFPR ;IHS/DSD/THL,AEF - PAYROLL DATA; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;
+3 ;UTILITY TO ENTER/EDIT PAYROLL DATA
+4 ;
EN DO EXIT
+1 DO EN1
EXIT KILL ACRCDATE,ACRODATE,ACRCANDA,ACRCAN,ACRFY,ACRQUIT,ACROUT,ACRCN,ACRPPN,ACRBY,ACRGP,ACRNE,ACROH,ACROP,ACRSSN,ACRCN,ACRDATE,ACRAU,ACRDOC,ACRDOCDA,ACRI,ACRJ,ACRLBDA,ACRMAX,ACRSS2,ACRSSDT,ACRX,ACRXX,ACRY
+1 KILL ^TMP("ACRPR",$JOB)
+2 QUIT
EN1 ;EDIT PERSONNEL DATA
+1 WRITE @IOF
+2 WRITE !?10,"PAYROLL DATA ENTRY UTILITY"
+3 SET DIR(0)="FOA^6:6"
+4 SET DIR("A")="Payroll Control NO.: "
+5 WRITE !!
+6 DO DIR^ACRFDIC
+7 IF Y'?6N
SET ACRQUIT=""
QUIT
+8 SET ACRCN=Y
+9 SET DIR(0)="NOA^1:52"
+10 SET DIR("A")="Payroll Period.....: "
+11 DO DIR^ACRFDIC
+12 IF 'Y
SET ACRQUIT=""
QUIT
+13 SET ACRPPN=Y
+14 SET DIR(0)="DOA^::E"
+15 SET DIR("A")="GS Pay Period Ends.: "
+16 DO DIR^ACRFDIC
+17 IF Y'?7N
QUIT
+18 SET ACRCDATE=Y
+19 SET DIR(0)="DOA^::E"
+20 SET DIR("A")="CO Pay Period Ends.: "
+21 DO DIR^ACRFDIC
+22 IF Y'?7N
QUIT
+23 SET ACRODATE=Y
+24 SET DIR(0)="NO^1000:9999"
+25 SET DIR("A")="Fiscal Year........: "
+26 SET DIR("B")=$SELECT($EXTRACT(ACRODATE,4,5)<10:$EXTRACT(ACRODATE,1,3)+1700,1:($EXTRACT(ACRODATE,1,3)+1)+1700)
+27 DO DIR^ACRFDIC
+28 IF Y'?4N
SET ACRQUIT=""
QUIT
+29 SET ACRFY=Y
+30 FOR
DO CAN
IF $DATA">DATA(ACRQUIT)!$DATA">DATA(ACROUT)
QUIT
+31 KILL ACRQUIT
+32 QUIT
CAN ;SELECT CAN NUMBER
+1 SET DIC="^ACRLOCB("
+2 SET DIC(0)="AEQZ"
+3 SET DIC("A")="Payroll CAN........: "
+4 SET DIC("S")="I $P($G(^ACRLOCB(+Y,""DT"")),U)=ACRFY"
+5 SET D="DCAN"
+6 DO IX^ACRFDIC
+7 IF Y<1
SET ACRQUIT=""
QUIT
+8 SET ACRLBDA=+Y
+9 SET ACRCANDA=$PIECE(^ACRLOCB(ACRLBDA,"DT"),U,9)
+10 SET ACRCAN=$PIECE(^AUTTCAN(ACRCANDA,0),U)
+11 DO NEWPAY
+12 IF '$ORDER(^ACRAU("CAN",ACRCANDA,0))
Begin DoDot:1
+13 WRITE !!,"No employees for this payroll CAN."
+14 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+15 DO DATA
+16 KILL ACRQUIT
+17 IF $DATA(ACROUT)
QUIT
+18 DO PPSUM
+19 WRITE !!,"NEXT"
+20 QUIT
DATA ;FIND EMPLOYEES AND EDIT PAYROLL INFO
+1 FOR
DO D1
IF $DATA">DATA(ACRQUIT)!$DATA">DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
D1 NEW ACRAUDA
+1 SET (ACRAUDA,ACRJ)=0
+2 FOR
SET ACRAUDA=$ORDER(^ACRAU("CAN",ACRCANDA,ACRAUDA))
IF 'ACRAUDA
QUIT
Begin DoDot:1
+3 ;S ACRAU=$P(^VA(200,ACRAUDA,0),U) ;ACR*2.1*19.02 IM16848
+4 ;ACR*2.1*19.02 IM16848
SET ACRAU=$$NAME2^ACRFUTL1(ACRAUDA)
+5 IF ACRAU=""
QUIT
+6 SET ACRSSN=$PIECE($GET(^VA(200,ACRAUDA,1)),U,9)
+7 IF ACRSSN=""
QUIT
+8 SET ^TMP("ACRPR",$JOB,ACRSSN)=ACRAUDA_U_ACRAU
End DoDot:1
+9 IF '$DATA(^TMP("ACRPR",$JOB))
QUIT
+10 DO EMPLIST
+11 IF $DATA(ACRQUIT)
QUIT
+12 DO SELECT
+13 QUIT
EMPLIST DO EMPLH
+1 KILL ACRSSN
+2 SET ACRJ=0
+3 SET ACRSSN=""
+4 FOR
SET ACRSSN=$ORDER(^TMP("ACRPR",$JOB,ACRSSN))
IF ACRSSN=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+5 SET ACRJ=ACRJ+1
+6 SET ACRSSN(ACRJ)=^TMP("ACRPR",$JOB,ACRSSN)_U_ACRSSN
End DoDot:1
+7 SET ACRMAX=ACRJ
+8 SET ACRJ=0
+9 SET ACRSSN=""
+10 FOR
SET ACRSSN=$ORDER(^TMP("ACRPR",$JOB,ACRSSN))
IF ACRSSN=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+11 SET ACRJ=ACRJ+1
+12 WRITE !,ACRJ,?4,ACRSSN,?14,$EXTRACT($PIECE(ACRSSN(ACRJ),U,2),1,20)
+13 KILL ACR,ACROH,ACROT,ACRBH
+14 IF $DATA(ACRDOCDA)
DO EDATA
+15 IF $GET(ACR(1))]""
WRITE ?35,$JUSTIFY($FNUMBER(ACR(1),"P",2),8),?44,$JUSTIFY(ACROH,3),?49,$JUSTIFY($FNUMBER(ACROT,"P",2),7),?58,$JUSTIFY(ACRBH,3),?62,$JUSTIFY($FNUMBER(ACR(1)+ACR(2),"P",2),10),?72,$JUSTIFY($FNUMBER(ACR(2),"P",2),7)
+16 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO EMPLH
End DoDot:1
+17 QUIT
EDATA ;FIND EMPLYEE PAYROLL INFO FOR THE PAY PERIOD
+1 SET ACRAUDA=+ACRSSN(ACRJ)
+2 NEW ACRSSDA,ACRJ
+3 SET (ACRSSDA,ACRJ)=0
+4 FOR
SET ACRSSDA=$ORDER(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+5 SET ACRJ=ACRJ+1
+6 SET ACRSSDT=$GET(^ACRSS(ACRSSDA,"DT"))
+7 SET ACRSS2=$GET(^ACRSS(ACRSSDA,2))
+8 IF ACRJ=1
SET ACR(1)=$PIECE(ACRSSDT,U,4)
SET ACROH=$PIECE(ACRSS2,U,7)
SET ACROT=$PIECE(ACRSS2,U,8)
SET ACRBH=$PIECE(ACRSS2,U,9)
+9 IF ACRJ=2
SET ACR(2)=$PIECE(ACRSSDT,U,4)
End DoDot:1
+10 QUIT
EMPLH ;EMPLOYEE LIST HEAD
+1 DO PPSUM
+2 DO PPCAN
+3 WRITE !!,?35,"GROSS",?44,"OVERTIME",?58,"BASE",?63,"NET",?72,"FRINGE"
+4 WRITE !,"NO.",?4,"SSN",?14,"EMPLOYEE",?35,"PAY",?44,"HRS",?49,"PAY",?58,"HRS",?63,"EXPEND",?72,"BENEFITS"
+5 WRITE !,"---",?4,"---------",?14,"--------------------",?35,"--------",?44,"----",?49,"-------",?58,"----",?63,"--------",?72,"-------"
+6 QUIT
PPSUM ;PAYPERIOD SUMMARY
+1 WRITE @IOF
+2 WRITE !?4,"Payroll Control NO.: ",ACRCN
+3 WRITE !?4,"Payroll Period.....: ",ACRPPN
+4 WRITE !?4,"Pay Period Ends....: "
+5 FOR Y=ACRCDATE,ACRODATE
XECUTE ^DD("DD")
WRITE Y,?$X+3
+6 WRITE !?4,"Fiscal Year........: ",ACRFY
+7 QUIT
PPCAN ;PAY PERIOD CAN
+1 WRITE !?4,"Payroll CAN........: ",ACRCAN
+2 QUIT
SELECT ;SELECT TYPE OF ACTION AND EMPLOYEES
+1 SET DIR(0)="SO^1:EDIT Existing Payroll entry;2:ADD New Payroll entry;3:REMOVE Payroll entry"
+2 SET DIR("A")="Which One"
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF Y<1
SET ACRQUIT=""
QUIT
+6 IF Y=1
DO EDIT
QUIT
+7 IF Y=2
DO ADD
QUIT
+8 IF Y=3
DO REMOVE
QUIT
+9 QUIT
PDAT ;EP;TO REVIEW EMPLOYEE DATA
+1 QUIT
EDIT ;
+1 DO WHICH
+2 IF '$GET(ACRXX)
QUIT
+3 NEW ACRJ
+4 FOR ACRJ=1:1
SET ACRX=$PIECE(ACRXX,",",ACRJ)
IF 'ACRX
QUIT
IF $DATA(ACRSSN(ACRX))
SET ACRAUDA=+ACRSSN(ACRX)
DO E1
+5 QUIT
E1 ;EDIT EACH ENTRY
+1 IF '$GET(ACRAUDA)
QUIT
+2 ;W !!,"Edit existing data for: ",$P($G(^VA(200,ACRAUDA,0)),U) ;ACR*2.1*19.02 IM16848
+3 ;ACR*2.1*19.02 IM16848
WRITE !!,"Edit existing data for: ",$$NAME2^ACRFUTL1(ACRAUDA)
+4 WRITE !," For Fiscal Year: ",ACRFY," Pay Period: ",ACRPPN," Control NO.: ",ACRCN
+5 NEW ACRJ,ACRSSDA
+6 SET (ACRSSDA,ACRJ)=0
+7 FOR
SET ACRSSDA=$ORDER(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+8 SET ACRJ=ACRJ+1
+9 SET DA=ACRSSDA
+10 SET DIE="^ACRSS("
+11 IF ACRJ=1
SET DR="12GROSS PAY...........;36T;37T;38T"
+12 IF '$TEST
SET DR="12BENEFITS............"
+13 DO DIE^ACRFDIC
+14 DO E11
End DoDot:1
+15 QUIT
E11 SET DA=ACRSSDA
+1 SET DIE="^ACRSS("
+2 SET DR="18////"_$PIECE(^ACRSS(ACRSSDA,"DT"),U,4)_";16.1////"_$PIECE(^("DT"),U,4)
+3 DO DIE^ACRFDIC
+4 QUIT
WHICH SET DIR(0)="LOA^1:"_ACRMAX
+1 SET DIR("A")="Which one(s): "
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF '+Y
QUIT
+5 SET ACRXX=Y
+6 QUIT
REMOVE DO WHICH
+1 IF '$GET(ACRXX)
QUIT
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Are you certain you want to"
+4 SET DIR("A")="REMOVE entr"_$SELECT($PIECE(ACRXX,",",2):"ies",1:"y")_" "_ACRXX
+5 SET DIR("B")="NO"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF Y'=1
QUIT
+9 NEW ACRJ
+10 FOR ACRJ=1:1
SET ACRX=$PIECE(ACRXX,",",ACRJ)
IF 'ACRX
QUIT
DO R1
+11 QUIT
R1 ;REMOVE ENTRIES
+1 NEW ACRSSDA
+2 SET ACRSSDA=0
+3 FOR
SET ACRSSDA=$ORDER(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+4 SET DA=ACRSSDA
+5 SET DIK="^ACRSS("
+6 DO DIK^ACRFDIC
End DoDot:1
+7 QUIT
ADD ;
+1 SET ACRI=0
+2 FOR
SET ACRI=$ORDER(ACRSSN(ACRI))
IF 'ACRI!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+3 SET ACRAUDA=+ACRSSN(ACRI)
+4 IF 'ACRAUDA
QUIT
+5 IF $ORDER(^ACRSS("PR",ACRFY,ACRCN,ACRAUDA,0))
QUIT
+6 DO NEW
End DoDot:1
+7 KILL ACRQUIT
+8 QUIT
NEW ;
+1 SET ACRAU=ACRSSN(ACRI)
+2 SET ACRAUDA=+ACRAU
+3 SET ACRDATE=$PIECE(^ACRAU(ACRAUDA,1),U,3)
+4 IF ACRDATE="CO"
SET ACRDATE=ACRODATE
+5 IF '$TEST
SET ACRDATE=ACRCDATE
+6 DO PPSUM
+7 DO PPCAN
+8 ;W !!,"PAYROLL DATA FOR: ",@ACRON,$P(^VA(200,ACRAUDA,0),U),@ACROF,! ;ACR*2.1*19.02 IM16848
+9 ;ACR*2.1*19.02 IM16848
WRITE !!,"PAYROLL DATA FOR: ",@ACRON,$$NAME2^ACRFUTL1(ACRAUDA),@ACROF,!
+10 SET DIR(0)="NOA^0:99999.99:2"
+11 SET DIR("A")="GROSS PAY.....: "
+12 DO DIR^ACRFDIC
+13 IF Y<1
QUIT
+14 SET ACR(1)=Y
+15 SET DIR(0)="NOA^0:80"
+16 SET DIR("A")="OVERTIME HOURS: "
+17 DO DIR^ACRFDIC
+18 SET ACROH=Y
+19 SET DIR(0)="NOA^0:9999.99:2"
+20 SET DIR("A")="OVERTIME PAY..: "
+21 DO DIR^ACRFDIC
+22 SET ACROT=Y
+23 SET DIR(0)="NOA^0:80"
+24 SET DIR("A")="BASE HOURS....: "
+25 SET DIR("B")=$SELECT($PIECE($GET(^ACRAU(+$GET(ACRAUDA),1)),U,3)="CO":160,1:80)
+26 DO DIR^ACRFDIC
+27 SET ACRBH=Y
+28 IF Y<1
QUIT
+29 SET DIR(0)="NOA^0:99999.99:2"
+30 SET DIR("A")="NET EXPEND....: "
+31 DO DIR^ACRFDIC
+32 SET ACR(2)=Y
+33 IF Y<1
QUIT
+34 DO CONFIRM
+35 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+36 FOR ACRJ=1,2
DO FILE
+37 QUIT
FILE SET X=ACRJ
+1 SET DIC="^ACRSS("
+2 SET DIC(0)="L"
+3 SET ACROBJDA=1
+4 SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROBJDA_";.05////"_ACRCANDA_";.06////"_ACRLBDA_";.13////"_ACRFY_";.17////"_ACRAUDA_";.2////"_ACRDOCDA_";1////"_ACRCN_";5////"_ACRPPN_";10////1;11///EA;15.3////"_ACRDATE
+5 IF ACRJ=1
SET DIC("DR")=DIC("DR")_";12////"_ACR(1)_";18////"_ACR(1)_";16.1////"_ACR(1)_";36////"_ACROH_";37////"_ACROT_";38////"_ACRBH
+6 IF ACRJ=2
SET ACRX=ACR(2)-ACR(1)
SET DIC("DR")=DIC("DR")_";12////"_ACRX_";18////"_ACRX_";16.1////"_ACRX
+7 DO FILE^ACRFDIC
+8 SET ACRSSDA=+Y
+9 QUIT
CONFIRM ;CONFIRM PAYROLL DATA
+1 SET DIR(0)="YO"
+2 SET DIR("A")="File PAYROLL DATA"
+3 SET DIR("B")="YES"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y'=1
SET ACRQUIT=""
+7 QUIT
NEWPAY ;CREATE PAY ENTRY FOR NEW PAY PERIOD AND NEW DEPARTMENT ACCOUNT
+1 SET ACRDOC=ACRFY_"-"_ACRCN
+2 SET ACRDOCDA=$ORDER(^ACRDOC("B",ACRDOC,0))
+3 IF ACRDOCDA
QUIT
+4 KILL ACRDOCDA
+5 SET X=ACRDOC
+6 SET DIC="^ACRDOC("
+7 SET DIC(0)="L"
+8 SET DIC("DR")=".02////"_ACRCN_";.03////"_DT_";.04////18;.06////"_ACRLBDA_";.13////60;.14////"_ACRFY_"-"_ACRCN_";130080////"_ACRCDATE_";130090////"_ACRODATE
+9 DO FILE^ACRFDIC
+10 IF Y<1
GOTO NEWPAY
+11 SET ACRDOCDA=+Y
PN1 SET X=ACRDOCDA
+1 SET DIC="^ACROBL("
+2 SET DIC(0)="L"
+3 SET DIC("DR")=".03////"_ACRLBDA_".05////"_DUZ_";.06////"_DT_";.1////60;1////"_ACRDOCDA_";120////SALARIES FOR FY: "_ACRFY_";121////CONTROL NO.: "_ACRCN_", PAY PERIOD: "_ACRPPN
+4 DO FILE^ACRFDIC
+5 IF Y<1
GOTO PN1
+6 QUIT
PINFO ;EP;TO ENTER PERSONNEL INFO
+1 FOR
DO PI1
IF $DATA">DATA(ACRQUIT)!$DATA">DATA(ACROUT)
QUIT
+2 KILL ACRQUIT,ACROUT
+3 QUIT
PI1 SET DIC="^ACRAU("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Employee's Name.....: "
+3 DO PIH
+4 DO DIC^ACRFDIC
+5 IF Y<1
SET ACRQUIT=""
QUIT
+6 SET DA=+Y
+7 SET DIE="^ACRAU("
+8 SET DR="[ACR PERSONNEL INFO]"
+9 DO DDS^ACRFDIC
+10 IF $DATA(ACRSCREN)
KILL ACRSCREN
DO DIE^ACRFDIC
+11 QUIT
PIH WRITE @IOF
+1 WRITE !?20,"Enter Employee Personnel Information",!!
+2 QUIT
