source: FOIAVistA/trunk/r/ENGINEERING-EN/ENPRP1.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1ENPRP1 ;(WIRMFO)/DLM/DH/SAB-Project Progress Report ;7/15/97
2 ;;7.0;ENGINEERING;**28**;Aug 17, 1993
3 ; Input variables
4 ; END - flag, true if user stops output
5 ; ENDA - ien of project
6 ; ENDT - date/time of report
7 ; ENOPT - option for 0051 pages to print (1,2, or B)
8 ; ENPG - current page of report
9EN ; print 0051
10 N ENPN
11 S ENY0=$G(^ENG("PROJ",ENDA,0)),ENY60=$G(^ENG("PROJ",ENDA,60))
12 S ENMC=$$GET1^DIQ(6925,ENDA,3),ENMC(0)=$$GET1^DIQ(6925,ENDA,15.3)
13 S ENMCN=$$GET1^DIQ(6925,ENDA,"3:99")
14 S ENMCN(0)=$$GET1^DIQ(6925,ENDA,"15.3:99")
15 S ENFT=$$GET1^DIQ(6925,ENDA,158,"I")
16 S ENFT(0)=$$GET1^DIQ(6925,ENDA,159.1,"I")
17 S ENDIV=$$GET1^DIQ(6925,ENDA,176)
18 S ENDIV(0)=$$GET1^DIQ(6925,ENDA,159.15)
19 I ENFT'="VHA" S Y=$G(^DIC(6910,1,0)),ENSMC=$P(Y,U),ENSMCN=$P(Y,U,2) K Y
20 S ENPN=$P(ENY0,U),ENPN(0)=$P(ENY60,U)
21 S ENRP=$$GET1^DIQ(6925,ENDA,1),ENRP(0)=$$GET1^DIQ(6925,ENDA,15)
22 S ENPT=$P(ENY0,U,3),ENPT(0)=$P(ENY60,U,3)
23 S ENPR=$P(ENY0,U,6),ENPR(0)=$P(ENY60,U,6)
24 K ENY0,ENY60
25 ;
26 I 'END,ENOPT=1!(ENOPT="B") D PAGE1
27 I 'END,ENOPT=2!(ENOPT="B") D PAGE2
28 K ENDIV,ENFT,ENMC,ENMCN,ENPN,ENPR,ENPT,ENRP,ENSMC,ENSMCN
29 Q
30 ;
31PAGE1 ; page 1
32 S ENP=1
33 D HD Q:END
34 D ID I $Y+7>IOSL D HD Q:END
35 D CAT I $Y+7>IOSL D HD Q:END
36 D NHCU I $Y+6>IOSL D HD Q:END
37 D COST I $Y+27>IOSL D HD Q:END
38 D DATE I $Y+7>IOSL D HD Q:END
39 D NOTE
40 D FT
41 Q
42PAGE2 ; page 2
43 S ENP=2
44 D HD Q:END
45 D ID
46 D HDCONTR
47 D CONTR
48 D FT
49 Q
50HD ; header
51 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
52 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
53 I $E(IOST,1,2)="C-"!ENPG W @IOF
54 S ENPG=ENPG+1
55 Q
56ID S $X=0 W "CONSTRUCTION PROJECT PROGRESS REPORT",?48,ENDT,?72,"page ",ENP
57 W !!,"FACILITY: " D W(ENMC,ENMC(0),"HA")
58 W " (" D W(ENMCN,ENMCN(0),"H") W ")"
59 W ?52,"DIVISION: " D W(ENDIV,ENDIV(0),"HA")
60 W !,"FACILITY TYPE: " D W(ENFT,ENFT(0),"HA")
61 I ENFT'="VHA" W ?20,"SERVICING FACILITY: ",ENSMC," (",ENSMCN,")"
62 W !!,"PROJECT #: " D W(ENPN,ENPN(0),"H")
63 W ?25,"FMS #: ",$$GET1^DIQ(6925,ENDA,.05)
64 W ?46,"REPORTING PERIOD: " D W(ENRP,ENRP(0),"H")
65 W !,"TITLE: " D W(ENPT,ENPT(0),"H")
66 Q
67CAT ;
68 W !!,"PROGRAM: " D W(ENPR,ENPR(0),"HA")
69 W ?14,"STATUS: "
70 D W($$GET1^DIQ(6925,ENDA,6),$$GET1^DIQ(6925,ENDA,15.8),"HA")
71 W !,"PROJECT CATEGORY: "
72 D W($$GET1^DIQ(6925,ENDA,158.1),$$GET1^DIQ(6925,ENDA,159.2),"HA")
73 W ?51,"BONUS: "
74 I "^NR^SL^"'[(U_ENPR_U) W "NA"
75 E D W($$GET1^DIQ(6925,ENDA,158.8),$$GET1^DIQ(6925,ENDA,159.9),"HA")
76 W !,"BUDGET CATEGORY: "
77 D W($$GET1^DIQ(6925,ENDA,158.2),$$GET1^DIQ(6925,ENDA,159.3),"HA")
78 W !,"EPA REPORTING CATEGORY: "
79 I "^NR^"'[(U_ENPR_U)!($P($G(^ENG("PROJ",ENDA,52)),U,7)="N") W "NA"
80 E D W($$GET1^DIQ(6925,ENDA,158.7),$$GET1^DIQ(6925,ENDA,159.8),"HA")
81 Q
82NHCU ;
83 K ENCNV S ENI=0 F S ENI=$O(^ENG("PROJ",ENDA,57,ENI)) Q:'ENI D
84 . S ENX=$G(^ENG("PROJ",ENDA,57,ENI,0))
85 . S ENXE=$S($P(ENX,U)]"":$$EXTERNAL^DILFD(6925.0166,.01,"",$P(ENX,U)),1:"")
86 . I ENXE]"" S ENCNV(ENXE)=$P(ENX,U,2)
87 K ENCNVO S ENI=0 F S ENI=$O(^ENG("PROJ",ENDA,58,ENI)) Q:'ENI D
88 . S ENX=$G(^ENG("PROJ",ENDA,58,ENI,0))
89 . S ENXE=$S($P(ENX,U)]"":$$EXTERNAL^DILFD(6925.0166,.01,"",$P(ENX,U)),1:"")
90 . I ENXE]"" S ENCNVO(ENXE)=$P(ENX,U,2)
91 S ENY52=$G(^ENG("PROJ",ENDA,52)),ENY68=$G(^ENG("PROJ",ENDA,68)),ENX=""
92 W !!,"NHCU BEDS:"
93 W ?13,"AUTHORIZED:",?25
94 D W($J($P($G(^ENG("PROJ",ENDA,53)),U,4),4),$J($P($G(^ENG("PROJ",ENDA,68)),U,14),4),"HA")
95 W ?37,"CONVERTED FROM:" D NHCNV
96 W !,?13,"NEW:",?25 D W($J($P(ENY52,U,3),4),$J($P(ENY68,U,3),4),"HA")
97 I ENX]"" D NHCNV
98 W !,?13,"RENOVATED:",?25
99 D W($J($P(ENY52,U,4),4),$J($P(ENY68,U,4),4),"HA")
100 I ENX]"" D NHCNV
101 W !,?13,"CONVERTED:",?25
102 D W($J($P(ENY52,U,5),4),$J($P(ENY68,U,5),4),"HA")
103 I ENX]"" D NHCNV
104 F I=1:1:2 I ENX]"" W ! D NHCNV
105 K ENCNV,ENCNVO,ENX,ENY52,ENY68
106 Q
107NHCNV ; NHCU conversion line (source and number)
108 S ENX=$O(ENCNV(ENX)) I ENX]"" D
109 . S ENXO=$S($D(ENCNVO(ENX)):ENX,1:"")
110 . W ?53 D W(ENX,ENXO,"HA")
111 . W ?69 D W($J(ENCNV(ENX),4),$J($G(ENCNVO(ENX)),4),"HA")
112 Q
113COST ;
114 W !!,?15,"FY",?22,"METHOD",?38,"$ APPROVED",?53,"$ OBLIGATED"
115 W !,"DESIGN:"
116 W ?15 D W($$GET1^DIQ(6925,ENDA,3.45),$$GET1^DIQ(6925,ENDA,15.4),"HA")
117 W ?22 D W($$GET1^DIQ(6925,ENDA,7),$$GET1^DIQ(6925,ENDA,15.9),"HA")
118 S ENA("AE")=$$GET1^DIQ(6925,ENDA,5),ENA("AE",0)=$$GET1^DIQ(6925,ENDA,15.7)
119 W ?37 D W($J($FN(ENA("AE"),","),11),$J($FN(ENA("AE",0),","),11),"HA")
120 S ENO("AE")=$$GET1^DIQ(6925,ENDA,82),ENO("AE",0)=$$GET1^DIQ(6925,ENDA,82)
121 W ?53 D W($J($FN(ENO("AE"),","),11),$J($FN(ENO("AE",0),","),11),"HAP")
122 W !,"CONSTRUCTION:"
123 W ?15 D W($$GET1^DIQ(6925,ENDA,3.5),$$GET1^DIQ(6925,ENDA,15.5),"HA")
124 W ?22 D W($$GET1^DIQ(6925,ENDA,8),$$GET1^DIQ(6925,ENDA,16),"HA")
125 S ENA("CN")=$$GET1^DIQ(6925,ENDA,4),ENA("CN",0)=$$GET1^DIQ(6925,ENDA,15.6)
126 W ?37 D W($J($FN(ENA("CN"),","),11),$J($FN(ENA("CN",0),","),11),"HA")
127 S ENO("CN")=$$GET1^DIQ(6925,ENDA,129),ENO("CN",0)=$$GET1^DIQ(6925,ENDA,129)
128 W ?53 D W($J($FN(ENO("CN"),","),11),$J($FN(ENO("CN",0),","),11),"HAP")
129 W !,"TOTAL:"
130 W ?37
131 D W($J($FN(ENA("AE")+ENA("CN"),","),11),$J($FN(ENA("AE",0)+ENA("CN",0),","),11),"HA")
132 W ?53
133 D W($J($FN(ENO("AE")+ENO("CN"),","),11),$J($FN(ENO("AE",0)+ENO("CN",0),","),11),"HAP")
134 K ENA,ENO
135 Q
136DATE ; milestones
137 D ^ENPRP2
138 Q
139NOTE ; progress note
140 N DIWL,DIWR,DIWF,ENX
141 S ENX=$P($G(^ENG("PROJ",ENDA,13)),U)
142 S ENX(0)=$P($G(^ENG("PROJ",ENDA,65)),U)
143 W !!
144 I ENX'=ENX(0) S X=$X W IOINHI S $X=X
145 K ^UTILITY($J,"W")
146 S DIWL=1,DIWR=76,DIWF="W"
147 S X="NOTE: " D ^DIWP
148 S X=ENX D ^DIWP
149 D ^DIWW
150 I ENX'=ENX(0) S X=$X W IOINLOW S $X=X
151 Q
152HDCONTR ; Contract Header
153 S $P(ENDL,"-",76)=""
154 W !!,"TYPE",?7,"CONTRACT DATA",?50,"SUPPLEMENTAL AGREEMENTS"
155 W !,ENDL
156 Q
157CONTR ; Contracts
158 D ^ENPRP3 I $Y+11>IOSL D HD Q:END D HDCONTR ; A/E
159 D ^ENPRP4 ; Construction & P&H
160 Q
161 ;
162FT ; Page footer
163 W !!," An asterisk '*' indicates a change since the last transmission."
164 Q
165W(ENDATA,ENDATAO,ENIND) ;
166 N X
167 I ENDATA'=ENDATAO,ENIND["H" S X=$X W IOINHI S $X=X
168 W ENDATA
169 I ENDATA'=ENDATAO D
170 . I ENIND["A" W "*"
171 . I ENIND["H" S X=$X W IOINLOW S $X=X
172 . I ENIND["P" W " ("_ENDATAO_")"
173 Q
174 ;ENPRP1
Note: See TracBrowser for help on using the repository browser.