Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFPR

ACRFPR.m

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