PRSREX1 ;HISC/JH,JAH-INDIVIDUAL SERVICE EXPENDITURE REPORT ;22-JAN-1998
;;4.0;PAID;**2,16,17,19,35**;Sep 21, 1995
;
;TLESEL sets up TLE array in PRSUT0:
; TLE = # units selected
; TLE(n) = T&L unit ^ name
; TLE(n,m) = IEN ^ member name
;T&A Supervisor entry point
SUP S PRSTLV=3
S (PRSR,PRSAI)=1
D TLESEL^PRSRUT0 G MSG4:$G(TLE)=""!(SSN="") G EN1
;
;Payroll entry point
FIS S PRSR=2,PRSTLV=3
D TLESEL^PRSRUT0 G MSG4:TLE=""!(SSN="")
;
EN1 W ! S X="T",%DT="" D ^%DT Q:Y<0 S DT=Y K %DT
;
;set DA to earliest payrun on record
;ask, construct and validate payperiod input
ASK S DA=""
S DA=$O(^PRST(459,"AB",DA))
S DA=$E((DA-1700),1,3)_"0000"
S %DT("A")="Enter YEAR: "
S %DT="AEP",%DT(0)=-DT
D ^%DT G Q1:$D(DTOUT)!(X="^"),MSG2:X="?"!(Y=-1),MSG3:Y<DA K %DT S YEAR=$E(Y,2,3)
ASK1 R !!,"Enter Pay Period (Return for all): ",PPE:DTIME G Q1:'$T!(PPE="^") G MSG:(PPE'>0&(PPE'<27))!(PPE["?")
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=""
E S DA(1)=$E(Y,2,3)_"-"_"00" W !,"This report could take some time, remember to QUEUE the report."
D DUZ^PRSRUTL
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")
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))
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
;
S DAT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
;
;if a single pay period was selected
I PPE D EXP^PRSROSOR,IND,Q1 Q
;
;otherwise all pay periods for a year were selected
;Q if we've gone into next year or end
F II=0:0 S DA(1)=$O(^PRST(459,"B",DA(1))) Q:DA(1)=""!($P(DA(1),"-")'=YEAR) D
. S DA=0 F II=0:0 S DA=$O(^PRST(459,"B",DA(1),DA)) Q:DA'>0 D EXP^PRSROSOR
. Q
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
D ^PRSREX11
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
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
Q
NONE I IOSL<66 F I=$Y:1:IOSL-5 D VLIN0^PRSREX11
D HDR^PRSREX11
Q
MSG W !,"Enter Numeric Digit, 1 thru 26 or Return/Enter for All Pay Periods." G ASK1
MSG1 W !!,*7,"*** Pay Period ",PPE," Year ",YEAR," not found in File." G ASK1
MSG2 W !!,*7,"*** Enter Year: 92 , 1994 ... " G ASK
MSG3 W !!,*7,"*** Year Entered is not on File." G ASK
MSG4 R !!,"Press Return/Enter to continue. ",X:DTIME G Q1
LOOP F X="DA*","TLE*","TLI","TLUNIT","DT","ORG","PPE","YEAR","SW" S ZTSAVE(X)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSREX1 2876 printed Oct 16, 2024@18:29:10 Page 2
PRSREX1 ;HISC/JH,JAH-INDIVIDUAL SERVICE EXPENDITURE REPORT ;22-JAN-1998
+1 ;;4.0;PAID;**2,16,17,19,35**;Sep 21, 1995
+2 ;
+3 ;TLESEL sets up TLE array in PRSUT0:
+4 ; TLE = # units selected
+5 ; TLE(n) = T&L unit ^ name
+6 ; TLE(n,m) = IEN ^ member name
+7 ;T&A Supervisor entry point
SUP SET PRSTLV=3
+1 SET (PRSR,PRSAI)=1
+2 DO TLESEL^PRSRUT0
if $GET(TLE)=""!(SSN="")
GOTO MSG4
GOTO EN1
+3 ;
+4 ;Payroll entry point
FIS SET PRSR=2
SET PRSTLV=3
+1 DO TLESEL^PRSRUT0
if TLE=""!(SSN="")
GOTO MSG4
+2 ;
EN1 WRITE !
SET X="T"
SET %DT=""
DO ^%DT
if Y<0
QUIT
SET DT=Y
KILL %DT
+1 ;
+2 ;set DA to earliest payrun on record
+3 ;ask, construct and validate payperiod input
ASK SET DA=""
+1 SET DA=$ORDER(^PRST(459,"AB",DA))
+2 SET DA=$EXTRACT((DA-1700),1,3)_"0000"
+3 SET %DT("A")="Enter YEAR: "
+4 SET %DT="AEP"
SET %DT(0)=-DT
+5 DO ^%DT
if $DATA(DTOUT)!(X="^")
GOTO Q1
if X="?"!(Y=-1)
GOTO MSG2
if Y<DA
GOTO MSG3
KILL %DT
SET YEAR=$EXTRACT(Y,2,3)
ASK1 READ !!,"Enter Pay Period (Return for all): ",PPE:DTIME
if '$TEST!(PPE="^")
GOTO Q1
if (PPE'>0&(PPE'<27))!(PPE["?")
GOTO MSG
+1 IF PPE'=""
SET II=$LENGTH(PPE)
SET PPE=$SELECT(II>1:PPE,1:"0"_PPE)
SET DA(1)=YEAR_"-"_PPE
SET DA=$ORDER(^PRST(459,"B",DA(1),""))
if DA=""
GOTO MSG1
+2 IF '$TEST
SET DA(1)=$EXTRACT(Y,2,3)_"-"_"00"
WRITE !,"This report could take some time, remember to QUEUE the report."
+3 DO DUZ^PRSRUTL
+4 SET TLUNIT=$SELECT(PRSRDUZ:$PIECE($GET(^PRSPC(PRSRDUZ,0)),"^",7),1:$ORDER(^VA(200,DUZ,2,0)))
SET TLI=$SELECT(PRSRDUZ:$PIECE($GET(^(0)),"^",8),1:"000")
+5 SET ZTRTN="START^PRSREX1"
SET ZTDESC="SERVICE EXPENDITURE REPORT"
WRITE !!,$CHAR(7),"THIS IS A 132 COLUMN REPORT !",!
DO ST^PRSRUTL
DO LOOP
DO QUE1^PRSRUT0
if POP!($DATA(ZTSK))
GOTO Q1
START SET (CNT,POUT,TGOV,TOTAL)=0
KILL ^TMP($JOB)
SET ^TMP($JOB,"EXP")="EMPLOYEE COST FOR PAY PERIOD"
FOR II=1:1:9
SET TOTAL(II)=0
+1 ;
+2 SET DAT=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+3 ;
+4 ;if a single pay period was selected
+5 IF PPE
DO EXP^PRSROSOR
DO IND
DO Q1
QUIT
+6 ;
+7 ;otherwise all pay periods for a year were selected
+8 ;Q if we've gone into next year or end
+9 FOR II=0:0
SET DA(1)=$ORDER(^PRST(459,"B",DA(1)))
if DA(1)=""!($PIECE(DA(1),"-")'=YEAR)
QUIT
Begin DoDot:1
+10 SET DA=0
FOR II=0:0
SET DA=$ORDER(^PRST(459,"B",DA(1),DA))
if DA'>0
QUIT
DO EXP^PRSROSOR
+11 QUIT
End DoDot:1
IND USE IO
IF 'CNT
SET PP=PPE
SET SW(7)=1
SET TLEU=TLE
DO HDR1^PRSREX11
DO VLIN0^PRSREX11
WRITE "|",?10,"No Expenditures on File this Pay Period.",?131,"|"
SET POUT=1
DO NONE
GOTO Q1
+1 DO ^PRSREX11
Q1 KILL %,%DT,FOOT,CODE,TLE,TLUNIT,CNT,COS,COSORG,D0,DA,DAT,DTOUT,POP,DIC,GOV,TGOV,NAM,PP,PPE,PRSAI,PRSR,PRSTLV,STOT
+1 KILL TL,TLI,USR,Z1,I,II,ORG,PRSRDUZ,POUT,SSN,SW,TIME,TOT,TOTAL,X,Y,YEAR,ZTDESC,ZTRTN,ZTSAVE,^TMP($JOB)
DO ^%ZISC
if $DATA(ZTSK)
SET ZTREQ="@"
KILL ZTSK
+2 QUIT
NONE IF IOSL<66
FOR I=$Y:1:IOSL-5
DO VLIN0^PRSREX11
+1 DO HDR^PRSREX11
+2 QUIT
MSG WRITE !,"Enter Numeric Digit, 1 thru 26 or Return/Enter for All Pay Periods."
GOTO ASK1
MSG1 WRITE !!,*7,"*** Pay Period ",PPE," Year ",YEAR," not found in File."
GOTO ASK1
MSG2 WRITE !!,*7,"*** Enter Year: 92 , 1994 ... "
GOTO ASK
MSG3 WRITE !!,*7,"*** Year Entered is not on File."
GOTO ASK
MSG4 READ !!,"Press Return/Enter to continue. ",X:DTIME
GOTO Q1
LOOP FOR X="DA*","TLE*","TLI","TLUNIT","DT","ORG","PPE","YEAR","SW"
SET ZTSAVE(X)=""
+1 QUIT
