source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPRP1.m@ 1680

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