ECTP1TL ;B'ham ISC/PTD-PAID Data for One T&L Unit ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
I '$O(^PRST(455,0)) W *7,!!,"'Payperiod 8B' File - #455 has not been populated on your system.",!! S XQUIT="" Q
DIC W !! S DIC="^PRST(455.5,",DIC(0)="QEANMZ",DIC("A")="Select T&L Unit: ",DIC("W")="I $P(^PRST(455.5,Y,0),U,2)'="""" W "" "",$P(^(0),U,2)" D ^DIC K DIC G:Y<0 EXIT^ECTP1TL1 S TLDA=+Y,TLNM=$P(Y(0),"^",2),TLPTR=Y(0,0)
S FST=$O(^PRST(455,0)) W !!,"The earliest pay period/date in the file is: "_$E(FST,4,5)_" - '"_$E(FST,2,3)
W !,"You may select the pay period/date RANGE:",!
BPP R !,"Enter BEGINNING Pay Period: ",BPP:DTIME G:'$T!("^"[BPP) EXIT^ECTP1TL1 I (BPP'?.N)!(BPP<1)!(BPP>27) W !!,"You MUST answer with a number between 1 and 27." G BPP
S:$L(BPP)=1 BPP="0"_BPP
BYR W ! S %DT="AE",%DT("A")="Enter calendar year associated with BEGINNING pay period: ",%DT(0)=2000000 D ^%DT G:$D(DTOUT)!("^"[X) EXIT^ECTP1TL1 S BYR=$E(Y,1,3),BYRPP=BYR_BPP
EPP R !!,"Enter ENDING Pay Period: ",EPP:DTIME G:'$T!("^"[EPP) EXIT^ECTP1TL1 I (EPP'?.N)!(EPP<1)!(EPP>27) W !!,"You MUST answer with a number between 1 and 27." G EPP
S:$L(EPP)=1 EPP="0"_EPP
EYR W ! S %DT="AE",%DT("A")="Enter calendar year associated with ENDING pay period: ",%DT(0)=BYR_"0000" D ^%DT G:$D(DTOUT)!("^"[X) EXIT^ECTP1TL1 S EYR=$E(Y,1,3),EYRPP=EYR_EPP
I +BYRPP>+EYRPP W *7,!!?10,"ENDING pay period/date must be equal to",!?10,"or come after BEGINNING pay period/date!",!! K BPP,BYR,BYRPP,EPP,EYR,EYRPP G BPP
PP S FLG=0,YP=(BYRPP-1) F J=0:0 S YP=$O(^PRST(455,"B",YP)) Q:'YP Q:YP>EYRPP S FLG=1 Q:FLG=1
I FLG=0 W *7,!!,"There is NO DATA in the file for the selected date range!",!! G EXIT^ECTP1TL1
DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G EXIT^ECTP1TL1
I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^ECTP1TL0",ZTDESC="PAID Data for One T&L Unit" F G="TLDA","TLNM","TLPTR","BYRPP","BYR","BPP","EYRPP","EYR","EPP" S:$D(@G) ZTSAVE(G)=""
I D ^%ZTLOAD K ZTSK G EXIT^ECTP1TL1
U IO G ^ECTP1TL0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTP1TL 2041 printed Nov 22, 2024@17:12:39 Page 2
ECTP1TL ;B'ham ISC/PTD-PAID Data for One T&L Unit ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
+1 IF '$ORDER(^PRST(455,0))
WRITE *7,!!,"'Payperiod 8B' File - #455 has not been populated on your system.",!!
SET XQUIT=""
QUIT
DIC WRITE !!
SET DIC="^PRST(455.5,"
SET DIC(0)="QEANMZ"
SET DIC("A")="Select T&L Unit: "
SET DIC("W")="I $P(^PRST(455.5,Y,0),U,2)'="""" W "" "",$P(^(0),U,2)"
DO ^DIC
KILL DIC
if Y<0
GOTO EXIT^ECTP1TL1
SET TLDA=+Y
SET TLNM=$PIECE(Y(0),"^",2)
SET TLPTR=Y(0,0)
+1 SET FST=$ORDER(^PRST(455,0))
WRITE !!,"The earliest pay period/date in the file is: "_$EXTRACT(FST,4,5)_" - '"_$EXTRACT(FST,2,3)
+2 WRITE !,"You may select the pay period/date RANGE:",!
BPP READ !,"Enter BEGINNING Pay Period: ",BPP:DTIME
if '$TEST!("^"[BPP)
GOTO EXIT^ECTP1TL1
IF (BPP'?.N)!(BPP<1)!(BPP>27)
WRITE !!,"You MUST answer with a number between 1 and 27."
GOTO BPP
+1 if $LENGTH(BPP)=1
SET BPP="0"_BPP
BYR WRITE !
SET %DT="AE"
SET %DT("A")="Enter calendar year associated with BEGINNING pay period: "
SET %DT(0)=2000000
DO ^%DT
if $DATA(DTOUT)!("^"[X)
GOTO EXIT^ECTP1TL1
SET BYR=$EXTRACT(Y,1,3)
SET BYRPP=BYR_BPP
EPP READ !!,"Enter ENDING Pay Period: ",EPP:DTIME
if '$TEST!("^"[EPP)
GOTO EXIT^ECTP1TL1
IF (EPP'?.N)!(EPP<1)!(EPP>27)
WRITE !!,"You MUST answer with a number between 1 and 27."
GOTO EPP
+1 if $LENGTH(EPP)=1
SET EPP="0"_EPP
EYR WRITE !
SET %DT="AE"
SET %DT("A")="Enter calendar year associated with ENDING pay period: "
SET %DT(0)=BYR_"0000"
DO ^%DT
if $DATA(DTOUT)!("^"[X)
GOTO EXIT^ECTP1TL1
SET EYR=$EXTRACT(Y,1,3)
SET EYRPP=EYR_EPP
+1 IF +BYRPP>+EYRPP
WRITE *7,!!?10,"ENDING pay period/date must be equal to",!?10,"or come after BEGINNING pay period/date!",!!
KILL BPP,BYR,BYRPP,EPP,EYR,EYRPP
GOTO BPP
PP SET FLG=0
SET YP=(BYRPP-1)
FOR J=0:0
SET YP=$ORDER(^PRST(455,"B",YP))
if 'YP
QUIT
if YP>EYRPP
QUIT
SET FLG=1
if FLG=1
QUIT
+1 IF FLG=0
WRITE *7,!!,"There is NO DATA in the file for the selected date range!",!!
GOTO EXIT^ECTP1TL1
DEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO EXIT^ECTP1TL1
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENQ^ECTP1TL0"
SET ZTDESC="PAID Data for One T&L Unit"
FOR G="TLDA","TLNM","TLPTR","BYRPP","BYR","BPP","EYRPP","EYR","EPP"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 IF $TEST
DO ^%ZTLOAD
KILL ZTSK
GOTO EXIT^ECTP1TL1
+3 USE IO
GOTO ^ECTP1TL0
+4 ;
