PRSATPL ; HISC/REL-Daily T&L Listing ;3/23/94 09:38
;;4.0;PAID;;Sep 21, 1995
TK ; Timekeeper Entry
S PRSTLV=2 G TL
PAY ; Payroll Entry
S PRSTLV=7 G TL
TL D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT
S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT
G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
I $D(IO("Q")) S PRSAPGM="Q1^PRSATPL",PRSALST="TLE^PPI^DAY" D QUE^PRSAUTL G EX
U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
Q1 ; Process
S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY)
S (QT,PG)=0 D HDR
S NN="" F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 I $D(^PRST(458,PPI,"E",DFN,0)) D CHK I QT G EX
D H1 G EX
CHK ; List Employee Day
D:$Y>(IOSL-5) HDR Q:QT
K Y1,Y2 S Y1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,1)),Y2=$G(^(2)),Y3=$G(^(3)),Y4=$G(^(4)),TC=$P($G(^(0)),"^",2)
I Y1="" S Y1=$S(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"NO TOUR ENTERED")
I " 1 3 4 "'[TC,$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)="" S Y2(1)="Unposted"
I TC=3,$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",4)=1 S Y2(1)="Day Worked"
W !!,$E($P($G(^PRSPC(DFN,0)),"^",1),1,25) S (L3,L4)=0 I Y1="",Y2="" Q
D S1
F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) W:K>1 ! W:$D(Y1(K)) ?27,Y1(K) W:$D(Y2(K)) ?52,$P(Y2(K),"^",1),?69,$P(Y2(K),"^",2)
W:Y3'="" !?10,Y3 Q
S1 ; Set Schedule Array
F L1=1:3:19 S A1=$P(Y1,"^",L1) Q:A1="" S L3=L3+1,Y1(L3)=A1 S:$P(Y1,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y1,"^",L1+1) I $P(Y1,"^",L1+2)'="" S L3=L3+1,Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
G:Y4="" S2
F L1=1:3:19 S A1=$P(Y4,"^",L1) Q:A1="" S L3=L3+1,Y1(L3)=A1 S:$P(Y4,"^",L1+1)'="" Y1(L3)=Y1(L3)_"-"_$P(Y4,"^",L1+1) I $P(Y4,"^",L1+2)'="" S L3=L3+1,Y1(L3)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
S2 ; Set Worked Array
F L1=1:4:25 D I A1="" G S3
.S A1=$P(Y2,"^",L1+2) Q:A1="" S L4=L4+1
.S A2=$P(Y2,"^",L1) I A2'="" S Y2(L4)=A2_"-"_$P(Y2,"^",L1+1)
.S K=$O(^PRST(457.3,"B",A1,0)) S $P(Y2(L4),"^",2)=A1_" "_$P($G(^PRST(457.3,+K,0)),"^",2)
.I $P(Y2,"^",L1+3)'="" S L4=L4+1,Y2(L4)=" "_$P($G(^PRST(457.4,+$P(Y2,"^",L1+3),0)),"^",1)
.Q
S3 Q
HDR ; Display Header
D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
S PG=PG+1 W !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
W !?27,DTE," for T&L ",TLE
W !!,"Employee",?27,"Scheduled Tour",?52,"Tour Exceptions"
W !,"------------------------------------------------------------------------------"
Q
H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
Q
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATPL 2796 printed Nov 22, 2024@17:34:54 Page 2
PRSATPL ; HISC/REL-Daily T&L Listing ;3/23/94 09:38
+1 ;;4.0;PAID;;Sep 21, 1995
TK ; Timekeeper Entry
+1 SET PRSTLV=2
GOTO TL
PAY ; Payroll Entry
+1 SET PRSTLV=7
GOTO TL
TL DO ^PRSAUTL
if TLI<1
GOTO EX
SET %DT="X"
SET X="T+3"
DO ^%DT
+1 SET %DT="AEPX"
SET %DT("A")="Posting Date: "
SET %DT("B")="T-1"
SET %DT(0)=-Y
WRITE !
DO ^%DT
+2 if Y<1
GOTO EX
SET D1=Y
SET Y=$GET(^PRST(458,"AD",D1))
SET PPI=$PIECE(Y,"^",1)
SET DAY=$PIECE(Y,"^",2)
+3 IF PPI=""
WRITE !!,*7,"Pay Period is Not Open Yet!"
GOTO EX
+4 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select Device: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO EX
+5 IF $DATA(IO("Q"))
SET PRSAPGM="Q1^PRSATPL"
SET PRSALST="TLE^PPI^DAY"
DO QUE^PRSAUTL
GOTO EX
+6 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
Q1 ; Process
+1 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
SET DTE=$PIECE($GET(^PRST(458,PPI,2)),"^",DAY)
SET DTI=$PIECE($GET(^(1)),"^",DAY)
+2 SET (QT,PG)=0
DO HDR
+3 SET NN=""
FOR
SET NN=$ORDER(^PRSPC("ATL"_TLE,NN))
if NN=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC("ATL"_TLE,NN,DFN))
if DFN<1
QUIT
IF $DATA(^PRST(458,PPI,"E",DFN,0))
DO CHK
IF QT
GOTO EX
+4 DO H1
GOTO EX
CHK ; List Employee Day
+1 if $Y>(IOSL-5)
DO HDR
if QT
QUIT
+2 KILL Y1,Y2
SET Y1=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,1))
SET Y2=$GET(^(2))
SET Y3=$GET(^(3))
SET Y4=$GET(^(4))
SET TC=$PIECE($GET(^(0)),"^",2)
+3 IF Y1=""
SET Y1=$SELECT(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"NO TOUR ENTERED")
+4 IF " 1 3 4 "'[TC
IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)=""
SET Y2(1)="Unposted"
+5 IF TC=3
IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",4)=1
SET Y2(1)="Day Worked"
+6 WRITE !!,$EXTRACT($PIECE($GET(^PRSPC(DFN,0)),"^",1),1,25)
SET (L3,L4)=0
IF Y1=""
IF Y2=""
QUIT
+7 DO S1
+8 FOR K=1:1
if '$DATA(Y1(K))&'$DATA(Y2(K))
QUIT
if K>1
WRITE !
if $DATA(Y1(K))
WRITE ?27,Y1(K)
if $DATA(Y2(K))
WRITE ?52,$PIECE(Y2(K),"^",1),?69,$PIECE(Y2(K),"^",2)
+9 if Y3'=""
WRITE !?10,Y3
QUIT
S1 ; Set Schedule Array
+1 FOR L1=1:3:19
SET A1=$PIECE(Y1,"^",L1)
if A1=""
QUIT
SET L3=L3+1
SET Y1(L3)=A1
if $PIECE(Y1,"^",L1+1)'=""
SET Y1(L3)=Y1(L3)_"-"_$PIECE(Y1,"^",L1+1)
IF $PIECE(Y1,"^",L1+2)'=""
SET L3=L3+1
SET Y1(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y1,"^",L1+2),0)),"^",1)
+2 if Y4=""
GOTO S2
+3 FOR L1=1:3:19
SET A1=$PIECE(Y4,"^",L1)
if A1=""
QUIT
SET L3=L3+1
SET Y1(L3)=A1
if $PIECE(Y4,"^",L1+1)'=""
SET Y1(L3)=Y1(L3)_"-"_$PIECE(Y4,"^",L1+1)
IF $PIECE(Y4,"^",L1+2)'=""
SET L3=L3+1
SET Y1(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y4,"^",L1+2),0)),"^",1)
S2 ; Set Worked Array
+1 FOR L1=1:4:25
Begin DoDot:1
+2 SET A1=$PIECE(Y2,"^",L1+2)
if A1=""
QUIT
SET L4=L4+1
+3 SET A2=$PIECE(Y2,"^",L1)
IF A2'=""
SET Y2(L4)=A2_"-"_$PIECE(Y2,"^",L1+1)
+4 SET K=$ORDER(^PRST(457.3,"B",A1,0))
SET $PIECE(Y2(L4),"^",2)=A1_" "_$PIECE($GET(^PRST(457.3,+K,0)),"^",2)
+5 IF $PIECE(Y2,"^",L1+3)'=""
SET L4=L4+1
SET Y2(L4)=" "_$PIECE($GET(^PRST(457.4,+$PIECE(Y2,"^",L1+3),0)),"^",1)
+6 QUIT
End DoDot:1
IF A1=""
GOTO S3
S3 QUIT
HDR ; Display Header
+1 DO H1
if QT
QUIT
if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
+2 SET PG=PG+1
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
+3 WRITE !?27,DTE," for T&L ",TLE
+4 WRITE !!,"Employee",?27,"Scheduled Tour",?52,"Tour Exceptions"
+5 WRITE !,"------------------------------------------------------------------------------"
+6 QUIT
H1 IF PG
IF $EXTRACT(IOST,1,2)="C-"
READ !!,"Press RETURN to Continue.",X:DTIME
if '$TEST!(X["^")
SET QT=1
+1 QUIT
EX GOTO KILL^XUSCLEAN
