- PRSROSOR ;HISC/JH - SORT FOR OT/CT & EXPENDITURE REPORTS ;11/18/98
- ;;4.0;PAID;**2,26,46,154**;Sep 21, 1995;Build 2
- OTCT ;Over Time & Comp Time Sort
- S X=$E($P($G(^PRST(458,DA(3),"E",D0,5)),"^"),22,24) D:$P(TLE(1),"^")=X
- . S TLUNIT=$P($G(^PRSPC(D0,0)),U,7),SSN=$P($G(^(0)),U,9) I SSN'="" S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
- . S COMP=$P($G(^PRST(459,DA(1),"P",D0,4)),"^",3),COMPU=$P($G(^PRST(459,DA(1),"P",D0,4)),"^",4),OTH=$P($G(^PRST(459,DA(1),"P",D0,5)),"^",15)
- . S SAL=$P($G(^PRST(459,DA(1),"P",D0,5)),"^"),OTP=$P($G(^(5)),"^",14),DA(4)=$P(DA(2),"-",2)
- . Q:'(COMP!(OTH)) S ^TMP($J,"OT/CP",DA(2),DATE,$P(TLE(1),"^"),NAM,D0)=SSN_"^"_SAL_"^"_COMP_"^"_COMPU_"^"_OTH_"^"_OTP,CNT=CNT+1 W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
- . Q
- Q
- EXP ;Expenditure Sort
- S (TL,GOV,STOT,TOT)=0,U="^",TLE=$P(TLE(1),U)
- ;S DA(3)=$O(^PRST(458,"B",DA(1),0)) Q:DA(3)'>0 D
- ;. S D0=0 F S D0=$O(^PRST(458,DA(3),"E",D0)) Q:D0'>0 S X=$E($P($G(^PRST(458,DA(3),"E",D0,5)),U),22,24) D:TLE=X
- ;*154 - removed checks on 458, no longer used after VATAS. Check t&l in file 459 instead.
- S D0=0 F S D0=$O(^PRST(459,DA,"P",D0)) Q:D0'>0 S X=$P($G(^PRST(459,DA,"P",D0,0)),U,13) D:TLE=X
- .; skip employee if there is no expenditure data for them
- . Q:'($G(^PRST(459,DA,"P",D0,5))!$G(^(8)))
- .;
- . S NAM=$P($G(^PRSPC(D0,0)),U),TOT(1)=$P($G(^PRST(459,DA,"P",D0,5)),U,5),TOT(2)=$P($G(^(5)),U,10),TOT(3)=$P($G(^(5)),U,8),TOT(4)=$P($G(^(5)),U,14)
- . S TOT(5)=$P($G(^PRST(459,DA,"P",D0,5)),U,19),TOT(6)=$P($G(^(5)),U,13),TOT(7)=$P($G(^(5)),U,24)+$P($G(^(5)),U,25)+$P($G(^(5)),U,31),TOT(8)=$P($G(^(5)),U,4),TOT(9)=$P($G(^(5)),U,17)
- . F I=1:1:9 S TOTAL(I)=TOTAL(I)+TOT(I),$P(STOT,U,I)=$P(STOT,U,I)+TOT(I)
- . S TOT=$P($G(^PRST(459,DA,"P",D0,5)),U)
- . S GOV(1)=$P($G(^PRST(459,DA,"P",D0,8)),U),GOV=GOV(1)-TOT
- . S TOTAL=TOTAL+TOT,TGOV=TGOV+GOV,$P(STOT,U,10)=$P(STOT,U,10)+TOT,$P(STOT,U,11)=$P(STOT,U,11)+GOV,$P(STOT,U,12)=$P(STOT,U,12)+(TOT+GOV)
- . S ^TMP($J,"EXP",+$P(DA(1),"-",2),TLE,NAM,D0)=TOT(1)_U_TOT(2)_U_TOT(3)_U_TOT(4)_U_TOT(5)_U_TOT(6)_U_TOT(7)_U_TOT(8)_U_TOT(9)_U_TOT_U_GOV_U_(TOT+GOV)
- . S CNT=CNT+1,(GOV,TOT)=0
- . I '(CNT#30),$E(IOST,1,2)="C-",'$D(ZTQUEUED) W "."
- . Q
- S ^TMP($J,"EXP1",+$P(DA(1),"-",2),TLE)=STOT,STOT=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSROSOR 2252 printed Feb 18, 2025@23:55:07 Page 2
- PRSROSOR ;HISC/JH - SORT FOR OT/CT & EXPENDITURE REPORTS ;11/18/98
- +1 ;;4.0;PAID;**2,26,46,154**;Sep 21, 1995;Build 2
- OTCT ;Over Time & Comp Time Sort
- +1 SET X=$EXTRACT($PIECE($GET(^PRST(458,DA(3),"E",D0,5)),"^"),22,24)
- if $PIECE(TLE(1),"^")=X
- Begin DoDot:1
- +2 SET TLUNIT=$PIECE($GET(^PRSPC(D0,0)),U,7)
- SET SSN=$PIECE($GET(^(0)),U,9)
- IF SSN'=""
- SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
- +3 SET COMP=$PIECE($GET(^PRST(459,DA(1),"P",D0,4)),"^",3)
- SET COMPU=$PIECE($GET(^PRST(459,DA(1),"P",D0,4)),"^",4)
- SET OTH=$PIECE($GET(^PRST(459,DA(1),"P",D0,5)),"^",15)
- +4 SET SAL=$PIECE($GET(^PRST(459,DA(1),"P",D0,5)),"^")
- SET OTP=$PIECE($GET(^(5)),"^",14)
- SET DA(4)=$PIECE(DA(2),"-",2)
- +5 if '(COMP!(OTH))
- QUIT
- SET ^TMP($JOB,"OT/CP",DA(2),DATE,$PIECE(TLE(1),"^"),NAM,D0)=SSN_"^"_SAL_"^"_COMP_"^"_COMPU_"^"_OTH_"^"_OTP
- SET CNT=CNT+1
- if '$DATA(ZTSK)&($EXTRACT(IOST)'="P")&($RANDOM(30))
- WRITE "."
- +6 QUIT
- End DoDot:1
- +7 QUIT
- EXP ;Expenditure Sort
- +1 SET (TL,GOV,STOT,TOT)=0
- SET U="^"
- SET TLE=$PIECE(TLE(1),U)
- +2 ;S DA(3)=$O(^PRST(458,"B",DA(1),0)) Q:DA(3)'>0 D
- +3 ;. S D0=0 F S D0=$O(^PRST(458,DA(3),"E",D0)) Q:D0'>0 S X=$E($P($G(^PRST(458,DA(3),"E",D0,5)),U),22,24) D:TLE=X
- +4 ;*154 - removed checks on 458, no longer used after VATAS. Check t&l in file 459 instead.
- +5 SET D0=0
- FOR
- SET D0=$ORDER(^PRST(459,DA,"P",D0))
- if D0'>0
- QUIT
- SET X=$PIECE($GET(^PRST(459,DA,"P",D0,0)),U,13)
- if TLE=X
- Begin DoDot:1
- +6 ; skip employee if there is no expenditure data for them
- +7 if '($GET(^PRST(459,DA,"P",D0,5))!$GET(^(8)))
- QUIT
- +8 ;
- +9 SET NAM=$PIECE($GET(^PRSPC(D0,0)),U)
- SET TOT(1)=$PIECE($GET(^PRST(459,DA,"P",D0,5)),U,5)
- SET TOT(2)=$PIECE($GET(^(5)),U,10)
- SET TOT(3)=$PIECE($GET(^(5)),U,8)
- SET TOT(4)=$PIECE($GET(^(5)),U,14)
- +10 SET TOT(5)=$PIECE($GET(^PRST(459,DA,"P",D0,5)),U,19)
- SET TOT(6)=$PIECE($GET(^(5)),U,13)
- SET TOT(7)=$PIECE($GET(^(5)),U,24)+$PIECE($GET(^(5)),U,25)+$PIECE($GET(^(5)),U,31)
- SET TOT(8)=$PIECE($GET(^(5)),U,4)
- SET TOT(9)=$PIECE($GET(^(5)),U,17)
- +11 FOR I=1:1:9
- SET TOTAL(I)=TOTAL(I)+TOT(I)
- SET $PIECE(STOT,U,I)=$PIECE(STOT,U,I)+TOT(I)
- +12 SET TOT=$PIECE($GET(^PRST(459,DA,"P",D0,5)),U)
- +13 SET GOV(1)=$PIECE($GET(^PRST(459,DA,"P",D0,8)),U)
- SET GOV=GOV(1)-TOT
- +14 SET TOTAL=TOTAL+TOT
- SET TGOV=TGOV+GOV
- SET $PIECE(STOT,U,10)=$PIECE(STOT,U,10)+TOT
- SET $PIECE(STOT,U,11)=$PIECE(STOT,U,11)+GOV
- SET $PIECE(STOT,U,12)=$PIECE(STOT,U,12)+(TOT+GOV)
- +15 SET ^TMP($JOB,"EXP",+$PIECE(DA(1),"-",2),TLE,NAM,D0)=TOT(1)_U_TOT(2)_U_TOT(3)_U_TOT(4)_U_TOT(5)_U_TOT(6)_U_TOT(7)_U_TOT(8)_U_TOT(9)_U_TOT_U_GOV_U_(TOT+GOV)
- +16 SET CNT=CNT+1
- SET (GOV,TOT)=0
- +17 IF '(CNT#30)
- IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- WRITE "."
- +18 QUIT
- End DoDot:1
- +19 SET ^TMP($JOB,"EXP1",+$PIECE(DA(1),"-",2),TLE)=STOT
- SET STOT=0
- +20 QUIT