- 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 Dec 13, 2024@01:53:50 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