ENPLS1 ;(WASH ISC)/SAB-DETERMINE PROJECTS ON FYFP ;5/24/95
;;7.0;ENGINEERING;**23**;Aug 17, 1993
FYFP(ENSN,ENFY,ENFYB,ENFYE,ENDV,ENRET) ; Five Year Facility Plan Projects
; Selects construction and lease projects which are part of the FYFP
; based on station, funding years, division, and status.
;
; required
; ENSN - station number
; ENFY - current year of FYFP (budget year - 1)
; optional
; ENBYB - beginning offset from current year (default 0)
; ENBYE - ending offset from current year (default F)
; ENDV - division screen or * for all (default *)
; ENRET - contains array code(s) to return (default L)
; L return projects by number
; ^TMP($J,"L")=count^current year of FYFP
; ^TMP($J,"L",number)=ien
; Y return projects in fiscal year format
; ^TMP($J,"Y",fiscal year or "F",program,number)
; =ien^a/e this year^const this year
; E return projects with equipment over $250K
; ^TMP($J,"E",program,fiscal year,number)=ien
N ENC,ENDA,ENIDX,ENPN,ENPR,ENPY,ENSTAT,ENSTC,ENSTL,ENX,ENY0,ENYR
S:$G(ENFYB)="" ENFYB=0
S:$G(ENFYE)="" ENFYE="F"
S:$G(ENDV)="" ENDV="*"
S:$G(ENRET)="" ENRET="L"
I ENRET["L" K ^TMP($J,"L") S ENC=0
I ENRET["Y" K ^TMP($J,"Y")
I ENRET["E" K ^TMP($J,"E")
Q:$G(ENSN)=""
Q:$G(ENFY)=""
I ENFYB="F",ENFYE'="F" Q
I ENFYE'="F",ENFYB>ENFYE Q
; find current and plan year projects
I ENFYB'="F" F ENYR=ENFY+ENFYB:1:ENFY+$S(ENFYE="F":5,1:ENFYE) D
. S ENPY=ENYR
. S ENSTC=$S(ENFY=ENYR:";6;8;9;10;11;12;13;14;15;",ENFY<ENYR:";3;5;6;8;9;10;11;12;",1:"") ; construction status list
. S ENSTL=$S(ENFY=ENYR:"",ENFY<ENYR:";3;5;",1:"") ; lease status list
. F ENIDX="F","G","L" D FYIDX
; find future year projects
I ENFYE="F" S ENPY="F" F ENIDX="F","G","L" D
. S ENSTC=";3;5;6;8;9;10;11;12;" ; construction status list
. S ENSTL=";3;5;" ; lease status list
. S ENYR=ENFY+5
. F S ENYR=$O(^ENG("PROJ",ENIDX,ENYR)) Q:ENYR="" D FYIDX
I ENRET["L",ENC S ^TMP($J,"L")=ENC_U_ENFY
Q
FYIDX ; Get Projects for a Funding Year A/E or CONST or RENT STARTS
S ENDA="" F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:ENDA="" D
. S ENY0=$G(^ENG("PROJ",ENDA,0))
. S ENPN=$P(ENY0,U) I ENPN="" Q
. S ENPR=$P(ENY0,U,6)
. I $P(ENPN,"-")'=ENSN Q
. I "FG"[ENIDX,"^MA^MI^MM^NR^"'[(U_ENPR_U) Q
. I "L"[ENIDX,"^LE^"'[(U_ENPR_U) Q
. I ENDV'="*",ENDV'=$P($G(^ENG("PROJ",ENDA,15)),U) Q
. S ENSTAT=$P($G(^ENG("PROJ",ENDA,1)),U,3)
. I "^MA^MI^MM^NR^"[(U_ENPR_U),ENSTC'[(";"_ENSTAT_";") Q
. I "^LE^"[(U_ENPR_U),ENSTL'[(";"_ENSTAT_";") Q
. I ENRET["L",'$D(^TMP($J,"L",ENPN)) S ^TMP($J,"L",ENPN)=ENDA,ENC=ENC+1
. I ENRET["Y" D
. . S ENX=$G(^TMP($J,"Y",ENPY,ENPR,ENPN))
. . S $P(ENX,U)=ENDA
. . S:ENIDX="F" $P(ENX,U,2)=1
. . S:ENIDX="G" $P(ENX,U,3)=1
. . S ^TMP($J,"Y",ENPY,ENPR,ENPN)=ENX
. I ENRET["E",ENPY'="F",ENFY'=ENYR,"GL"[ENIDX,$O(^ENG("PROJ",ENDA,25,0)) S ^TMP($J,"E",ENPR,ENPY,ENPN)=ENDA
Q
;ENPLS1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPLS1 2970 printed Oct 16, 2024@17:55:47 Page 2
ENPLS1 ;(WASH ISC)/SAB-DETERMINE PROJECTS ON FYFP ;5/24/95
+1 ;;7.0;ENGINEERING;**23**;Aug 17, 1993
FYFP(ENSN,ENFY,ENFYB,ENFYE,ENDV,ENRET) ; Five Year Facility Plan Projects
+1 ; Selects construction and lease projects which are part of the FYFP
+2 ; based on station, funding years, division, and status.
+3 ;
+4 ; required
+5 ; ENSN - station number
+6 ; ENFY - current year of FYFP (budget year - 1)
+7 ; optional
+8 ; ENBYB - beginning offset from current year (default 0)
+9 ; ENBYE - ending offset from current year (default F)
+10 ; ENDV - division screen or * for all (default *)
+11 ; ENRET - contains array code(s) to return (default L)
+12 ; L return projects by number
+13 ; ^TMP($J,"L")=count^current year of FYFP
+14 ; ^TMP($J,"L",number)=ien
+15 ; Y return projects in fiscal year format
+16 ; ^TMP($J,"Y",fiscal year or "F",program,number)
+17 ; =ien^a/e this year^const this year
+18 ; E return projects with equipment over $250K
+19 ; ^TMP($J,"E",program,fiscal year,number)=ien
+20 NEW ENC,ENDA,ENIDX,ENPN,ENPR,ENPY,ENSTAT,ENSTC,ENSTL,ENX,ENY0,ENYR
+21 if $GET(ENFYB)=""
SET ENFYB=0
+22 if $GET(ENFYE)=""
SET ENFYE="F"
+23 if $GET(ENDV)=""
SET ENDV="*"
+24 if $GET(ENRET)=""
SET ENRET="L"
+25 IF ENRET["L"
KILL ^TMP($JOB,"L")
SET ENC=0
+26 IF ENRET["Y"
KILL ^TMP($JOB,"Y")
+27 IF ENRET["E"
KILL ^TMP($JOB,"E")
+28 if $GET(ENSN)=""
QUIT
+29 if $GET(ENFY)=""
QUIT
+30 IF ENFYB="F"
IF ENFYE'="F"
QUIT
+31 IF ENFYE'="F"
IF ENFYB>ENFYE
QUIT
+32 ; find current and plan year projects
+33 IF ENFYB'="F"
FOR ENYR=ENFY+ENFYB:1:ENFY+$SELECT(ENFYE="F":5,1:ENFYE)
Begin DoDot:1
+34 SET ENPY=ENYR
+35 ; construction status list
SET ENSTC=$SELECT(ENFY=ENYR:";6;8;9;10;11;12;13;14;15;",ENFY<ENYR:";3;5;6;8;9;10;11;12;",1:"")
+36 ; lease status list
SET ENSTL=$SELECT(ENFY=ENYR:"",ENFY<ENYR:";3;5;",1:"")
+37 FOR ENIDX="F","G","L"
DO FYIDX
End DoDot:1
+38 ; find future year projects
+39 IF ENFYE="F"
SET ENPY="F"
FOR ENIDX="F","G","L"
Begin DoDot:1
+40 ; construction status list
SET ENSTC=";3;5;6;8;9;10;11;12;"
+41 ; lease status list
SET ENSTL=";3;5;"
+42 SET ENYR=ENFY+5
+43 FOR
SET ENYR=$ORDER(^ENG("PROJ",ENIDX,ENYR))
if ENYR=""
QUIT
DO FYIDX
End DoDot:1
+44 IF ENRET["L"
IF ENC
SET ^TMP($JOB,"L")=ENC_U_ENFY
+45 QUIT
FYIDX ; Get Projects for a Funding Year A/E or CONST or RENT STARTS
+1 SET ENDA=""
FOR
SET ENDA=$ORDER(^ENG("PROJ",ENIDX,ENYR,ENDA))
if ENDA=""
QUIT
Begin DoDot:1
+2 SET ENY0=$GET(^ENG("PROJ",ENDA,0))
+3 SET ENPN=$PIECE(ENY0,U)
IF ENPN=""
QUIT
+4 SET ENPR=$PIECE(ENY0,U,6)
+5 IF $PIECE(ENPN,"-")'=ENSN
QUIT
+6 IF "FG"[ENIDX
IF "^MA^MI^MM^NR^"'[(U_ENPR_U)
QUIT
+7 IF "L"[ENIDX
IF "^LE^"'[(U_ENPR_U)
QUIT
+8 IF ENDV'="*"
IF ENDV'=$PIECE($GET(^ENG("PROJ",ENDA,15)),U)
QUIT
+9 SET ENSTAT=$PIECE($GET(^ENG("PROJ",ENDA,1)),U,3)
+10 IF "^MA^MI^MM^NR^"[(U_ENPR_U)
IF ENSTC'[(";"_ENSTAT_";")
QUIT
+11 IF "^LE^"[(U_ENPR_U)
IF ENSTL'[(";"_ENSTAT_";")
QUIT
+12 IF ENRET["L"
IF '$DATA(^TMP($JOB,"L",ENPN))
SET ^TMP($JOB,"L",ENPN)=ENDA
SET ENC=ENC+1
+13 IF ENRET["Y"
Begin DoDot:2
+14 SET ENX=$GET(^TMP($JOB,"Y",ENPY,ENPR,ENPN))
+15 SET $PIECE(ENX,U)=ENDA
+16 if ENIDX="F"
SET $PIECE(ENX,U,2)=1
+17 if ENIDX="G"
SET $PIECE(ENX,U,3)=1
+18 SET ^TMP($JOB,"Y",ENPY,ENPR,ENPN)=ENX
End DoDot:2
+19 IF ENRET["E"
IF ENPY'="F"
IF ENFY'=ENYR
IF "GL"[ENIDX
IF $ORDER(^ENG("PROJ",ENDA,25,0))
SET ^TMP($JOB,"E",ENPR,ENPY,ENPN)=ENDA
End DoDot:1
+20 QUIT
+21 ;ENPLS1
