ENPL5A.m

ENPL5A ;(WIRMFO)/LKG,SAB-FYFP REPORT: YEAR SUMMARY PAGE ;5/15/96

 ;;7.0;ENGINEERING;**3,11,23,28**;Aug 17, 1993

YS ; year summary page for ENYR

 N ENAE,ENCO,ENCST,ENCSTC,ENCSTCA,ENCSTD,ENCSTDA,ENDA,ENPN,ENPR,ENPRE,ENX

 D HD

 F ENPR="LE","MA","MI","MM","NR" D  Q:END

 . Q:$O(^TMP($J,"Y",ENYR,ENPR,""))']""

 . S ENPRE=$S(ENPR="LE":"LEASE",ENPR="MA":"MAJOR",ENPR="MI":"MINOR",ENPR="MM":"MI-MISC",ENPR="NR":"NRM",1:"")

 . W:$E(IOST,1,2)'="C-" !

 . S ENPN=""

 . F  S ENPN=$O(^TMP($J,"Y",ENYR,ENPR,ENPN)) Q:ENPN=""  D  Q:END

 . . S ENX=^TMP($J,"Y",ENYR,ENPR,ENPN)

 . . S ENDA=$P(ENX,U),ENAE=$P(ENX,U,2),ENCO=$P(ENX,U,3)

 . . I "^MA^MI^MM^NR^"[(U_ENPR_U) D

 . . . S ENX=$G(^ENG("PROJ",ENDA,19))

 . . . S ENCSTD=$P(ENX,U,10)+999\1000

 . . . S ENCSTC=$P(ENX,U,11)+999\1000

 . . . S ENCST=$S(ENAE:ENCSTD,1:0)+$S(ENCO:ENCSTC,1:0)

 . . I "^LE^"[(U_ENPR_U) D

 . . . S ENCST=$P($G(^ENG("PROJ",ENDA,55)),U,5)+999\1000

 . . I ENPR'="LE"!($P($G(^ENG("PROJ",ENDA,55)),U)'="EX") D SUM^ENPL5D

 . . I $Y+10>IOSL D FT Q:END  D HD

 . . W !

 . . W:ENMDA $$GET1^DIQ(6925,ENDA_",",176)

 . . W ?12,$P(ENPN,"-",2,3)

 . . W ?21,$E($P($G(^ENG("PROJ",ENDA,0)),U,3),1,30)

 . . W ?54,"$",$J($FN(ENCST,","),9)

 . . I "^MA^MI^MM^NR^"[(U_ENPR_U) D

 . . . I '(ENAE&ENCO) W $S(ENAE:" D",ENCO:" C",1:"")

 . . . ;S ENCSTDA=$P($G(^ENG("PROJ",ENDA,5)),U,2)+999\1000

 . . . ;S ENCSTCA=$P($G(^ENG("PROJ",ENDA,1)),U,1)+999\1000

 . . . ;I ENCSTDA>0&(ENCSTD'=ENCSTDA)!(ENCSTCA>0&(ENCSTC'=ENCSTCA)) W ?66,"!"

 . . W ?70,ENPRE

 . . W ?83,$E($$GET1^DIQ(6925,ENDA_",",158.1),1,20)

 . . ; W:$O(^ENG("PROJ",ENDA,20,0)) ?106,"YES"

 . . I ENYR'="F" D

 . . . W:ENPR="MA" ?111,$J($P($G(^ENG("PROJ",ENDA,24)),U,8),5)

 . . . W ?118,$$CD(ENDA)

 W !,?54,"----------"

 W !,?5,"TOTAL COST (Excluding Expedited Leases)",?54,"$",$J($FN($P($G(ENT(ENYR,"LE")),U)+$P($G(ENT(ENYR,"MA")),U)+$P($G(ENT(ENYR,"MI")),U)+$P($G(ENT(ENYR,"MM")),U)+$P($G(ENT(ENYR,"NR")),U),","),9)

 F ENI=$Y+10:1:$S(IOSL>254:$Y+13,1:IOSL) W ! ; for long page length

 ;F ENI=$Y+10:1:IOSL W !

 W !,?10,"Project Count"

 W "   LEASE (excludes Expedited) = ",$P($G(ENT(ENYR,"LE")),U,2)+0

 W "   MAJOR = ",$P($G(ENT(ENYR,"MA")),U,2)+0

 W "   MINOR = ",$P($G(ENT(ENYR,"MI")),U,2)+0

 W "   MINOR MISC = ",$P($G(ENT(ENYR,"MM")),U,2)+0

 W "   NRM = ",$P($G(ENT(ENYR,"NR")),U,2)+0

 D FT

 Q

HD ; page header

 D FYFPHD

 S ENX=$S(ENFY=ENYR:"CURRENT YEAR APPROVED",ENYR="F":"FUTURE YEARS",1:"BUDGET YEAR")

 S:ENFY+1<ENYR ENX=ENX_" PLUS "_$P("ONE^TWO^THREE^FOUR",U,ENYR-(ENFY+1))

 S ENX=ENX_" PROJECT LIST"

 S:ENYR'="F" ENX=ENX_" (FY "_ENYR_")"

 W !,?(125-$L(ENX)\2+5),ENX,!!

 W:ENMDA "DIVISION"

 W ?12,"PROJ #",?21,"TITLE",?56,"COST",?65,"*",?70,"PROGRAM"

 W ?83,"PROJECT" ;,?104,"DOMINO"

 W:ENYR'="F" ?111,"MCPS",?118,"CITED"

 W !,?54,"(in $000)",?83,"CATEGORY"

 W:ENYR'="F" ?111,"SCORE",?118,"DEFICIENCY"

 W !

 Q

FT ; page footer

 W !!,?5,"*    C = Construction dollars only    D = Design dollars only"

 S ENPG=$G(ENPG)+1 W !!,?64,"Page ",ENPG,?100,ENRDT

 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y END=1

 Q

FYFPHD ; FYFP Header

 W:$E(IOST,1,2)="C-"!ENPG @IOF

 W !,?56,"FIVE YEAR FACILITY PLAN",!,?ENPGHC,ENPGH

 Q

CD(ENDA) ; Cited Deficiencies Text Extrinsic Variable

 N ENCA,ENCD,ENI

 S ENCD="",ENI=0

 F  S ENI=$O(^ENG("PROJ",ENDA,21,ENI)) Q:'ENI  D

 . S ENCA=$$GET1^DIQ(6925.0164,ENI_","_ENDA_",","3:1")

 . I "^JCAHO^RSFPE^"[(U_ENCA_U) S $P(ENCD,",",ENCA="RSFPE"+1)=ENCA

 I $E(ENCD)="," S ENCD=$E(ENCD,2,99)

 I ENCD="",$O(^ENG("PROJ",ENDA,21,0)) S ENCD="OTHER"

 I ENCD="" S ENCD="NONE"

 Q ENCD

 ;ENPL5A

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENPL5A   3591     printed  Mar 13, 2025@20:59:25                                                                                                                                                                                                      Page 2

ENPL5A    ;(WIRMFO)/LKG,SAB-FYFP REPORT: YEAR SUMMARY PAGE ;5/15/96

 +1       ;;7.0;ENGINEERING;**3,11,23,28**;Aug 17, 1993

YS        ; year summary page for ENYR

 +1        NEW ENAE,ENCO,ENCST,ENCSTC,ENCSTCA,ENCSTD,ENCSTDA,ENDA,ENPN,ENPR,ENPRE,ENX

 +2        DO HD

 +3        FOR ENPR="LE","MA","MI","MM","NR"

               Begin DoDot:1

 +4                if $ORDER(^TMP($JOB,"Y",ENYR,ENPR,""))']""

                       QUIT 

 +5                SET ENPRE=$SELECT(ENPR="LE":"LEASE",ENPR="MA":"MAJOR",ENPR="MI":"MINOR",ENPR="MM":"MI-MISC",ENPR="NR":"NRM",1:"")

 +6                if $EXTRACT(IOST,1,2)'="C-"

                       WRITE !

 +7                SET ENPN=""

 +8                FOR 

                       SET ENPN=$ORDER(^TMP($JOB,"Y",ENYR,ENPR,ENPN))

                       if ENPN=""

                           QUIT 

                       Begin DoDot:2

 +9                        SET ENX=^TMP($JOB,"Y",ENYR,ENPR,ENPN)

 +10                       SET ENDA=$PIECE(ENX,U)

                           SET ENAE=$PIECE(ENX,U,2)

                           SET ENCO=$PIECE(ENX,U,3)

 +11                       IF "^MA^MI^MM^NR^"[(U_ENPR_U)

                               Begin DoDot:3

 +12                               SET ENX=$GET(^ENG("PROJ",ENDA,19))

 +13                               SET ENCSTD=$PIECE(ENX,U,10)+999\1000

 +14                               SET ENCSTC=$PIECE(ENX,U,11)+999\1000

 +15                               SET ENCST=$SELECT(ENAE:ENCSTD,1:0)+$SELECT(ENCO:ENCSTC,1:0)

                               End DoDot:3

 +16                       IF "^LE^"[(U_ENPR_U)

                               Begin DoDot:3

 +17                               SET ENCST=$PIECE($GET(^ENG("PROJ",ENDA,55)),U,5)+999\1000

                               End DoDot:3

 +18                       IF ENPR'="LE"!($PIECE($GET(^ENG("PROJ",ENDA,55)),U)'="EX")

                               DO SUM^ENPL5D

 +19                       IF $Y+10>IOSL

                               DO FT

                               if END

                                   QUIT 

                               DO HD

 +20                       WRITE !

 +21                       if ENMDA

                               WRITE $$GET1^DIQ(6925,ENDA_",",176)

 +22                       WRITE ?12,$PIECE(ENPN,"-",2,3)

 +23                       WRITE ?21,$EXTRACT($PIECE($GET(^ENG("PROJ",ENDA,0)),U,3),1,30)

 +24                       WRITE ?54,"$",$JUSTIFY($FNUMBER(ENCST,","),9)

 +25                       IF "^MA^MI^MM^NR^"[(U_ENPR_U)

                               Begin DoDot:3

 +26                               IF '(ENAE&ENCO)

                                       WRITE $SELECT(ENAE:" D",ENCO:" C",1:"")

 +27      ;S ENCSTDA=$P($G(^ENG("PROJ",ENDA,5)),U,2)+999\1000

 +28      ;S ENCSTCA=$P($G(^ENG("PROJ",ENDA,1)),U,1)+999\1000

 +29      ;I ENCSTDA>0&(ENCSTD'=ENCSTDA)!(ENCSTCA>0&(ENCSTC'=ENCSTCA)) W ?66,"!"

                               End DoDot:3

 +30                       WRITE ?70,ENPRE

 +31                       WRITE ?83,$EXTRACT($$GET1^DIQ(6925,ENDA_",",158.1),1,20)

 +32      ; W:$O(^ENG("PROJ",ENDA,20,0)) ?106,"YES"

 +33                       IF ENYR'="F"

                               Begin DoDot:3

 +34                               if ENPR="MA"

                                       WRITE ?111,$JUSTIFY($PIECE($GET(^ENG("PROJ",ENDA,24)),U,8),5)

 +35                               WRITE ?118,$$CD(ENDA)

                               End DoDot:3

                       End DoDot:2

                       if END

                           QUIT 

               End DoDot:1

               if END

                   QUIT 

 +36       WRITE !,?54,"----------"

 +37       WRITE !,?5,"TOTAL COST (Excluding Expedited Leases)",?54,"$",$JUSTIFY($FNUMBER($PIECE($GET(ENT(ENYR,"LE")),U)+$PIECE($GET(ENT(ENYR,"MA")),U)+$PIECE($GET(ENT(ENYR,"MI")),U)+$PIECE($GET(ENT(ENYR,"MM")),U)+$PIECE($GET(ENT(ENYR,"NR")),U),","),9)

 +38      ; for long page length

           FOR ENI=$Y+10:1:$SELECT(IOSL>254:$Y+13,1:IOSL)

               WRITE !

 +39      ;F ENI=$Y+10:1:IOSL W !

 +40       WRITE !,?10,"Project Count"

 +41       WRITE "   LEASE (excludes Expedited) = ",$PIECE($GET(ENT(ENYR,"LE")),U,2)+0

 +42       WRITE "   MAJOR = ",$PIECE($GET(ENT(ENYR,"MA")),U,2)+0

 +43       WRITE "   MINOR = ",$PIECE($GET(ENT(ENYR,"MI")),U,2)+0

 +44       WRITE "   MINOR MISC = ",$PIECE($GET(ENT(ENYR,"MM")),U,2)+0

 +45       WRITE "   NRM = ",$PIECE($GET(ENT(ENYR,"NR")),U,2)+0

 +46       DO FT

 +47       QUIT 

HD        ; page header

 +1        DO FYFPHD

 +2        SET ENX=$SELECT(ENFY=ENYR:"CURRENT YEAR APPROVED",ENYR="F":"FUTURE YEARS",1:"BUDGET YEAR")

 +3        if ENFY+1<ENYR

               SET ENX=ENX_" PLUS "_$PIECE("ONE^TWO^THREE^FOUR",U,ENYR-(ENFY+1))

 +4        SET ENX=ENX_" PROJECT LIST"

 +5        if ENYR'="F"

               SET ENX=ENX_" (FY "_ENYR_")"

 +6        WRITE !,?(125-$LENGTH(ENX)\2+5),ENX,!!

 +7        if ENMDA

               WRITE "DIVISION"

 +8        WRITE ?12,"PROJ #",?21,"TITLE",?56,"COST",?65,"*",?70,"PROGRAM"

 +9       ;,?104,"DOMINO"

           WRITE ?83,"PROJECT"

 +10       if ENYR'="F"

               WRITE ?111,"MCPS",?118,"CITED"

 +11       WRITE !,?54,"(in $000)",?83,"CATEGORY"

 +12       if ENYR'="F"

               WRITE ?111,"SCORE",?118,"DEFICIENCY"

 +13       WRITE !

 +14       QUIT 

FT        ; page footer

 +1        WRITE !!,?5,"*    C = Construction dollars only    D = Design dollars only"

 +2        SET ENPG=$GET(ENPG)+1

           WRITE !!,?64,"Page ",ENPG,?100,ENRDT

 +3        IF $EXTRACT(IOST,1,2)="C-"

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               if 'Y

                   SET END=1

 +4        QUIT 

FYFPHD    ; FYFP Header

 +1        if $EXTRACT(IOST,1,2)="C-"!ENPG

               WRITE @IOF

 +2        WRITE !,?56,"FIVE YEAR FACILITY PLAN",!,?ENPGHC,ENPGH

 +3        QUIT 

CD(ENDA)  ; Cited Deficiencies Text Extrinsic Variable

 +1        NEW ENCA,ENCD,ENI

 +2        SET ENCD=""

           SET ENI=0

 +3        FOR 

               SET ENI=$ORDER(^ENG("PROJ",ENDA,21,ENI))

               if 'ENI

                   QUIT 

               Begin DoDot:1

 +4                SET ENCA=$$GET1^DIQ(6925.0164,ENI_","_ENDA_",","3:1")

 +5                IF "^JCAHO^RSFPE^"[(U_ENCA_U)

                       SET $PIECE(ENCD,",",ENCA="RSFPE"+1)=ENCA

               End DoDot:1

 +6        IF $EXTRACT(ENCD)=","

               SET ENCD=$EXTRACT(ENCD,2,99)

 +7        IF ENCD=""

               IF $ORDER(^ENG("PROJ",ENDA,21,0))

                   SET ENCD="OTHER"

 +8        IF ENCD=""

               SET ENCD="NONE"

 +9        QUIT ENCD

 +10      ;ENPL5A