- 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 Feb 18, 2025@23:21:47 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
