ENPL1 ;(WASH ISC)/LKG,SAB-UTILITY FXS ;6/10/97
;;7.0;ENGINEERING;**23,28**;Aug 17, 1993
A ;Create string of Building Nos. from multiple for display
N Y S Y=0,X=""
F S Y=$O(^ENG("PROJ",D0,34,Y)) Q:Y'?1.N!($L(X)>235) S X=X_$S(X]"":",",1:"")_$P($G(^ENG(6928.3,$P(^ENG("PROJ",D0,34,Y,0),U),0)),U)
Q
V ;Validate format for name
X ^%ZOSF("UPPERCASE") S X=Y
I $TR(X,"-' .")'?1.U1","1.U K X Q
I X[" ,"!(X[", ") K X Q
Q
SH(ENPR) ; executable help for STATUS field
; ENPR - program (internal value)
N ENI,ENY0
I $G(ENPR)]"" S ENI=0 F S ENI=$O(^ENG(6925.2,"AC",ENI)) Q:'ENI D
. S ENY0=$G(^ENG(6925.2,$O(^ENG(6925.2,"AC",ENI,0)),0))
. I $P(ENY0,U,5)[ENPR W ?3,$P(ENY0,U),!
;R " Press RETURN to continue",ENI:DTIME
Q
ECS ; File 6925, Field 158.7 Environmental Category - Screen
S DIC("S")="I $S('$D(ENDA):1,$P($G(^(0)),U,5)=$P($G(^ENG(""PROJ"",ENDA,52)),U):1,'$P($G(^ENG(""PROJ"",ENDA,52)),U):1,'$O(^ENG(6925.3,""AC"",$P(^ENG(""PROJ"",ENDA,52),U),0)):1,1:0)"
Q
XA ; File 6925, Field 233.1 MI/MM CITATION POINTS computed expression
N ENDA,ENF
I $D(D0)#10'=1 S X="" G XAE
I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XAE
S ENDA=D0 D A^ENPL3 S X=$P(ENF,U)+$P(ENF,U,2)
XAE Q
XB ; File 6925, Field 233.2 MI/MM SPACE POINTS computed expression
N ENDA,ENG
I $D(D0)#10'=1 S X="" G XBE
I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XBE
S ENDA=D0 D B^ENPL3 S X=ENG+0
XBE Q
XC ; File 6925, Field 233.3 MI/MM ENERGY POINTS computed expression
N ENDA,ENH
I $D(D0)#10'=1 S X="" G XCE
I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XCE
S ENDA=D0 D C^ENPL3 S X=ENH+0
XCE Q
XD ; File 6925, Field 233.4 MI/MM CATEGORY POINTS computed expression
N ENDA,ENI
I $D(D0)#10'=1 S X="" G XDE
I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XDE
D XB I X>0 S X=0 G XDE ; If space points then no points here
S ENDA=D0 D D^ENPL3 S X=ENI+0
XDE Q
XE ; File 6925, Field 233.5 MI/MM VAMC PRIORITY POINTS computed expression
N ENDA,ENJ
I $D(D0)#10'=1 S X="" G XEE
I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XEE
S ENDA=D0 D E^ENPL3 S X=ENJ+0
XEE Q
XF ; File 6925, Field 262.4 NRM CITATION POINTS computed expression
N ENI,ENP,ENY
I $D(D0)#10'=1 S X="" G XFE
I ",NR,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G XFE
S (ENI,ENP)=0 F S ENI=$O(^ENG("PROJ",D0,21,ENI)) Q:ENI'>0 D
. N %Y,X,X1,X2,Y
. S ENY=$G(^ENG("PROJ",D0,21,ENI,0))
. I '$P(ENY,U,8) Q
. ; base 6-yr limit on 1/15 of current year
. S X1=$E(DT,1,3)_"0115",X2=$P(ENY,U,3) D ^%DTC I X>2190 Q
. S ENP=1
. Q
S X=$S(ENP:12,1:0)
XFE Q
;ENPL1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENPL1 2661 printed Apr 09, 2024@20:56:35 Page 2
ENPL1 ;(WASH ISC)/LKG,SAB-UTILITY FXS ;6/10/97
+1 ;;7.0;ENGINEERING;**23,28**;Aug 17, 1993
A ;Create string of Building Nos. from multiple for display
+1 NEW Y
SET Y=0
SET X=""
+2 FOR
SET Y=$ORDER(^ENG("PROJ",D0,34,Y))
if Y'?1.N!($LENGTH(X)>235)
QUIT
SET X=X_$SELECT(X]"":",",1:"")_$PIECE($GET(^ENG(6928.3,$PIECE(^ENG("PROJ",D0,34,Y,0),U),0)),U)
+3 QUIT
V ;Validate format for name
+1 XECUTE ^%ZOSF("UPPERCASE")
SET X=Y
+2 IF $TRANSLATE(X,"-' .")'?1.U1","1.U
KILL X
QUIT
+3 IF X[" ,"!(X[", ")
KILL X
QUIT
+4 QUIT
SH(ENPR) ; executable help for STATUS field
+1 ; ENPR - program (internal value)
+2 NEW ENI,ENY0
+3 IF $GET(ENPR)]""
SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6925.2,"AC",ENI))
if 'ENI
QUIT
Begin DoDot:1
+4 SET ENY0=$GET(^ENG(6925.2,$ORDER(^ENG(6925.2,"AC",ENI,0)),0))
+5 IF $PIECE(ENY0,U,5)[ENPR
WRITE ?3,$PIECE(ENY0,U),!
End DoDot:1
+6 ;R " Press RETURN to continue",ENI:DTIME
+7 QUIT
ECS ; File 6925, Field 158.7 Environmental Category - Screen
+1 SET DIC("S")="I $S('$D(ENDA):1,$P($G(^(0)),U,5)=$P($G(^ENG(""PROJ"",ENDA,52)),U):1,'$P($G(^ENG(""PROJ"",ENDA,52)),U):1,'$O(^ENG(6925.3,""AC"",$P(^ENG(""PROJ"",ENDA,52),U),0)):1,1:0)"
+2 QUIT
XA ; File 6925, Field 233.1 MI/MM CITATION POINTS computed expression
+1 NEW ENDA,ENF
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XAE
+3 IF ",MI,MM,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XAE
+4 SET ENDA=D0
DO A^ENPL3
SET X=$PIECE(ENF,U)+$PIECE(ENF,U,2)
XAE QUIT
XB ; File 6925, Field 233.2 MI/MM SPACE POINTS computed expression
+1 NEW ENDA,ENG
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XBE
+3 IF ",MI,MM,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XBE
+4 SET ENDA=D0
DO B^ENPL3
SET X=ENG+0
XBE QUIT
XC ; File 6925, Field 233.3 MI/MM ENERGY POINTS computed expression
+1 NEW ENDA,ENH
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XCE
+3 IF ",MI,MM,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XCE
+4 SET ENDA=D0
DO C^ENPL3
SET X=ENH+0
XCE QUIT
XD ; File 6925, Field 233.4 MI/MM CATEGORY POINTS computed expression
+1 NEW ENDA,ENI
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XDE
+3 IF ",MI,MM,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XDE
+4 ; If space points then no points here
DO XB
IF X>0
SET X=0
GOTO XDE
+5 SET ENDA=D0
DO D^ENPL3
SET X=ENI+0
XDE QUIT
XE ; File 6925, Field 233.5 MI/MM VAMC PRIORITY POINTS computed expression
+1 NEW ENDA,ENJ
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XEE
+3 IF ",MI,MM,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XEE
+4 SET ENDA=D0
DO E^ENPL3
SET X=ENJ+0
XEE QUIT
XF ; File 6925, Field 262.4 NRM CITATION POINTS computed expression
+1 NEW ENI,ENP,ENY
+2 IF $DATA(D0)#10'=1
SET X=""
GOTO XFE
+3 IF ",NR,"'[(","_$PIECE($GET(^ENG("PROJ",D0,0)),U,6)_",")
SET X=""
GOTO XFE
+4 SET (ENI,ENP)=0
FOR
SET ENI=$ORDER(^ENG("PROJ",D0,21,ENI))
if ENI'>0
QUIT
Begin DoDot:1
+5 NEW %Y,X,X1,X2,Y
+6 SET ENY=$GET(^ENG("PROJ",D0,21,ENI,0))
+7 IF '$PIECE(ENY,U,8)
QUIT
+8 ; base 6-yr limit on 1/15 of current year
+9 SET X1=$EXTRACT(DT,1,3)_"0115"
SET X2=$PIECE(ENY,U,3)
DO ^%DTC
IF X>2190
QUIT
+10 SET ENP=1
+11 QUIT
End DoDot:1
+12 SET X=$SELECT(ENP:12,1:0)
XFE QUIT
+1 ;ENPL1
