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 Dec 13, 2024@02:28:35 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
