| 1 | PRSREX1 ;HISC/JH,JAH-INDIVIDUAL SERVICE EXPENDITURE REPORT ;22-JAN-1998
 | 
|---|
| 2 |  ;;4.0;PAID;**2,16,17,19,35**;Sep 21, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;TLESEL sets up TLE array in PRSUT0:
 | 
|---|
| 5 |  ;   TLE      = # units selected
 | 
|---|
| 6 |  ;   TLE(n)   = T&L unit ^ name
 | 
|---|
| 7 |  ;   TLE(n,m) = IEN ^ member name
 | 
|---|
| 8 |  ;T&A Supervisor entry point
 | 
|---|
| 9 | SUP S PRSTLV=3
 | 
|---|
| 10 |  S (PRSR,PRSAI)=1
 | 
|---|
| 11 |  D TLESEL^PRSRUT0 G MSG4:$G(TLE)=""!(SSN="") G EN1
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  ;Payroll entry point
 | 
|---|
| 14 | FIS S PRSR=2,PRSTLV=3
 | 
|---|
| 15 |  D TLESEL^PRSRUT0 G MSG4:TLE=""!(SSN="")
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 | EN1 W ! S X="T",%DT="" D ^%DT Q:Y<0  S DT=Y K %DT
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 |  ;set DA to earliest payrun on record
 | 
|---|
| 20 |  ;ask, construct and validate payperiod input
 | 
|---|
| 21 | ASK S DA=""
 | 
|---|
| 22 |  S DA=$O(^PRST(459,"AB",DA))
 | 
|---|
| 23 |  S DA=$E((DA-1700),1,3)_"0000"
 | 
|---|
| 24 |  S %DT("A")="Enter YEAR: "
 | 
|---|
| 25 |  S %DT="AEP",%DT(0)=-DT
 | 
|---|
| 26 |  D ^%DT G Q1:$D(DTOUT)!(X="^"),MSG2:X="?"!(Y=-1),MSG3:Y<DA K %DT S YEAR=$E(Y,2,3)
 | 
|---|
| 27 | ASK1 R !!,"Enter Pay Period (Return for all): ",PPE:DTIME G Q1:'$T!(PPE="^") G MSG:(PPE'>0&(PPE'<27))!(PPE["?")
 | 
|---|
| 28 |  I PPE'="" S II=$L(PPE),PPE=$S(II>1:PPE,1:"0"_PPE),DA(1)=YEAR_"-"_PPE,DA=$O(^PRST(459,"B",DA(1),"")) G MSG1:DA=""
 | 
|---|
| 29 |  E  S DA(1)=$E(Y,2,3)_"-"_"00" W !,"This report could take some time, remember to QUEUE the report."
 | 
|---|
| 30 |  D DUZ^PRSRUTL
 | 
|---|
| 31 |  S TLUNIT=$S(PRSRDUZ:$P($G(^PRSPC(PRSRDUZ,0)),"^",7),1:$O(^VA(200,DUZ,2,0))),TLI=$S(PRSRDUZ:$P($G(^(0)),"^",8),1:"000")
 | 
|---|
| 32 |  S ZTRTN="START^PRSREX1",ZTDESC="SERVICE EXPENDITURE REPORT" W !!,$C(7),"THIS IS A 132 COLUMN REPORT !",! D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
 | 
|---|
| 33 | START S (CNT,POUT,TGOV,TOTAL)=0 K ^TMP($J) S ^TMP($J,"EXP")="EMPLOYEE COST FOR PAY PERIOD" F II=1:1:9 S TOTAL(II)=0
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  S DAT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  ;if a single pay period was selected
 | 
|---|
| 38 |  I PPE D EXP^PRSROSOR,IND,Q1 Q
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 |  ;otherwise all pay periods for a year were selected
 | 
|---|
| 41 |  ;Q if we've gone into next year or end
 | 
|---|
| 42 |  F II=0:0 S DA(1)=$O(^PRST(459,"B",DA(1))) Q:DA(1)=""!($P(DA(1),"-")'=YEAR)  D
 | 
|---|
| 43 |  .  S DA=0 F II=0:0 S DA=$O(^PRST(459,"B",DA(1),DA)) Q:DA'>0  D EXP^PRSROSOR
 | 
|---|
| 44 |  .  Q
 | 
|---|
| 45 | IND U IO I 'CNT S PP=PPE,SW(7)=1,TLEU=TLE D HDR1^PRSREX11,VLIN0^PRSREX11 W "|",?10,"No Expenditures on File this Pay Period.",?131,"|" S POUT=1 D NONE G Q1
 | 
|---|
| 46 |  D ^PRSREX11
 | 
|---|
| 47 | Q1 K %,%DT,FOOT,CODE,TLE,TLUNIT,CNT,COS,COSORG,D0,DA,DAT,DTOUT,POP,DIC,GOV,TGOV,NAM,PP,PPE,PRSAI,PRSR,PRSTLV,STOT
 | 
|---|
| 48 |  K TL,TLI,USR,Z1,I,II,ORG,PRSRDUZ,POUT,SSN,SW,TIME,TOT,TOTAL,X,Y,YEAR,ZTDESC,ZTRTN,ZTSAVE,^TMP($J) D ^%ZISC S:$D(ZTSK) ZTREQ="@" K ZTSK
 | 
|---|
| 49 |  Q
 | 
|---|
| 50 | NONE I IOSL<66 F I=$Y:1:IOSL-5 D VLIN0^PRSREX11
 | 
|---|
| 51 |  D HDR^PRSREX11
 | 
|---|
| 52 |  Q
 | 
|---|
| 53 | MSG W !,"Enter Numeric Digit, 1 thru 26 or Return/Enter for All Pay Periods." G ASK1
 | 
|---|
| 54 | MSG1 W !!,*7,"*** Pay Period ",PPE," Year ",YEAR," not found in File." G ASK1
 | 
|---|
| 55 | MSG2 W !!,*7,"*** Enter Year: 92 , 1994 ... " G ASK
 | 
|---|
| 56 | MSG3 W !!,*7,"*** Year Entered is not on File." G ASK
 | 
|---|
| 57 | MSG4 R !!,"Press Return/Enter to continue. ",X:DTIME G Q1
 | 
|---|
| 58 | LOOP F X="DA*","TLE*","TLI","TLUNIT","DT","ORG","PPE","YEAR","SW" S ZTSAVE(X)=""
 | 
|---|
| 59 |  Q
 | 
|---|