ENPL5 ;(WASH ISC)/LKG,SAB-FYFP REPORT ;8/17/95
;;7.0;ENGINEERING;**11,23**;Aug 17, 1993
IN ;Entry point to print 5-Yr Plan report
S DIR(0)="N^1993:2099:0",DIR("A")="Budget Year of 5-Yr Plan"
S DIR("?")="Enter the 4-digit Budget Year of the Plan"
S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1)
D ^DIR K DIR G:$D(DIRUT) EX S ENFY=Y-1
ST ; get station
S EN6910Y0=$G(^DIC(6910,1,0))
S DIC("B")=$P(EN6910Y0,U,2)
S DIC="^DIC(4,",DIC(0)="AEMQ" D ^DIC K DIC G:Y<1 EX S ENI=+Y_","
S ENSN=$E($$GET1^DIQ(4,ENI,99),1,3)
S ENPN=$O(^ENG("PROJ","B",ENSN_"-"))
I $P(ENPN,"-")'=ENSN W !,$C(7)_"No Projects on file for this Site" G ST
S ENX="VAMC: "_$$GET1^DIQ(4,ENI,"1.03")_", "
S ENX=ENX_$$GET1^DIQ(4,ENI,".02:1")_" ("_ENSN_")"
S:$P(EN6910Y0,U,7)]"" ENX=ENX_" Region: "_$P(EN6910Y0,U,7)
S:$P(EN6910Y0,U,11)]"" ENX=ENX_" VISN: "_$P(EN6910Y0,U,11)
S:$P(EN6910Y0,U,12)]"" ENX=ENX_" Network: "_$P(EN6910Y0,U,12)
S ENPGH=ENX
K EN6910Y0,ENI
;
S ENMDA=0,ENDV="*"
I $P($G(^DIC(6910,1,0)),U,10) D G:$D(DTOUT)!$D(DUOUT) EX
. W !,"Select Division to be included in report or leave blank for all"
. S DIC="^ENG(6910.3,",DIC(0)="AQEM" D ^DIC Q:$D(DTOUT)!$D(DUOUT)
. I Y'<1 S ENDV=+Y
. I Y<1 S ENMDA=1
S:ENDV'="*" ENPGH=ENPGH_" Div: "_$$GET1^DIQ(6910.3,ENDV_",",.01)
;
K DIR S DIR("A")="Start with year: ",DIR("B")=ENFY
S DIR(0)="SA^"_ENFY_":CURRENT YR;"_(ENFY+1)_":BUDGET YR;"_(ENFY+2)_":BUDGET YR+1;"_(ENFY+3)_":BUDGET YR+2;"_(ENFY+4)_":BUDGET YR+3;"_(ENFY+5)_":BUDGET YR+4;FUTURE:FUTURE YEARS"
S DIR("?")="Enter a 4 digit year from "_ENFY_" to "_(ENFY+5)_" or FUTURE"
D ^DIR K DIR G:$D(DIRUT) EX S ENFYB=$S(Y="FUTURE":"F",1:Y-ENFY)
;
S DIR("A")="Go to year: ",DIR("B")="FUTURE",DIR(0)="SA^"
I ENFYB'="F" F ENI=ENFYB:1:5 S DIR(0)=DIR(0)_(ENFY+ENI)_$S(ENI:":BUDGET YR",1:":CURRENT YR")_$S(ENI>1:"+"_(ENI-1)_";",1:";")
S DIR(0)=DIR(0)_"FUTURE:FUTURE YEARS" K ENI
S DIR("?")="Enter FUTURE"_$S(ENFYB'="F":" or a four digit year from "_(ENFY+ENFYB)_" to "_(ENFY+5),1:"")
D ^DIR K DIR G:$D(DIRUT) EX S ENFYE=$S(Y="FUTURE":"F",1:Y-ENFY)
;
S DIR("A")="Level of detail: ",DIR("B")="DEFAULT"
S DIR(0)="SA^L:LOWEST;S:SUMMARY;E:EQUIPMENT;D:DEFAULT;H:HIGHEST"
S DIR("?")="Enter a code (L, S, E, D, or H)"
S DIR("?",1)="L (LOWEST) Prints only project list pages."
S DIR("?",2)="S (SUMMARY) Prints project list and final summary pages."
S DIR("?",3)="E (EQUIPMENT) Prints equipment page only."
S DIR("?",4)="D (DEFAULT) Prints project list, final summary,"
S DIR("?",5)=" and equipment list pages. Prints detail"
S DIR("?",6)=" pages for BUDGET and BUDGET+1 years."
S DIR("?",7)="H (HIGHEST) Prints project list, final summary,"
S DIR("?",8)=" and equipment list pages. Prints detail"
S DIR("?",9)=" pages for BUDGET through BUDGET+4 years."
D ^DIR K DIR G:$D(DIRUT) EX S ENDETAIL=Y
DEV ; device
S %ZIS="PQ" D ^%ZIS G:POP EX I IOM<132 K IO("Q") D:IO'=IO(0) ^%ZISC W *7,"* Must Support 132 Character Display" G DEV
I $D(IO("Q")) D G EX
. S ZTRTN="QEN^ENPL5",ZTDESC="Five Year Facility Plan Report"
. F ENX="ENSN","ENDV","ENPGH","ENMDA","ENFY","ENFYB","ENFYE","ENDETAIL" S ZTSAVE(ENX)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry point
U IO K ENT S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENRDT=Y
S ENPGHC=125-$L(ENPGH)\2+5
; get projects and leases
S ENX="Y"_$S("EDH"[ENDETAIL:"E",1:"")_$S("DH"[ENDETAIL:"L",1:"")
D FYFP^ENPLS1(ENSN,ENFY,ENFYB,ENFYE,ENDV,ENX)
; generate current and/or plan year summary pages
I "LSDH"[ENDETAIL,ENFYB'="F" F ENYR=ENFY+ENFYB:1:ENFY+$S(ENFYE="F":5,1:ENFYE) D YS^ENPL5A Q:END
; generate future year summary pages
I "LSDH"[ENDETAIL,ENFYE="F",'END S ENYR="F" D YS^ENPL5A
; generate equipment pages
I "EDH"[ENDETAIL,'END D EQP^ENPL5C
; generate detail pages
I "DH"[ENDETAIL,'END D
. S ENFYMX=$S(ENDETAIL["D":ENFY+2,ENDETAIL["H":ENFY+5,1:0) ; max year
. S ENPN=""
. F S ENPN=$O(^TMP($J,"L",ENPN)) Q:ENPN="" D Q:END
. . S ENDA=$P(^TMP($J,"L",ENPN),U),ENY0=$G(^ENG("PROJ",ENDA,0))
. . S ENPR=$P(ENY0,U,6)
. . I "^MA^MI^MM^NR^"[(U_ENPR_U) D
. . . S ENFYAE=$P($G(^ENG("PROJ",ENDA,5)),U,7)
. . . S ENFYCO=$P(ENY0,U,7)
. . . I (ENFYAE>ENFY&(ENFYAE'>ENFYMX))!(ENFYCO>ENFY&(ENFYCO'>ENFYMX)) D PD^ENPL5B
. . I "^LE^"[(U_ENPR_U) D
. . . S ENFYRE=$P($G(^ENG("PROJ",ENDA,55)),U,3)
. . . I ENFYRE>ENFY,ENFYRE'>ENFYMX D PD^ENPL5B
. K ENFYMX,ENFYAE,ENFYCO,ENFYRE,ENY0
; generate plan summary page
I "SDH"[ENDETAIL,'END D PS^ENPL5D
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
EX ; exit
K ^TMP($J)
K EN6910Y0,END,ENDA,ENDETAIL,ENDV,ENFY,ENFYB,ENFYE,ENI,ENMDA
K ENPG,ENPGH,ENPGHC,ENPN,ENPR,ENRDT,ENSN,ENT,ENX,ENYR
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q
;ENPL5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPL5 4804 printed Nov 22, 2024@17:04:53 Page 2
ENPL5 ;(WASH ISC)/LKG,SAB-FYFP REPORT ;8/17/95
+1 ;;7.0;ENGINEERING;**11,23**;Aug 17, 1993
IN ;Entry point to print 5-Yr Plan report
+1 SET DIR(0)="N^1993:2099:0"
SET DIR("A")="Budget Year of 5-Yr Plan"
+2 SET DIR("?")="Enter the 4-digit Budget Year of the Plan"
+3 SET DIR("B")=$EXTRACT(17000000+DT,1,4)+$SELECT($EXTRACT(DT,4,7)>0600:2,1:1)
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EX
SET ENFY=Y-1
ST ; get station
+1 SET EN6910Y0=$GET(^DIC(6910,1,0))
+2 SET DIC("B")=$PIECE(EN6910Y0,U,2)
+3 SET DIC="^DIC(4,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
if Y<1
GOTO EX
SET ENI=+Y_","
+4 SET ENSN=$EXTRACT($$GET1^DIQ(4,ENI,99),1,3)
+5 SET ENPN=$ORDER(^ENG("PROJ","B",ENSN_"-"))
+6 IF $PIECE(ENPN,"-")'=ENSN
WRITE !,$CHAR(7)_"No Projects on file for this Site"
GOTO ST
+7 SET ENX="VAMC: "_$$GET1^DIQ(4,ENI,"1.03")_", "
+8 SET ENX=ENX_$$GET1^DIQ(4,ENI,".02:1")_" ("_ENSN_")"
+9 if $PIECE(EN6910Y0,U,7)]""
SET ENX=ENX_" Region: "_$PIECE(EN6910Y0,U,7)
+10 if $PIECE(EN6910Y0,U,11)]""
SET ENX=ENX_" VISN: "_$PIECE(EN6910Y0,U,11)
+11 if $PIECE(EN6910Y0,U,12)]""
SET ENX=ENX_" Network: "_$PIECE(EN6910Y0,U,12)
+12 SET ENPGH=ENX
+13 KILL EN6910Y0,ENI
+14 ;
+15 SET ENMDA=0
SET ENDV="*"
+16 IF $PIECE($GET(^DIC(6910,1,0)),U,10)
Begin DoDot:1
+17 WRITE !,"Select Division to be included in report or leave blank for all"
+18 SET DIC="^ENG(6910.3,"
SET DIC(0)="AQEM"
DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+19 IF Y'<1
SET ENDV=+Y
+20 IF Y<1
SET ENMDA=1
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EX
+21 if ENDV'="*"
SET ENPGH=ENPGH_" Div: "_$$GET1^DIQ(6910.3,ENDV_",",.01)
+22 ;
+23 KILL DIR
SET DIR("A")="Start with year: "
SET DIR("B")=ENFY
+24 SET DIR(0)="SA^"_ENFY_":CURRENT YR;"_(ENFY+1)_":BUDGET YR;"_(ENFY+2)_":BUDGET YR+1;"_(ENFY+3)_":BUDGET YR+2;"_(ENFY+4)_":BUDGET YR+3;"_(ENFY+5)_":BUDGET YR+4;FUTURE:FUTURE YEARS"
+25 SET DIR("?")="Enter a 4 digit year from "_ENFY_" to "_(ENFY+5)_" or FUTURE"
+26 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EX
SET ENFYB=$SELECT(Y="FUTURE":"F",1:Y-ENFY)
+27 ;
+28 SET DIR("A")="Go to year: "
SET DIR("B")="FUTURE"
SET DIR(0)="SA^"
+29 IF ENFYB'="F"
FOR ENI=ENFYB:1:5
SET DIR(0)=DIR(0)_(ENFY+ENI)_$SELECT(ENI:":BUDGET YR",1:":CURRENT YR")_$SELECT(ENI>1:"+"_(ENI-1)_";",1:";")
+30 SET DIR(0)=DIR(0)_"FUTURE:FUTURE YEARS"
KILL ENI
+31 SET DIR("?")="Enter FUTURE"_$SELECT(ENFYB'="F":" or a four digit year from "_(ENFY+ENFYB)_" to "_(ENFY+5),1:"")
+32 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EX
SET ENFYE=$SELECT(Y="FUTURE":"F",1:Y-ENFY)
+33 ;
+34 SET DIR("A")="Level of detail: "
SET DIR("B")="DEFAULT"
+35 SET DIR(0)="SA^L:LOWEST;S:SUMMARY;E:EQUIPMENT;D:DEFAULT;H:HIGHEST"
+36 SET DIR("?")="Enter a code (L, S, E, D, or H)"
+37 SET DIR("?",1)="L (LOWEST) Prints only project list pages."
+38 SET DIR("?",2)="S (SUMMARY) Prints project list and final summary pages."
+39 SET DIR("?",3)="E (EQUIPMENT) Prints equipment page only."
+40 SET DIR("?",4)="D (DEFAULT) Prints project list, final summary,"
+41 SET DIR("?",5)=" and equipment list pages. Prints detail"
+42 SET DIR("?",6)=" pages for BUDGET and BUDGET+1 years."
+43 SET DIR("?",7)="H (HIGHEST) Prints project list, final summary,"
+44 SET DIR("?",8)=" and equipment list pages. Prints detail"
+45 SET DIR("?",9)=" pages for BUDGET through BUDGET+4 years."
+46 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EX
SET ENDETAIL=Y
DEV ; device
+1 SET %ZIS="PQ"
DO ^%ZIS
if POP
GOTO EX
IF IOM<132
KILL IO("Q")
if IO'=IO(0)
DO ^%ZISC
WRITE *7,"* Must Support 132 Character Display"
GOTO DEV
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="QEN^ENPL5"
SET ZTDESC="Five Year Facility Plan Report"
+4 FOR ENX="ENSN","ENDV","ENPGH","ENMDA","ENFY","ENFYB","ENFYE","ENDETAIL"
SET ZTSAVE(ENX)=""
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EX
QEN ; queued entry point
+1 USE IO
KILL ENT
SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENRDT=Y
+2 SET ENPGHC=125-$LENGTH(ENPGH)\2+5
+3 ; get projects and leases
+4 SET ENX="Y"_$SELECT("EDH"[ENDETAIL:"E",1:"")_$SELECT("DH"[ENDETAIL:"L",1:"")
+5 DO FYFP^ENPLS1(ENSN,ENFY,ENFYB,ENFYE,ENDV,ENX)
+6 ; generate current and/or plan year summary pages
+7 IF "LSDH"[ENDETAIL
IF ENFYB'="F"
FOR ENYR=ENFY+ENFYB:1:ENFY+$SELECT(ENFYE="F":5,1:ENFYE)
DO YS^ENPL5A
if END
QUIT
+8 ; generate future year summary pages
+9 IF "LSDH"[ENDETAIL
IF ENFYE="F"
IF 'END
SET ENYR="F"
DO YS^ENPL5A
+10 ; generate equipment pages
+11 IF "EDH"[ENDETAIL
IF 'END
DO EQP^ENPL5C
+12 ; generate detail pages
+13 IF "DH"[ENDETAIL
IF 'END
Begin DoDot:1
+14 ; max year
SET ENFYMX=$SELECT(ENDETAIL["D":ENFY+2,ENDETAIL["H":ENFY+5,1:0)
+15 SET ENPN=""
+16 FOR
SET ENPN=$ORDER(^TMP($JOB,"L",ENPN))
if ENPN=""
QUIT
Begin DoDot:2
+17 SET ENDA=$PIECE(^TMP($JOB,"L",ENPN),U)
SET ENY0=$GET(^ENG("PROJ",ENDA,0))
+18 SET ENPR=$PIECE(ENY0,U,6)
+19 IF "^MA^MI^MM^NR^"[(U_ENPR_U)
Begin DoDot:3
+20 SET ENFYAE=$PIECE($GET(^ENG("PROJ",ENDA,5)),U,7)
+21 SET ENFYCO=$PIECE(ENY0,U,7)
+22 IF (ENFYAE>ENFY&(ENFYAE'>ENFYMX))!(ENFYCO>ENFY&(ENFYCO'>ENFYMX))
DO PD^ENPL5B
End DoDot:3
+23 IF "^LE^"[(U_ENPR_U)
Begin DoDot:3
+24 SET ENFYRE=$PIECE($GET(^ENG("PROJ",ENDA,55)),U,3)
+25 IF ENFYRE>ENFY
IF ENFYRE'>ENFYMX
DO PD^ENPL5B
End DoDot:3
End DoDot:2
if END
QUIT
+26 KILL ENFYMX,ENFYAE,ENFYCO,ENFYRE,ENY0
End DoDot:1
+27 ; generate plan summary page
+28 IF "SDH"[ENDETAIL
IF 'END
DO PS^ENPL5D
+29 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
EX ; exit
+1 KILL ^TMP($JOB)
+2 KILL EN6910Y0,END,ENDA,ENDETAIL,ENDV,ENFY,ENFYB,ENFYE,ENI,ENMDA
+3 KILL ENPG,ENPGH,ENPGHC,ENPN,ENPR,ENRDT,ENSN,ENT,ENX,ENYR
+4 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 QUIT
+6 ;ENPL5
