175 lines
5.8 KiB
Mathematica
175 lines
5.8 KiB
Mathematica
ENPRP1 ;(WIRMFO)/DLM/DH/SAB-Project Progress Report ;7/15/97
|
|
;;7.0;ENGINEERING;**28**;Aug 17, 1993
|
|
; Input variables
|
|
; END - flag, true if user stops output
|
|
; ENDA - ien of project
|
|
; ENDT - date/time of report
|
|
; ENOPT - option for 0051 pages to print (1,2, or B)
|
|
; ENPG - current page of report
|
|
EN ; print 0051
|
|
N ENPN
|
|
S ENY0=$G(^ENG("PROJ",ENDA,0)),ENY60=$G(^ENG("PROJ",ENDA,60))
|
|
S ENMC=$$GET1^DIQ(6925,ENDA,3),ENMC(0)=$$GET1^DIQ(6925,ENDA,15.3)
|
|
S ENMCN=$$GET1^DIQ(6925,ENDA,"3:99")
|
|
S ENMCN(0)=$$GET1^DIQ(6925,ENDA,"15.3:99")
|
|
S ENFT=$$GET1^DIQ(6925,ENDA,158,"I")
|
|
S ENFT(0)=$$GET1^DIQ(6925,ENDA,159.1,"I")
|
|
S ENDIV=$$GET1^DIQ(6925,ENDA,176)
|
|
S ENDIV(0)=$$GET1^DIQ(6925,ENDA,159.15)
|
|
I ENFT'="VHA" S Y=$G(^DIC(6910,1,0)),ENSMC=$P(Y,U),ENSMCN=$P(Y,U,2) K Y
|
|
S ENPN=$P(ENY0,U),ENPN(0)=$P(ENY60,U)
|
|
S ENRP=$$GET1^DIQ(6925,ENDA,1),ENRP(0)=$$GET1^DIQ(6925,ENDA,15)
|
|
S ENPT=$P(ENY0,U,3),ENPT(0)=$P(ENY60,U,3)
|
|
S ENPR=$P(ENY0,U,6),ENPR(0)=$P(ENY60,U,6)
|
|
K ENY0,ENY60
|
|
;
|
|
I 'END,ENOPT=1!(ENOPT="B") D PAGE1
|
|
I 'END,ENOPT=2!(ENOPT="B") D PAGE2
|
|
K ENDIV,ENFT,ENMC,ENMCN,ENPN,ENPR,ENPT,ENRP,ENSMC,ENSMCN
|
|
Q
|
|
;
|
|
PAGE1 ; page 1
|
|
S ENP=1
|
|
D HD Q:END
|
|
D ID I $Y+7>IOSL D HD Q:END
|
|
D CAT I $Y+7>IOSL D HD Q:END
|
|
D NHCU I $Y+6>IOSL D HD Q:END
|
|
D COST I $Y+27>IOSL D HD Q:END
|
|
D DATE I $Y+7>IOSL D HD Q:END
|
|
D NOTE
|
|
D FT
|
|
Q
|
|
PAGE2 ; page 2
|
|
S ENP=2
|
|
D HD Q:END
|
|
D ID
|
|
D HDCONTR
|
|
D CONTR
|
|
D FT
|
|
Q
|
|
HD ; header
|
|
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
|
|
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
|
|
I $E(IOST,1,2)="C-"!ENPG W @IOF
|
|
S ENPG=ENPG+1
|
|
Q
|
|
ID S $X=0 W "CONSTRUCTION PROJECT PROGRESS REPORT",?48,ENDT,?72,"page ",ENP
|
|
W !!,"FACILITY: " D W(ENMC,ENMC(0),"HA")
|
|
W " (" D W(ENMCN,ENMCN(0),"H") W ")"
|
|
W ?52,"DIVISION: " D W(ENDIV,ENDIV(0),"HA")
|
|
W !,"FACILITY TYPE: " D W(ENFT,ENFT(0),"HA")
|
|
I ENFT'="VHA" W ?20,"SERVICING FACILITY: ",ENSMC," (",ENSMCN,")"
|
|
W !!,"PROJECT #: " D W(ENPN,ENPN(0),"H")
|
|
W ?25,"FMS #: ",$$GET1^DIQ(6925,ENDA,.05)
|
|
W ?46,"REPORTING PERIOD: " D W(ENRP,ENRP(0),"H")
|
|
W !,"TITLE: " D W(ENPT,ENPT(0),"H")
|
|
Q
|
|
CAT ;
|
|
W !!,"PROGRAM: " D W(ENPR,ENPR(0),"HA")
|
|
W ?14,"STATUS: "
|
|
D W($$GET1^DIQ(6925,ENDA,6),$$GET1^DIQ(6925,ENDA,15.8),"HA")
|
|
W !,"PROJECT CATEGORY: "
|
|
D W($$GET1^DIQ(6925,ENDA,158.1),$$GET1^DIQ(6925,ENDA,159.2),"HA")
|
|
W ?51,"BONUS: "
|
|
I "^NR^SL^"'[(U_ENPR_U) W "NA"
|
|
E D W($$GET1^DIQ(6925,ENDA,158.8),$$GET1^DIQ(6925,ENDA,159.9),"HA")
|
|
W !,"BUDGET CATEGORY: "
|
|
D W($$GET1^DIQ(6925,ENDA,158.2),$$GET1^DIQ(6925,ENDA,159.3),"HA")
|
|
W !,"EPA REPORTING CATEGORY: "
|
|
I "^NR^"'[(U_ENPR_U)!($P($G(^ENG("PROJ",ENDA,52)),U,7)="N") W "NA"
|
|
E D W($$GET1^DIQ(6925,ENDA,158.7),$$GET1^DIQ(6925,ENDA,159.8),"HA")
|
|
Q
|
|
NHCU ;
|
|
K ENCNV S ENI=0 F S ENI=$O(^ENG("PROJ",ENDA,57,ENI)) Q:'ENI D
|
|
. S ENX=$G(^ENG("PROJ",ENDA,57,ENI,0))
|
|
. S ENXE=$S($P(ENX,U)]"":$$EXTERNAL^DILFD(6925.0166,.01,"",$P(ENX,U)),1:"")
|
|
. I ENXE]"" S ENCNV(ENXE)=$P(ENX,U,2)
|
|
K ENCNVO S ENI=0 F S ENI=$O(^ENG("PROJ",ENDA,58,ENI)) Q:'ENI D
|
|
. S ENX=$G(^ENG("PROJ",ENDA,58,ENI,0))
|
|
. S ENXE=$S($P(ENX,U)]"":$$EXTERNAL^DILFD(6925.0166,.01,"",$P(ENX,U)),1:"")
|
|
. I ENXE]"" S ENCNVO(ENXE)=$P(ENX,U,2)
|
|
S ENY52=$G(^ENG("PROJ",ENDA,52)),ENY68=$G(^ENG("PROJ",ENDA,68)),ENX=""
|
|
W !!,"NHCU BEDS:"
|
|
W ?13,"AUTHORIZED:",?25
|
|
D W($J($P($G(^ENG("PROJ",ENDA,53)),U,4),4),$J($P($G(^ENG("PROJ",ENDA,68)),U,14),4),"HA")
|
|
W ?37,"CONVERTED FROM:" D NHCNV
|
|
W !,?13,"NEW:",?25 D W($J($P(ENY52,U,3),4),$J($P(ENY68,U,3),4),"HA")
|
|
I ENX]"" D NHCNV
|
|
W !,?13,"RENOVATED:",?25
|
|
D W($J($P(ENY52,U,4),4),$J($P(ENY68,U,4),4),"HA")
|
|
I ENX]"" D NHCNV
|
|
W !,?13,"CONVERTED:",?25
|
|
D W($J($P(ENY52,U,5),4),$J($P(ENY68,U,5),4),"HA")
|
|
I ENX]"" D NHCNV
|
|
F I=1:1:2 I ENX]"" W ! D NHCNV
|
|
K ENCNV,ENCNVO,ENX,ENY52,ENY68
|
|
Q
|
|
NHCNV ; NHCU conversion line (source and number)
|
|
S ENX=$O(ENCNV(ENX)) I ENX]"" D
|
|
. S ENXO=$S($D(ENCNVO(ENX)):ENX,1:"")
|
|
. W ?53 D W(ENX,ENXO,"HA")
|
|
. W ?69 D W($J(ENCNV(ENX),4),$J($G(ENCNVO(ENX)),4),"HA")
|
|
Q
|
|
COST ;
|
|
W !!,?15,"FY",?22,"METHOD",?38,"$ APPROVED",?53,"$ OBLIGATED"
|
|
W !,"DESIGN:"
|
|
W ?15 D W($$GET1^DIQ(6925,ENDA,3.45),$$GET1^DIQ(6925,ENDA,15.4),"HA")
|
|
W ?22 D W($$GET1^DIQ(6925,ENDA,7),$$GET1^DIQ(6925,ENDA,15.9),"HA")
|
|
S ENA("AE")=$$GET1^DIQ(6925,ENDA,5),ENA("AE",0)=$$GET1^DIQ(6925,ENDA,15.7)
|
|
W ?37 D W($J($FN(ENA("AE"),","),11),$J($FN(ENA("AE",0),","),11),"HA")
|
|
S ENO("AE")=$$GET1^DIQ(6925,ENDA,82),ENO("AE",0)=$$GET1^DIQ(6925,ENDA,82)
|
|
W ?53 D W($J($FN(ENO("AE"),","),11),$J($FN(ENO("AE",0),","),11),"HAP")
|
|
W !,"CONSTRUCTION:"
|
|
W ?15 D W($$GET1^DIQ(6925,ENDA,3.5),$$GET1^DIQ(6925,ENDA,15.5),"HA")
|
|
W ?22 D W($$GET1^DIQ(6925,ENDA,8),$$GET1^DIQ(6925,ENDA,16),"HA")
|
|
S ENA("CN")=$$GET1^DIQ(6925,ENDA,4),ENA("CN",0)=$$GET1^DIQ(6925,ENDA,15.6)
|
|
W ?37 D W($J($FN(ENA("CN"),","),11),$J($FN(ENA("CN",0),","),11),"HA")
|
|
S ENO("CN")=$$GET1^DIQ(6925,ENDA,129),ENO("CN",0)=$$GET1^DIQ(6925,ENDA,129)
|
|
W ?53 D W($J($FN(ENO("CN"),","),11),$J($FN(ENO("CN",0),","),11),"HAP")
|
|
W !,"TOTAL:"
|
|
W ?37
|
|
D W($J($FN(ENA("AE")+ENA("CN"),","),11),$J($FN(ENA("AE",0)+ENA("CN",0),","),11),"HA")
|
|
W ?53
|
|
D W($J($FN(ENO("AE")+ENO("CN"),","),11),$J($FN(ENO("AE",0)+ENO("CN",0),","),11),"HAP")
|
|
K ENA,ENO
|
|
Q
|
|
DATE ; milestones
|
|
D ^ENPRP2
|
|
Q
|
|
NOTE ; progress note
|
|
N DIWL,DIWR,DIWF,ENX
|
|
S ENX=$P($G(^ENG("PROJ",ENDA,13)),U)
|
|
S ENX(0)=$P($G(^ENG("PROJ",ENDA,65)),U)
|
|
W !!
|
|
I ENX'=ENX(0) S X=$X W IOINHI S $X=X
|
|
K ^UTILITY($J,"W")
|
|
S DIWL=1,DIWR=76,DIWF="W"
|
|
S X="NOTE: " D ^DIWP
|
|
S X=ENX D ^DIWP
|
|
D ^DIWW
|
|
I ENX'=ENX(0) S X=$X W IOINLOW S $X=X
|
|
Q
|
|
HDCONTR ; Contract Header
|
|
S $P(ENDL,"-",76)=""
|
|
W !!,"TYPE",?7,"CONTRACT DATA",?50,"SUPPLEMENTAL AGREEMENTS"
|
|
W !,ENDL
|
|
Q
|
|
CONTR ; Contracts
|
|
D ^ENPRP3 I $Y+11>IOSL D HD Q:END D HDCONTR ; A/E
|
|
D ^ENPRP4 ; Construction & P&H
|
|
Q
|
|
;
|
|
FT ; Page footer
|
|
W !!," An asterisk '*' indicates a change since the last transmission."
|
|
Q
|
|
W(ENDATA,ENDATAO,ENIND) ;
|
|
N X
|
|
I ENDATA'=ENDATAO,ENIND["H" S X=$X W IOINHI S $X=X
|
|
W ENDATA
|
|
I ENDATA'=ENDATAO D
|
|
. I ENIND["A" W "*"
|
|
. I ENIND["H" S X=$X W IOINLOW S $X=X
|
|
. I ENIND["P" W " ("_ENDATAO_")"
|
|
Q
|
|
;ENPRP1
|