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