- PRSRLSOR ;HISC/JH,WIRMFO/JAH-LEAVE REPORT SORTS ;7/8/97
- ;;4.0;PAID;**16,17,26**;Sep 21, 1995
- REQ ; find employee leave requests within specified period
- ; input
- ; D0 - employee ien (file 450)
- ; NAM - employee name
- ; FR - specified FR date
- ; TO - specified TO date
- ; CNT
- ; output
- ; ^TMP($J,"REQ",request from date, employee name, request ien)=data
- ; CNT
- ; get cost center/org code (ccoc) from employee record
- S ORG=$$CCORG^PRSRUTL(PRSRY1)
- ; send bulletin to G.PAD if ORG description missing, but continue.
- I +ORG>0 D CCORGBUL^PRSRUTL(ORG,PRSRDUZ,1,$P(PRSRY,"^",2))
- ; loop thru employee requests in reverse chrono by request's TO DATE
- ; quit loop when earlier than specified FROM DATE
- S DTI("Q")=9999999-FR
- S DTI=0 F S DTI=$O(^PRST(458.1,"AD",D0,DTI)) Q:DTI>DTI("Q")!(DTI="") D
- . S DA=0 F S DA=$O(^PRST(458.1,"AD",D0,DTI,DA)) Q:'DA D
- . . S Z=$G(^PRST(458.1,DA,0)) Q:Z=""
- . . Q:$P(Z,U,3)>TO!($P(Z,U,3)="") ; exclude: after specified date range
- . . Q:"DX"[$P(Z,U,9) ; exclude: status disapproved or canceled
- . . S X=$P(Z,U,7),%=$F(LVT,";"_X_":"),X(1)=$S(%>0:$P($E(LVT,%,999),";"),1:"")
- . . S X=$P(Z,U,9),%=$F(LVS,";"_X_":"),X(2)=$S(%>0:$P($E(LVS,%,999),";"),1:"")
- . . S ^TMP($J,"REQ",$P(Z,U,3),NAM,DA)=$P(Z,U,4)_U_$P(Z,U,6)_U_$P(Z,U,5)_U_X(1)_U_X(2)_U_$P(Z,U,11)_U_$P(Z,U,13)_U_$P(Z,U,12)_U_$P(Z,U,15,16)
- . . S CNT=CNT+1 I '(CNT#30),$E(IOST,1,2)="C-",'$D(ZTQUEUED) W "."
- Q
- ;
- USE I SW S DA(4)=0 F I=0:0 S DA(4)=$O(TLE(DA(4))) Q:DA(4)'>0 S DA(3)=0 F S DA(3)=$O(TLE(DA(4),DA(3))) Q:DA(3)'>0 S D0=$P(TLE(DA(4),DA(3)),U) 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),$P(TLE(DA(4),DA(3)),U,2),SSN,D0,CNT)=TOUR W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
- . Q
- I 'SW S DAY=$P($G(^PRST(458,DA(1),2)),"^",DA) Q:DAY="" 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,$P(DA(2),"-",2),$P(DATES,"^",DA),DAY)=TOUR W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSRLSOR 2330 printed Mar 13, 2025@21:33:37 Page 2
- PRSRLSOR ;HISC/JH,WIRMFO/JAH-LEAVE REPORT SORTS ;7/8/97
- +1 ;;4.0;PAID;**16,17,26**;Sep 21, 1995
- REQ ; find employee leave requests within specified period
- +1 ; input
- +2 ; D0 - employee ien (file 450)
- +3 ; NAM - employee name
- +4 ; FR - specified FR date
- +5 ; TO - specified TO date
- +6 ; CNT
- +7 ; output
- +8 ; ^TMP($J,"REQ",request from date, employee name, request ien)=data
- +9 ; CNT
- +10 ; get cost center/org code (ccoc) from employee record
- +11 SET ORG=$$CCORG^PRSRUTL(PRSRY1)
- +12 ; send bulletin to G.PAD if ORG description missing, but continue.
- +13 IF +ORG>0
- DO CCORGBUL^PRSRUTL(ORG,PRSRDUZ,1,$PIECE(PRSRY,"^",2))
- +14 ; loop thru employee requests in reverse chrono by request's TO DATE
- +15 ; quit loop when earlier than specified FROM DATE
- +16 SET DTI("Q")=9999999-FR
- +17 SET DTI=0
- FOR
- SET DTI=$ORDER(^PRST(458.1,"AD",D0,DTI))
- if DTI>DTI("Q")!(DTI="")
- QUIT
- Begin DoDot:1
- +18 SET DA=0
- FOR
- SET DA=$ORDER(^PRST(458.1,"AD",D0,DTI,DA))
- if 'DA
- QUIT
- Begin DoDot:2
- +19 SET Z=$GET(^PRST(458.1,DA,0))
- if Z=""
- QUIT
- +20 ; exclude: after specified date range
- if $PIECE(Z,U,3)>TO!($PIECE(Z,U,3)="")
- QUIT
- +21 ; exclude: status disapproved or canceled
- if "DX"[$PIECE(Z,U,9)
- QUIT
- +22 SET X=$PIECE(Z,U,7)
- SET %=$FIND(LVT,";"_X_":")
- SET X(1)=$SELECT(%>0:$PIECE($EXTRACT(LVT,%,999),";"),1:"")
- +23 SET X=$PIECE(Z,U,9)
- SET %=$FIND(LVS,";"_X_":")
- SET X(2)=$SELECT(%>0:$PIECE($EXTRACT(LVS,%,999),";"),1:"")
- +24 SET ^TMP($JOB,"REQ",$PIECE(Z,U,3),NAM,DA)=$PIECE(Z,U,4)_U_$PIECE(Z,U,6)_U_$PIECE(Z,U,5)_U_X(1)_U_X(2)_U_$PIECE(Z,U,11)_U_$PIECE(Z,U,13)_U_$PIECE(Z,U,12)_U_$PIECE(Z,U,15,16)
- +25 SET CNT=CNT+1
- IF '(CNT#30)
- IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- WRITE "."
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- USE IF SW
- SET DA(4)=0
- FOR I=0:0
- SET DA(4)=$ORDER(TLE(DA(4)))
- if DA(4)'>0
- QUIT
- SET DA(3)=0
- FOR
- SET DA(3)=$ORDER(TLE(DA(4),DA(3)))
- if DA(3)'>0
- QUIT
- SET D0=$PIECE(TLE(DA(4),DA(3)),U)
- Begin DoDot:1
- +1 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
- +2 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),$PIECE(TLE(DA(4),DA(3)),U,2),SSN,D0,CNT)=TOUR
- if '$DATA(ZTSK)&($EXTRACT(IOST)'="P")&($RANDOM(30))
- WRITE "."
- +3 QUIT
- End DoDot:1
- +4 IF 'SW
- SET DAY=$PIECE($GET(^PRST(458,DA(1),2)),"^",DA)
- if DAY=""
- QUIT
- Begin DoDot:1
- +5 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
- +6 SET CNT=CNT+1
- SET ^TMP($JOB,"USE",CNT,$PIECE(DA(2),"-",2),$PIECE(DATES,"^",DA),DAY)=TOUR
- if '$DATA(ZTSK)&($EXTRACT(IOST)'="P")&($RANDOM(30))
- WRITE "."
- +7 QUIT
- End DoDot:1
- +8 QUIT
