- PRSAPPQ ; HISC/REL-Display Time Data for Prior Pay Periods ;11/29/95 13:44
- ;;4.0;PAID;**6,132**;Sep 21, 1995;Build 13
- DIS W !!,?7,"Date",?17,"TW Scheduled Tour",?46,"Tour Exceptions"
- F0 ; Display Frames
- N Y8
- K Y1,Y2 S Y1=AUR(2),Y2=AUR(3),Y3=AUR(5),Y4=AUR(6),TC=$P(AUR(1),"^",2),Y8=$G(AUR(7))
- I Y1="" S Y1=$S(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
- I " 1 3 4 "'[TC,$P(AUR(4),"^",1)="" S Y2(1)="Unposted"
- I TC=3,$P(AUR(4),"^",4)=1 S Y2(1)="Day Worked"
- W !?3,DTE S (L3,L4)=0 I Y1="",Y2="" G EX
- D S1
- F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) W:K>1 ! W:$D(Y1(K)) ?17,$P($G(Y8),U),?21,Y1(K) W:$D(Y2(K)) ?45,$P(Y2(K),"^",1),?63,$P(Y2(K),"^",2)
- W:Y3'="" !?10,Y3
- EX 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 S8
- .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)
- .QUIT
- QUIT
- ;
- S8 ;telweork hours of node 8
- F L1=2,3,4 I $P(Y8,U,L1) S L4=L4+1,Y2(L4)=$J($P(Y8,U,L1),0,2)_" "_$S(TC=2!(TC=3):"Day",1:"Hrs")_" - Telework "_$P("REG^MED^Ad Hoc",U,L1-1)
- QUIT
- ;
- VCS ; Display VCS Sales/Fee Basis
- S PAYP=$P($G(^PRSPC(DFN,0)),"^",21) W !!?30,$S(PAYP="F":"Fee Basis Appointee",1:"VCS Commission Sales")
- W !?11,"Sun Mon Tue Wed Thu Fri Sat Total",!
- W !,"Week 1" S VS=0,L1=1 F K=1:1:7 S L1=L1+8,Z1=$P(Z,"^",K) I Z1'="" S VS=VS+Z1 W ?L1,$J(Z1,7,2)
- W ?63,$J(VS,9,2)
- W !,"Week 2" S VS=0,L1=1 F K=8:1:14 S L1=L1+8,Z1=$P(Z,"^",K) I Z1'="" S VS=VS+Z1 W ?L1,$J(Z1,7,2)
- W ?63,$J(VS,9,2)
- I PAYP="F" W !! F K=19:1:21 S Z1=$P(Z,"^",K) W "Total ",$P("Hours Days Procedures"," ",K-18),": ",Z1," "
- Q
- ED ; Display Envir. Diff.
- W !!?26,"Environmental Differentials",!
- S Y="" F K=1:2:5 S Z1=$P(Z,"^",K) Q:'Z1 S:Y'="" Y=Y_"; " S Y=Y_$P($G(^PRST(457.6,+Z1,0)),"^",1)_" ( "_$P($G(^(0)),"^",3)_" % ) "_$P(Z,"^",K+1)_" Hrs."
- I Y'="" W !,"Week 1: ",Y
- S Y="" F K=7:2:11 S Z1=$P(Z,"^",K) Q:'Z1 S:Y'="" Y=Y_"; " S Y=Y_$P($G(^PRST(457.6,+Z1,0)),"^",1)_" ( "_$P($G(^(0)),"^",3)_" % ) "_$P(Z,"^",K+1)_" Hrs."
- I Y'="" W !,"Week 2: ",Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPPQ 2701 printed Feb 18, 2025@23:50:29 Page 2
- PRSAPPQ ; HISC/REL-Display Time Data for Prior Pay Periods ;11/29/95 13:44
- +1 ;;4.0;PAID;**6,132**;Sep 21, 1995;Build 13
- DIS WRITE !!,?7,"Date",?17,"TW Scheduled Tour",?46,"Tour Exceptions"
- F0 ; Display Frames
- +1 NEW Y8
- +2 KILL Y1,Y2
- SET Y1=AUR(2)
- SET Y2=AUR(3)
- SET Y3=AUR(5)
- SET Y4=AUR(6)
- SET TC=$PIECE(AUR(1),"^",2)
- SET Y8=$GET(AUR(7))
- +3 IF Y1=""
- SET Y1=$SELECT(TC=1:"Day Off",TC=2:"Day Tour",TC=3!(TC=4):"Intermittent",1:"")
- +4 IF " 1 3 4 "'[TC
- IF $PIECE(AUR(4),"^",1)=""
- SET Y2(1)="Unposted"
- +5 IF TC=3
- IF $PIECE(AUR(4),"^",4)=1
- SET Y2(1)="Day Worked"
- +6 WRITE !?3,DTE
- SET (L3,L4)=0
- IF Y1=""
- IF Y2=""
- GOTO EX
- +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 ?17,$PIECE($GET(Y8),U),?21,Y1(K)
- if $DATA(Y2(K))
- WRITE ?45,$PIECE(Y2(K),"^",1),?63,$PIECE(Y2(K),"^",2)
- +9 if Y3'=""
- WRITE !?10,Y3
- EX 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 S8
- +7 QUIT
- +8 ;
- S8 ;telweork hours of node 8
- +1 FOR L1=2,3,4
- IF $PIECE(Y8,U,L1)
- SET L4=L4+1
- SET Y2(L4)=$JUSTIFY($PIECE(Y8,U,L1),0,2)_" "_$SELECT(TC=2!(TC=3):"Day",1:"Hrs")_" - Telework "_$PIECE("REG^MED^Ad Hoc",U,L1-1)
- +2 QUIT
- +3 ;
- VCS ; Display VCS Sales/Fee Basis
- +1 SET PAYP=$PIECE($GET(^PRSPC(DFN,0)),"^",21)
- WRITE !!?30,$SELECT(PAYP="F":"Fee Basis Appointee",1:"VCS Commission Sales")
- +2 WRITE !?11,"Sun Mon Tue Wed Thu Fri Sat Total",!
- +3 WRITE !,"Week 1"
- SET VS=0
- SET L1=1
- FOR K=1:1:7
- SET L1=L1+8
- SET Z1=$PIECE(Z,"^",K)
- IF Z1'=""
- SET VS=VS+Z1
- WRITE ?L1,$JUSTIFY(Z1,7,2)
- +4 WRITE ?63,$JUSTIFY(VS,9,2)
- +5 WRITE !,"Week 2"
- SET VS=0
- SET L1=1
- FOR K=8:1:14
- SET L1=L1+8
- SET Z1=$PIECE(Z,"^",K)
- IF Z1'=""
- SET VS=VS+Z1
- WRITE ?L1,$JUSTIFY(Z1,7,2)
- +6 WRITE ?63,$JUSTIFY(VS,9,2)
- +7 IF PAYP="F"
- WRITE !!
- FOR K=19:1:21
- SET Z1=$PIECE(Z,"^",K)
- WRITE "Total ",$PIECE("Hours Days Procedures"," ",K-18),": ",Z1," "
- +8 QUIT
- ED ; Display Envir. Diff.
- +1 WRITE !!?26,"Environmental Differentials",!
- +2 SET Y=""
- FOR K=1:2:5
- SET Z1=$PIECE(Z,"^",K)
- if 'Z1
- QUIT
- if Y'=""
- SET Y=Y_"; "
- SET Y=Y_$PIECE($GET(^PRST(457.6,+Z1,0)),"^",1)_" ( "_$PIECE($GET(^(0)),"^",3)_" % ) "_$PIECE(Z,"^",K+1)_" Hrs."
- +3 IF Y'=""
- WRITE !,"Week 1: ",Y
- +4 SET Y=""
- FOR K=7:2:11
- SET Z1=$PIECE(Z,"^",K)
- if 'Z1
- QUIT
- if Y'=""
- SET Y=Y_"; "
- SET Y=Y_$PIECE($GET(^PRST(457.6,+Z1,0)),"^",1)_" ( "_$PIECE($GET(^(0)),"^",3)_" % ) "_$PIECE(Z,"^",K+1)_" Hrs."
- +5 IF Y'=""
- WRITE !,"Week 2: ",Y
- +6 QUIT