ENFAVAL ;(WIRMFO)/KLD/SAB; VALIDITY CHECKS FOR Fx DOCS ;2/18/99
;;7.0;ENGINEERING;**25,29,33,38,39,46,60**;Aug 17, 1993
ST ;
N ENC,X
S ENC("BAD")=0
F I=1:1 X "S T=$P($T("_ENFAP("DOC")_"CHK+I),"";;"",2)" Q:T["END" D
. I ENFAP("DOC")="FA" D Q
. . Q:$P(ENEQ(+T),U,$P(T,";",2))]"" D SET("Missing "_$P(T,";",3))
. Q:$P(ENFAP(+T),U,$P(T,";",2))]"" D SET("Missing "_$P(T,";",3))
I ENFAP("DOC")="FA" D FA
I ENFAP("DOC")="FC" D FC
I ENFAP("DOC")="FD" D FD
I ENFAP("DOC")="FR" D FR
I ENC("BAD")>0 S ^TMP($J,"BAD",ENEQ("DA"))=ENC("BAD")
K I,T Q
;
FA ;Check for appropriate values of certain required fields
I $P(ENEQ(2),U,3)]"" D:$P(ENEQ(2),U,3)'>0 SET("Asset Value must be greater than 0.00")
I $P(ENEQ(3),U,4)]"" D:$P(ENEQ(3),U,4)>0 SET("Acquisition Method inappropriate")
I $P(ENEQ(0),U,4)]"" D:$P(ENEQ(0),U,4)'="NX" SET("Not non-expendable")
D:'$P(ENEQ(8),U,2) SET("Asset not capitalized")
I $P(ENEQ(9),U,6)]"" D
. S X=$G(^ENG(6914.4,$P(ENEQ(9),U,6),0))
. I $P(X,U)="" D SET("BOC invalid pointer")
. I $P(X,U,5)]"",$P(X,U,5)'>DT D SET("BOC has been deactivated")
I $P(ENEQ(8),U,6)]"" D
. I '$D(^ENG(6914.3,$P(ENEQ(8),U,6))) D SET("SGL invalid pointer") Q
. S X=$G(^ENG(6914.3,$P(ENEQ(8),U,6),0))
. I $P(X,U)="6100" D SET("NX SGL account of 6100")
. I $P(X,U,5)]"",$P(X,U,5)'>DT D SET("SGL has been deactivated")
I $P(ENEQ(9),U,7)]"" D
. S X=$G(^ENG(6914.6,$P(ENEQ(9),U,7),0))
. I $P(X,U)="" D SET("FUND invalid pointer")
. I $P(X,U,5)]"",$P(X,U,5)'>DT D SET("FUND has been deactivated")
I $P(ENEQ(2),U,9)]"" D
. S ENFAP("LOC")=$$LOC($$GET1^DIQ(6914,ENEQ("DA"),19))
. I ENFAP("LOC")="" D SET("Invalid CMR") Q
. I $P(ENEQ(9),U,8)]"" D
. . S X=$O(^ENG(6914.9,"B",ENFAP("LOC"),0))
. . Q:'X
. . S Y=$P($G(^ENG(6914.9,X,0)),U,4)
. . I Y]"",Y'=$P(ENEQ(9),U,8) D SET("CMR inappropriate for A/O")
I $P(ENEQ(2),U,8)]"" D
. S ENFAP("GRP")=$$GROUP($$GET1^DIQ(6914,ENEQ("DA"),18))
. I 'ENFAP("GRP") D SET("Invalid CSN") Q
. I $P(ENEQ(8),U,6)]"",'$O(^ENG(6914.3,$P(ENEQ(8),U,6),1,"B",ENFAP("GRP"),0)) D SET("CSN inappropriate for SGL")
I $P(ENEQ(2),U,4)]"",+$E($P(ENEQ(2),U,4),4,5)'>0 D SET("Acquisition Month Missing")
I $P(ENEQ(2),U,10)]"" D
. I +$E($P(ENEQ(2),U,10),4,5)'>0 D SET("Replacement Month Missing")
. I $P(ENEQ(2),U,4)]"",$P(ENEQ(2),U,10)<$P(ENEQ(2),U,4) D SET("Replacement Date preceeds Acquisition Date")
Q
;
FC ;Check for problems with CSN and/or CMR
I $P(ENFAP(100),U)]"" D
. I $P(ENFAP(3),U,9)="" D SET("CSN is unacceptable for capitalized NX") Q
. I $P(ENEQ(8),U,6)]"",'$O(^ENG(6914.3,$P(ENEQ(8),U,6),1,"B",$P(ENFAP(3),U,9),0)) D SET("CSN inappropriate for SGL")
I $P(ENFAP(100),U,2)]"",$P(ENFAP(3),U,10)="" D SET("CMR is unacceptable for capitalized NX")
;check date order (ACQUISITION & REPLACEMENT)
I $P(ENFAP(100),U,6)]""!($P(ENFAP(100),U,7)]"") D
. N ENAD,ENRD
. S ENAD=$S($P(ENFAP(100),U,6)]"":$P(ENFAP(100),U,6),1:$P(ENEQ(2),U,4))
. S ENRD=$S($P(ENFAP(100),U,7)]"":$P(ENFAP(100),U,7),1:$P(ENEQ(2),U,10))
. I ENAD=""!(ENRD="") Q
. I ENRD'>ENAD D SET("REPLACEMENT DATE must follow ACQUISITION DATE.")
Q
;
FD ; Check for probems with disp date
I $P(ENFAP(100),U,3)>DT D SET("DISPOSITION DATE must not be later than Today.")
Q
;
FR ; Check for problems with CMR
I $P(ENFAP(100),U,6)]"",$$LOC($P($G(^ENG(6914.1,$P(ENFAP(100),U,6),0)),U))="" D SET("CMR is unacceptable for capitalized NX")
I $P(ENFAP(100),U,3)]""!($P(ENFAP(100),U,6)]"") D ; new A/O or new CMR
. N ENAO,ENCMR
. S ENAO=$S($P(ENFAP(100),U,3)]"":$P(ENFAP(100),U,3),1:$P(ENEQ(9),U,8))
. S ENCMR=$S($P(ENFAP(100),U,6)]"":$P(ENFAP(100),U,6),1:$P(ENEQ(2),U,9))
. I ENAO=""!(ENCMR="") Q
. S ENFAP("LOC")=$$LOC($P($G(^ENG(6914.1,ENCMR,0)),U))
. I ENFAP("LOC")="" Q
. S X=$O(^ENG(6914.9,"B",ENFAP("LOC"),0))
. I X'>0 Q
. S Y=$P($G(^ENG(6914.9,X,0)),U,4)
. I Y]"",Y'=ENAO D SET("CMR inappropriate for A/O")
I $P(ENFAP(100),U,5)]"" D
. S X=$G(^ENG(6914.4,$P(ENFAP(100),U,5),0))
. I $P(X,U)="" D SET("BOC invalid pointer")
. I $P(X,U,5)]"",$P(X,U,5)'>DT D SET("BOC has been deactivated")
I $P(ENFAP(100),U,2)]"" D
. S X=$G(^ENG(6914.6,$P(ENFAP(100),U,2),0))
. I $P(X,U)="" D SET("FUND invalid pointer")
. I $P(X,U,5)]"",$P(X,U,5)'>DT D SET("FUND has been deactivated")
Q
SET(X) ;Record problems
S ENC("BAD")=ENC("BAD")+1,^TMP($J,"BAD",ENEQ("DA"),ENC("BAD"))=X
Q
;
LOC(CMR) ;Accepts CMR and checks 1st two char
;Returns FAP LOCATION (EIL)
S ENFAP("LOC")=$E(CMR,1,2) I ENFAP("LOC")'?2N S ENFAP("LOC")="" G LOCDN
I ENFAP("LOC")]"",'$D(^ENG(6914.9,"B",ENFAP("LOC"))) S ENFAP("LOC")=""
;I "^73^74^79^"[(U_ENFAP("LOC")_U) S ENFAP("LOC")=""
;I ENFAP("LOC")>83,"^86^88^90^98^99^"'[(U_ENFAP("LOC")_U) S ENFAP("LOC")=""
LOCDN Q ENFAP("LOC")
;
GROUP(CSN) ;Accepts CSN and returns FAP GROUP
N FSC S FSC=$E(CSN,1,4) ;Federal Supply Classification
I FSC'?4N S ENFAP("GRP")=0 G GRPDUN
I "7020^7021^7025^7035^7040^7050^7435"[FSC S ENFAP("GRP")=FSC
E S ENFAP("GRP")=$E(FSC,1,2)_"00"
GRPDUN Q ENFAP("GRP")
;
FACHK ;;
;;0;4;Type of Entry
;;8;6;General Ledger Account
;;2;8;Category Stock Number
;;2;9;CMR
;;2;4;Acquisition Date
;;9;7;Fund
;;9;8;A.O. Code
;;9;6;Budget Object Code
;;2;6;Life Expectancy
;;2;3;Acquisition Value
;;3;4;Acquitition Method
;;9;9;Equity Account
;;END
FBCHK ;;
;;3;7;Betterment Number
;;3;12;Acquisition Method
;;6;2;Equity Account
;;4;4;Dollar Amount
;;END
FCCHK ;;
;;3;8;Betterment Number
;;END
FDCHK ;;
;;5;4;Disposition Method
;;5;5;Disposition Year
;;5;6;Disposition Month
;;5;7;Disposition Day
;;5;8;Selling Price
;;5;9;Disposition Authority
;;END
FRCHK ;;
;;3;9;New Fund Code
;;3;10;New A.O. Code
;;3;11;New Owning Station
;;3;12;New Xprogram
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAVAL 5802 printed Oct 16, 2024@17:54:39 Page 2
ENFAVAL ;(WIRMFO)/KLD/SAB; VALIDITY CHECKS FOR Fx DOCS ;2/18/99
+1 ;;7.0;ENGINEERING;**25,29,33,38,39,46,60**;Aug 17, 1993
ST ;
+1 NEW ENC,X
+2 SET ENC("BAD")=0
+3 FOR I=1:1
XECUTE "S T=$P($T("_ENFAP("DOC")_"CHK+I),"";;"",2)"
if T["END"
QUIT
Begin DoDot:1
+4 IF ENFAP("DOC")="FA"
Begin DoDot:2
+5 if $PIECE(ENEQ(+T),U,$PIECE(T,";",2))]""
QUIT
DO SET("Missing "_$PIECE(T,";",3))
End DoDot:2
QUIT
+6 if $PIECE(ENFAP(+T),U,$PIECE(T,";",2))]""
QUIT
DO SET("Missing "_$PIECE(T,";",3))
End DoDot:1
+7 IF ENFAP("DOC")="FA"
DO FA
+8 IF ENFAP("DOC")="FC"
DO FC
+9 IF ENFAP("DOC")="FD"
DO FD
+10 IF ENFAP("DOC")="FR"
DO FR
+11 IF ENC("BAD")>0
SET ^TMP($JOB,"BAD",ENEQ("DA"))=ENC("BAD")
+12 KILL I,T
QUIT
+13 ;
FA ;Check for appropriate values of certain required fields
+1 IF $PIECE(ENEQ(2),U,3)]""
if $PIECE(ENEQ(2),U,3)'>0
DO SET("Asset Value must be greater than 0.00")
+2 IF $PIECE(ENEQ(3),U,4)]""
if $PIECE(ENEQ(3),U,4)>0
DO SET("Acquisition Method inappropriate")
+3 IF $PIECE(ENEQ(0),U,4)]""
if $PIECE(ENEQ(0),U,4)'="NX"
DO SET("Not non-expendable")
+4 if '$PIECE(ENEQ(8),U,2)
DO SET("Asset not capitalized")
+5 IF $PIECE(ENEQ(9),U,6)]""
Begin DoDot:1
+6 SET X=$GET(^ENG(6914.4,$PIECE(ENEQ(9),U,6),0))
+7 IF $PIECE(X,U)=""
DO SET("BOC invalid pointer")
+8 IF $PIECE(X,U,5)]""
IF $PIECE(X,U,5)'>DT
DO SET("BOC has been deactivated")
End DoDot:1
+9 IF $PIECE(ENEQ(8),U,6)]""
Begin DoDot:1
+10 IF '$DATA(^ENG(6914.3,$PIECE(ENEQ(8),U,6)))
DO SET("SGL invalid pointer")
QUIT
+11 SET X=$GET(^ENG(6914.3,$PIECE(ENEQ(8),U,6),0))
+12 IF $PIECE(X,U)="6100"
DO SET("NX SGL account of 6100")
+13 IF $PIECE(X,U,5)]""
IF $PIECE(X,U,5)'>DT
DO SET("SGL has been deactivated")
End DoDot:1
+14 IF $PIECE(ENEQ(9),U,7)]""
Begin DoDot:1
+15 SET X=$GET(^ENG(6914.6,$PIECE(ENEQ(9),U,7),0))
+16 IF $PIECE(X,U)=""
DO SET("FUND invalid pointer")
+17 IF $PIECE(X,U,5)]""
IF $PIECE(X,U,5)'>DT
DO SET("FUND has been deactivated")
End DoDot:1
+18 IF $PIECE(ENEQ(2),U,9)]""
Begin DoDot:1
+19 SET ENFAP("LOC")=$$LOC($$GET1^DIQ(6914,ENEQ("DA"),19))
+20 IF ENFAP("LOC")=""
DO SET("Invalid CMR")
QUIT
+21 IF $PIECE(ENEQ(9),U,8)]""
Begin DoDot:2
+22 SET X=$ORDER(^ENG(6914.9,"B",ENFAP("LOC"),0))
+23 if 'X
QUIT
+24 SET Y=$PIECE($GET(^ENG(6914.9,X,0)),U,4)
+25 IF Y]""
IF Y'=$PIECE(ENEQ(9),U,8)
DO SET("CMR inappropriate for A/O")
End DoDot:2
End DoDot:1
+26 IF $PIECE(ENEQ(2),U,8)]""
Begin DoDot:1
+27 SET ENFAP("GRP")=$$GROUP($$GET1^DIQ(6914,ENEQ("DA"),18))
+28 IF 'ENFAP("GRP")
DO SET("Invalid CSN")
QUIT
+29 IF $PIECE(ENEQ(8),U,6)]""
IF '$ORDER(^ENG(6914.3,$PIECE(ENEQ(8),U,6),1,"B",ENFAP("GRP"),0))
DO SET("CSN inappropriate for SGL")
End DoDot:1
+30 IF $PIECE(ENEQ(2),U,4)]""
IF +$EXTRACT($PIECE(ENEQ(2),U,4),4,5)'>0
DO SET("Acquisition Month Missing")
+31 IF $PIECE(ENEQ(2),U,10)]""
Begin DoDot:1
+32 IF +$EXTRACT($PIECE(ENEQ(2),U,10),4,5)'>0
DO SET("Replacement Month Missing")
+33 IF $PIECE(ENEQ(2),U,4)]""
IF $PIECE(ENEQ(2),U,10)<$PIECE(ENEQ(2),U,4)
DO SET("Replacement Date preceeds Acquisition Date")
End DoDot:1
+34 QUIT
+35 ;
FC ;Check for problems with CSN and/or CMR
+1 IF $PIECE(ENFAP(100),U)]""
Begin DoDot:1
+2 IF $PIECE(ENFAP(3),U,9)=""
DO SET("CSN is unacceptable for capitalized NX")
QUIT
+3 IF $PIECE(ENEQ(8),U,6)]""
IF '$ORDER(^ENG(6914.3,$PIECE(ENEQ(8),U,6),1,"B",$PIECE(ENFAP(3),U,9),0))
DO SET("CSN inappropriate for SGL")
End DoDot:1
+4 IF $PIECE(ENFAP(100),U,2)]""
IF $PIECE(ENFAP(3),U,10)=""
DO SET("CMR is unacceptable for capitalized NX")
+5 ;check date order (ACQUISITION & REPLACEMENT)
+6 IF $PIECE(ENFAP(100),U,6)]""!($PIECE(ENFAP(100),U,7)]"")
Begin DoDot:1
+7 NEW ENAD,ENRD
+8 SET ENAD=$SELECT($PIECE(ENFAP(100),U,6)]"":$PIECE(ENFAP(100),U,6),1:$PIECE(ENEQ(2),U,4))
+9 SET ENRD=$SELECT($PIECE(ENFAP(100),U,7)]"":$PIECE(ENFAP(100),U,7),1:$PIECE(ENEQ(2),U,10))
+10 IF ENAD=""!(ENRD="")
QUIT
+11 IF ENRD'>ENAD
DO SET("REPLACEMENT DATE must follow ACQUISITION DATE.")
End DoDot:1
+12 QUIT
+13 ;
FD ; Check for probems with disp date
+1 IF $PIECE(ENFAP(100),U,3)>DT
DO SET("DISPOSITION DATE must not be later than Today.")
+2 QUIT
+3 ;
FR ; Check for problems with CMR
+1 IF $PIECE(ENFAP(100),U,6)]""
IF $$LOC($PIECE($GET(^ENG(6914.1,$PIECE(ENFAP(100),U,6),0)),U))=""
DO SET("CMR is unacceptable for capitalized NX")
+2 ; new A/O or new CMR
IF $PIECE(ENFAP(100),U,3)]""!($PIECE(ENFAP(100),U,6)]"")
Begin DoDot:1
+3 NEW ENAO,ENCMR
+4 SET ENAO=$SELECT($PIECE(ENFAP(100),U,3)]"":$PIECE(ENFAP(100),U,3),1:$PIECE(ENEQ(9),U,8))
+5 SET ENCMR=$SELECT($PIECE(ENFAP(100),U,6)]"":$PIECE(ENFAP(100),U,6),1:$PIECE(ENEQ(2),U,9))
+6 IF ENAO=""!(ENCMR="")
QUIT
+7 SET ENFAP("LOC")=$$LOC($PIECE($GET(^ENG(6914.1,ENCMR,0)),U))
+8 IF ENFAP("LOC")=""
QUIT
+9 SET X=$ORDER(^ENG(6914.9,"B",ENFAP("LOC"),0))
+10 IF X'>0
QUIT
+11 SET Y=$PIECE($GET(^ENG(6914.9,X,0)),U,4)
+12 IF Y]""
IF Y'=ENAO
DO SET("CMR inappropriate for A/O")
End DoDot:1
+13 IF $PIECE(ENFAP(100),U,5)]""
Begin DoDot:1
+14 SET X=$GET(^ENG(6914.4,$PIECE(ENFAP(100),U,5),0))
+15 IF $PIECE(X,U)=""
DO SET("BOC invalid pointer")
+16 IF $PIECE(X,U,5)]""
IF $PIECE(X,U,5)'>DT
DO SET("BOC has been deactivated")
End DoDot:1
+17 IF $PIECE(ENFAP(100),U,2)]""
Begin DoDot:1
+18 SET X=$GET(^ENG(6914.6,$PIECE(ENFAP(100),U,2),0))
+19 IF $PIECE(X,U)=""
DO SET("FUND invalid pointer")
+20 IF $PIECE(X,U,5)]""
IF $PIECE(X,U,5)'>DT
DO SET("FUND has been deactivated")
End DoDot:1
+21 QUIT
SET(X) ;Record problems
+1 SET ENC("BAD")=ENC("BAD")+1
SET ^TMP($JOB,"BAD",ENEQ("DA"),ENC("BAD"))=X
+2 QUIT
+3 ;
LOC(CMR) ;Accepts CMR and checks 1st two char
+1 ;Returns FAP LOCATION (EIL)
+2 SET ENFAP("LOC")=$EXTRACT(CMR,1,2)
IF ENFAP("LOC")'?2N
SET ENFAP("LOC")=""
GOTO LOCDN
+3 IF ENFAP("LOC")]""
IF '$DATA(^ENG(6914.9,"B",ENFAP("LOC")))
SET ENFAP("LOC")=""
+4 ;I "^73^74^79^"[(U_ENFAP("LOC")_U) S ENFAP("LOC")=""
+5 ;I ENFAP("LOC")>83,"^86^88^90^98^99^"'[(U_ENFAP("LOC")_U) S ENFAP("LOC")=""
LOCDN QUIT ENFAP("LOC")
+1 ;
GROUP(CSN) ;Accepts CSN and returns FAP GROUP
+1 ;Federal Supply Classification
NEW FSC
SET FSC=$EXTRACT(CSN,1,4)
+2 IF FSC'?4N
SET ENFAP("GRP")=0
GOTO GRPDUN
+3 IF "7020^7021^7025^7035^7040^7050^7435"[FSC
SET ENFAP("GRP")=FSC
+4 IF '$TEST
SET ENFAP("GRP")=$EXTRACT(FSC,1,2)_"00"
GRPDUN QUIT ENFAP("GRP")
+1 ;
FACHK ;;
+1 ;;0;4;Type of Entry
+2 ;;8;6;General Ledger Account
+3 ;;2;8;Category Stock Number
+4 ;;2;9;CMR
+5 ;;2;4;Acquisition Date
+6 ;;9;7;Fund
+7 ;;9;8;A.O. Code
+8 ;;9;6;Budget Object Code
+9 ;;2;6;Life Expectancy
+10 ;;2;3;Acquisition Value
+11 ;;3;4;Acquitition Method
+12 ;;9;9;Equity Account
+13 ;;END
FBCHK ;;
+1 ;;3;7;Betterment Number
+2 ;;3;12;Acquisition Method
+3 ;;6;2;Equity Account
+4 ;;4;4;Dollar Amount
+5 ;;END
FCCHK ;;
+1 ;;3;8;Betterment Number
+2 ;;END
FDCHK ;;
+1 ;;5;4;Disposition Method
+2 ;;5;5;Disposition Year
+3 ;;5;6;Disposition Month
+4 ;;5;7;Disposition Day
+5 ;;5;8;Selling Price
+6 ;;5;9;Disposition Authority
+7 ;;END
FRCHK ;;
+1 ;;3;9;New Fund Code
+2 ;;3;10;New A.O. Code
+3 ;;3;11;New Owning Station
+4 ;;3;12;New Xprogram
+5 ;;END
