Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENPL3

ENPL3.m

Go to the documentation of this file.
  1. ENPL3 ;(WASH ISC)/LKG,SAB-MINOR/MINOR MISC PRIORITIZATION ;5/12/95
  1. ;;7.0;ENGINEERING;**11,23**;Aug 17, 1993
  1. IN ;Calculation of VAMC Priority points by section and generating Total
  1. D A,B,C,D,E,F,G
  1. Q
  1. A ; Citation Points
  1. N %Y,ENA,ENB,ENC,END,ENE,X,X1,X2,Y
  1. K ENF S ENA=0
  1. AA S ENA=$O(^ENG("PROJ",ENDA,21,ENA)) G:ENA'?1.N AE
  1. S ENB=$G(^ENG("PROJ",ENDA,21,ENA,0)) G AA:'$P(ENB,U,8)
  1. ; base 6-yr limit on 1/15 of current year
  1. S X1=$E(DT,1,3)_"0115",X2=$P(ENB,U,3) D ^%DTC G:X>2190 AA
  1. S ENC=$P(ENB,U,4) G AA:ENC'?1.N,AA:$D(^OFM(7335.7,ENC,0))#10'=1
  1. S END=^OFM(7335.7,ENC,0),ENE=$P(END,U,8) G:'ENE AA
  1. S X=$P(ENB,U,3) D I
  1. S ENF(ENE)=$G(ENF(ENE))+1,ENF(ENE,ENF(ENE))=Y_U_$P(ENB,U,5)_U_$P(ENB,U,6)_"/"_$P(ENB,U,7)
  1. G AA
  1. AE S ENF=$S($D(ENF(1))#10'=1:0,ENF(1)<3:ENF(1)*5,1:10)_U_$S($D(ENF(2))#10'=1:0,ENF(2)<3:ENF(2)*5,1:10)
  1. Q
  1. B ; Space Points
  1. N ENA,ENB,ENC
  1. K ENG S ENG="0^Not Applicable"
  1. S ENB=$S($D(^ENG("PROJ",ENDA,0))#10:$P(^(0),U,6),1:"")
  1. G:",MI,MM,"'[(","_ENB_",") BE
  1. S ENA=$P($G(^ENG("PROJ",ENDA,18)),U,2) G BE:ENA'?1.N,BE:$D(^OFM(7336.3,ENA,0))#10'=1
  1. S ENC=^OFM(7336.3,ENA,0),ENG=$P(ENC,U,ENB="MM"+3)+0_U_$P(ENC,U)
  1. BE ;
  1. Q
  1. C ; Energy Points
  1. N ENA,ENB
  1. K ENH S ENH="0^Not Applicable"
  1. S ENB=$S($D(^ENG("PROJ",ENDA,0))#10:$P(^(0),U,6),1:"")
  1. G:",MI,MM,"'[(","_ENB_",") CE
  1. S ENA=$G(^ENG("PROJ",ENDA,15)) ; G:$P(ENA,U,17)'="Y" CE
  1. S ENA=+$P(ENA,U,11)
  1. S ENH=$S(ENA>5:"5^Above 5",ENA>4:"4^Between 4-5",ENA>3:"3^Between 3-4",ENA>2:"2^Between 2-3",ENA>1:"1^Below 2",1:"0^Not Applicable")
  1. CE ;
  1. Q
  1. D ; Category Points
  1. N ENA,ENB,ENC,END,ENE
  1. K ENI S ENI="0^Not Applicable"
  1. S ENB=$S($D(^ENG("PROJ",ENDA,0))#10:$P(^(0),U,6),1:"")
  1. G DE:",MI,MM,"'[(","_ENB_","),DE:$P($G(^ENG("PROJ",ENDA,18)),U,4)'="Y"
  1. S ENA=$P($G(^ENG("PROJ",ENDA,52)),U) G:ENA'?1.N DE
  1. G:'$D(^OFM(7336.8,ENA)) DE
  1. S ENE=$P($G(^OFM(7336.8,ENA,0)),U,1,4)
  1. S ENC=$P($G(^OFM(7336.8,ENA,1)),U,ENB="MM"+6)
  1. I $P(ENE,U)["SEISM" D
  1. . S END=+$P($G(^ENG("PROJ",ENDA,18)),U,3)
  1. . S ENC=$P(ENC,"/",END)
  1. S ENI=+ENC_U_$P(ENE,U,4)_$S($P(ENE,U)["SEISM":" AREA CAT "_$P("I^II^III",U,END),1:"")
  1. DE ;
  1. Q
  1. E ; VAMC Priority Points
  1. N ENA,ENB,ENC
  1. K ENJ S ENJ="0^NOT a Priority"
  1. S ENB=$S($D(^ENG("PROJ",ENDA,0))#10:$P(^(0),U,6),1:"")
  1. G:",MI,MM,"'[(","_ENB_",") EE
  1. S ENA=$P($G(^ENG("PROJ",ENDA,15)),U,9) G:ENA="" EE
  1. I ENB="MI" S ENC=$S(1:0,ENA=1:10,ENA=2:5,1:0) G EA ; unknown
  1. S ENC=$S(1:0,ENA>0&(ENA<5):15-(ENA*3),1:0) ; unknown
  1. EA S ENJ=ENC_U_"PRIORITY "_ENA
  1. EE ;
  1. Q
  1. F ; allowed Space, Energy, Category combination
  1. K ENK
  1. S ENK=$S(+ENG>0:+ENG_U_+ENH_"^0",1:"0^"_+ENH_"^"_+ENI)
  1. FE ;
  1. Q
  1. G ; VAMC & Factor Subtotal
  1. K ENX
  1. S ENX=ENF+$P(ENF,U,2)+ENK+$P(ENK,U,2)+$P(ENK,U,3)+ENJ
  1. Q
  1. H N ENA,ENB,ENC,END S ENA="",ENB="",ENC="",END="" K ENL
  1. HA S ENA=$O(^ENG("PROJ","AB",ENDA,ENA)) G:ENA="" HE
  1. S ENC=$G(^ENG("PROJ",ENA,0)),ENB=$P(ENC,U,6) G HA:",MA,MI,"'[(","_ENB_",")
  1. S END=$P($G(^ENG("PROJ",ENA,1)),U,3) G:END'?1.N HA
  1. G:'$P($G(^ENG(6925.2,END,0)),U,3) HA
  1. S ENL($P(ENC,U))=$P(ENC,U,3)_U_$S(ENB="MA":"MAJOR",1:"MINOR")
  1. G HA
  1. HE Q
  1. I I X'?1.N S Y="" Q
  1. S X=X+17000000,Y=$S($E(X,7)=0:" ",1:"")_+$E(X,7,8)_" "_$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,+$E(X,5,6))_" "_$E(X,1,4)
  1. Q
  1. J S X="FY "_$S($D(^ENG("PROJ",ENDA,5))#10:$P(^(5),U,7),1:"XXXX")_" MINOR "
  1. S X=X_$P("DESIGN^MISCELLANEOUS",U,$P($G(^ENG("PROJ",ENDA,0)),U,6)="MM"+1)
  1. S X=X_" PRIORITIZATION SCORING SHEET"
  1. Q
  1. K ;Entry point for computed expression to calculate VAMC Minor/Minor Misc.
  1. ;;Prioritization Methodology Score
  1. N ENF,ENG,ENH,ENI,ENJ,ENK,ENX,ENDA
  1. I $D(D0)#10'=1 S X="" G KE
  1. I ",MI,MM,"'[(","_$P($G(^ENG("PROJ",D0,0)),U,6)_",") S X="" G KE
  1. S ENDA=D0 D IN S X=ENX
  1. KE Q
  1. ;ENPL3