- PRSRASOR ;HISC/JH-EMPLOYEE AUDIT SORT ;2/28/95
- ;;4.0;PAID;;Sep 21, 1995
- PP I SW S DA(3)="" F I=0:0 S DA(3)=$O(^PRSPC("ATL"_TLE,DA(3))) Q:DA(3)="" D
- . S D0=0 F I=0:0 S D0=$O(^PRSPC("ATL"_TLE,DA(3),D0)) Q:D0'>0 S DA=0 F I=0:0 S DA=$O(^PRST(458,DA(1),"E",D0,"D",DA)) Q:DA'>0 D
- .. Q:$G(^PRST(458,DA(1),"E",D0,"D",DA,2))="" S TOUR=$G(^PRST(458,DA(1),"E",D0,"D",DA,2)) Q:TOUR="" D CKTOUR^PRSRUT0(.TOUR) Q:TOUR=""
- .. S SSN=$P($G(^PRSPC(D0,0)),U,9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9),CNT=CNT+1,^TMP($J,"USE",DA(2),$P(DATES,"^",DA),DA(3),SSN,D0,CNT)=TOUR W:$E(IOST)="C" "."
- .. Q
- . Q
- I 'SW S DA(2)="" F II=0:0 S DA(2)=$O(^PRST(458,"B",DA(2))) Q:DA(2)="" D
- . S DA(1)=0 F I=0:0 S DA(1)=$O(^PRST(458,"B",DA(2),DA(1))) Q:DA(1)'>0 S DATES=$G(^PRST(458,DA(1),1)) D
- .. S DA=0 F I=0:0 S DA=$O(^PRST(458,DA(1),"E",D0,"D",DA)) Q:DA'>0 S DAY=$P($P(^PRST(458,DA(1),2),"^",DA)," ") D
- ... Q:$G(^PRST(458,DA(1),"E",D0,"D",DA,2))=""!(($P(DATES,"^",DA)<FR)!($P(DATES,"^",DA)>TO)) S TOUR=$G(^PRST(458,DA(1),"E",D0,"D",DA,2)) Q:TOUR="" D CKTOUR^PRSRUT0(.TOUR) Q:TOUR=""
- ... S CNT=CNT+1,^TMP($J,"USE",CNT,DA(2),$P(DATES,"^",DA),DAY)=TOUR
- ... Q
- .. Q
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSRASOR 1192 printed Apr 23, 2025@18:42:55 Page 2
- PRSRASOR ;HISC/JH-EMPLOYEE AUDIT SORT ;2/28/95
- +1 ;;4.0;PAID;;Sep 21, 1995
- PP IF SW
- SET DA(3)=""
- FOR I=0:0
- SET DA(3)=$ORDER(^PRSPC("ATL"_TLE,DA(3)))
- if DA(3)=""
- QUIT
- Begin DoDot:1
- +1 SET D0=0
- FOR I=0:0
- SET D0=$ORDER(^PRSPC("ATL"_TLE,DA(3),D0))
- if D0'>0
- QUIT
- SET DA=0
- FOR I=0:0
- SET DA=$ORDER(^PRST(458,DA(1),"E",D0,"D",DA))
- if DA'>0
- QUIT
- Begin DoDot:2
- +2 if $GET(^PRST(458,DA(1),"E",D0,"D",DA,2))=""
- QUIT
- SET TOUR=$GET(^PRST(458,DA(1),"E",D0,"D",DA,2))
- if TOUR=""
- QUIT
- DO CKTOUR^PRSRUT0(.TOUR)
- if TOUR=""
- QUIT
- +3 SET SSN=$PIECE($GET(^PRSPC(D0,0)),U,9)
- SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
- SET CNT=CNT+1
- SET ^TMP($JOB,"USE",DA(2),$PIECE(DATES,"^",DA),DA(3),SSN,D0,CNT)=TOUR
- if $EXTRACT(IOST)="C"
- WRITE "."
- +4 QUIT
- End DoDot:2
- +5 QUIT
- End DoDot:1
- +6 IF 'SW
- SET DA(2)=""
- FOR II=0:0
- SET DA(2)=$ORDER(^PRST(458,"B",DA(2)))
- if DA(2)=""
- QUIT
- Begin DoDot:1
- +7 SET DA(1)=0
- FOR I=0:0
- SET DA(1)=$ORDER(^PRST(458,"B",DA(2),DA(1)))
- if DA(1)'>0
- QUIT
- SET DATES=$GET(^PRST(458,DA(1),1))
- Begin DoDot:2
- +8 SET DA=0
- FOR I=0:0
- SET DA=$ORDER(^PRST(458,DA(1),"E",D0,"D",DA))
- if DA'>0
- QUIT
- SET DAY=$PIECE($PIECE(^PRST(458,DA(1),2),"^",DA)," ")
- Begin DoDot:3
- +9 if $GET(^PRST(458,DA(1),"E",D0,"D",DA,2))=""!(($PIECE(DATES,"^",DA)<FR)!($PIECE(DATES,"^",DA)>TO))
- QUIT
- SET TOUR=$GET(^PRST(458,DA(1),"E",D0,"D",DA,2))
- if TOUR=""
- QUIT
- DO CKTOUR^PRSRUT0(.TOUR)
- if TOUR=""
- QUIT
- +10 SET CNT=CNT+1
- SET ^TMP($JOB,"USE",CNT,DA(2),$PIECE(DATES,"^",DA),DAY)=TOUR
- +11 QUIT
- End DoDot:3
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 QUIT
