ENFARC3 ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER (CONT); 12/16/1998
;;7.0;ENGINEERING;**39,60**;Aug 17, 1993
Q
;
FCPVAL(ENFILE,ENIEN,ENFAIEN) ; Determine prior values at time of FC
; Input Variables
; ENFILE - FAP document file for the input document
; ENIEN - IEN of the input document in ENFILE
; ENFAIEN - IEN of the assoicated FA document
; Returns
; EN(30) - previous DESCRIPTION
; EN(34) - previous ACQ METHOD CODE
; EN(105) - previous ACQ DATE (FileMan format)
; also when betterment = 00
; EN(29) - previous LOCATION (NATIONAL EIL)
; EN(37) - previous USEFUL LIFE
; EN(106) - previous REPL DATE (FileMan format)
Q:ENFILE'=6915.4 ; must be FC Document
N ENDA,ENDOC,ENDTC,ENFC,ENY
; get initial values (from FA or FB)
S (EN(30),EN(34),EN(105),EN(29),EN(37),EN(106))=""
S ENFC("BETR")=$P($G(^ENG(ENFILE,ENIEN,3)),U,8)
I ENFC("BETR")="00" D
. S ENDTC("I")=$P($G(^ENG(6915.2,ENFAIEN,0)),U,2) ; date/time of FA
. S ENY(3)=$G(^ENG(6915.2,ENFAIEN,3))
. S EN(30)=$P(ENY(3),U,15)
. S EN(34)=$P(ENY(3),U,19)
. I $P(ENY(3),U,16)]"" D
. . S EN(105)=$P(ENY(3),U,16)-1700
. . S EN(105)=EN(105)_$E("00",1,2-$L($P(ENY(3),U,17)))_$P(ENY(3),U,17)
. . S EN(105)=EN(105)_$E("00",1,2-$L($P(ENY(3),U,18)))_$P(ENY(3),U,18)
. S EN(29)=$P(ENY(3),U,8)
. S EN(37)=$P(ENY(3),U,24)
. I $P(ENY(3),U,21)]"" D
. . S EN(106)=$P(ENY(3),U,21)-1700
. . S EN(106)=EN(106)_$E("00",1,2-$L($P(ENY(3),U,22)))_$P(ENY(3),U,22)
. . S EN(106)=EN(106)_$E("00",1,2-$L($P(ENY(3),U,23)))_$P(ENY(3),U,23)
I ENFC("BETR")'="00" D
. S ENFC("FB")=$P($G(^ENG(6915.4,ENIEN,100)),U,5) ; betterment pointer
. S ENDTC("I")=$P($G(^ENG(6915.3,ENFC("FB"),0)),U,2) ; date/time of FB
. S ENY(3)=$S(ENFC("FB"):$G(^ENG(6915.3,ENFC("FB"),3)),1:"")
. S EN(30)=$P(ENY(3),U,8)
. S EN(34)=$P(ENY(3),U,12)
. I $P(ENY(3),U,9)]"" D
. . S EN(105)=$P(ENY(3),U,9)-1700
. . S EN(105)=EN(105)_$E("00",1,2-$L($P(ENY(3),U,10)))_$P(ENY(3),U,10)
. . S EN(105)=EN(105)_$E("00",1,2-$L($P(ENY(3),U,11)))_$P(ENY(3),U,11)
; Construct chrono list of FC and FR in time frame for Equipment
S ENY(0)=$G(^ENG(ENFILE,ENIEN,0))
S ENDA("EQ")=$P(ENY(0),U) ; equip id
S ENDTC("F?")=$P(ENY(0),U,2) ; date/time of input doc
; add FC documents to list
S ENDA("FC")=0
F S ENDA("FC")=$O(^ENG(6915.4,"B",ENDA("EQ"),ENDA("FC"))) Q:'ENDA("FC") D
. S ENDTC("FC")=$P($G(^ENG(6915.4,ENDA("FC"),0)),U,2)
. I ENDTC("FC")>ENDTC("I"),ENDTC("FC")<ENDTC("F?") D
. . Q:ENFC("BETR")'=$P($G(^ENG(ENFILE,ENDA("FC"),3)),U,8) ; diff betr
. . S ENDOC(ENDTC("FC"),"6915.4;"_ENDA("FC"))=""
; add FR documents to list
S ENDA("FR")=0
F S ENDA("FR")=$O(^ENG(6915.6,"B",ENDA("EQ"),ENDA("FR"))) Q:'ENDA("FR") D
. S ENDTC("FR")=$P($G(^ENG(6915.6,ENDA("FR"),0)),U,2)
. I ENDTC("FR")>ENDTC("I"),ENDTC("FR")<ENDTC("F?") D
. . S ENDOC(ENDTC("FR"),"6915.6;"_ENDA("FR"))=""
; Loop thru chrono list and update initial values as appropriate
S ENDTC="" F S ENDTC=$O(ENDOC(ENDTC)) Q:ENDTC="" D
. S ENY="" F S ENY=$O(ENDOC(ENDTC,ENY)) Q:ENY="" D
. . S ENFILE=$P(ENY,";"),ENDA=$P(ENY,";",2)
. . I ENFILE=6915.4 D ; FC Document
. . . S ENY(3)=$G(^ENG(6915.4,ENDA,3))
. . . S ENY(4)=$G(^ENG(6915.4,ENDA,4))
. . . S ENY(100)=$G(^ENG(6915.4,ENDA,100))
. . . S:$P(ENY(3),U,11)]"" EN(30)=$P(ENY(3),U,11)
. . . S:$P(ENY(3),U,15)]"" EN(34)=$P(ENY(3),U,15)
. . . S:$P(ENY(100),U,6)]"" EN(105)=$P(ENY(100),U,6)
. . . S:$P(ENY(3),U,10)]"" EN(29)=$P(ENY(3),U,10)
. . . S:$P(ENY(4),U,3)]"" EN(37)=$P(ENY(4),U,3)
. . . S:$P(ENY(100),U,7)]"" EN(106)=$P(ENY(100),U,Y)
. . I ENFILE=6915.6 D ; FR Document
. . . S ENY(3)=$G(^ENG(6915.6,ENDA,3))
. . . S:$P(ENY(3),U,14)]"" EN(29)=$P(ENY(3),U,14)
Q
FRPVAL(ENFILE,ENIEN,ENFAIEN) ; Determine prior values at time of FR
; Input Variables
; ENFILE - FAP document file for the input document
; ENIEN - IEN of the input document in ENFILE
; ENFAIEN - IEN of the assoicated FA document
; Returns
; EN(28) - previous FUND
; EN(29) - previous A/O
; EN(32) - previous BOC
; EN(33) - previous LOCATION (NATIONAL EIL)
; EN(34) - previous COST CENTER
; EN(37) - previous XAREA (CMR)
Q:ENFILE'=6915.6 ; must be FR Document
N ENDA,ENDOC,ENDTC,ENFC,ENY
; get initial values (from FA)
S (EN(28),EN(29),EN(32),EN(33),EN(34))=""
S ENDTC("I")=$P($G(^ENG(6915.2,ENFAIEN,0)),U,2) ; date/time of FA
S ENY(3)=$G(^ENG(6915.2,ENFAIEN,3))
S EN(28)=$P(ENY(3),U,10)
S EN(29)=$P(ENY(3),U,11)
S EN(32)=$P(ENY(3),U,14)
S EN(33)=$P(ENY(3),U,8)
S EN(34)=$P(ENY(3),U,28)
S EN(37)=$P(ENY(3),U,31)
; Construct chrono list of FC and FR in time frame for Equipment
S ENY(0)=$G(^ENG(ENFILE,ENIEN,0))
S ENDA("EQ")=$P(ENY(0),U) ; equip id
S ENDTC("F?")=$P(ENY(0),U,2) ; date/time of input doc
; add FC documents to list
S ENDA("FC")=0
F S ENDA("FC")=$O(^ENG(6915.4,"B",ENDA("EQ"),ENDA("FC"))) Q:'ENDA("FC") D
. S ENDTC("FC")=$P($G(^ENG(6915.4,ENDA("FC"),0)),U,2)
. I ENDTC("FC")>ENDTC("I"),ENDTC("FC")<ENDTC("F?") D
. . Q:$P($G(^ENG(ENFILE,ENDA("FC"),3)),U,8)'="00" ; not FC to FA
. . S ENDOC(ENDTC("FC"),"6915.4;"_ENDA("FC"))=""
; add FR documents to list
S ENDA("FR")=0
F S ENDA("FR")=$O(^ENG(6915.6,"B",ENDA("EQ"),ENDA("FR"))) Q:'ENDA("FR") D
. S ENDTC("FR")=$P($G(^ENG(6915.6,ENDA("FR"),0)),U,2)
. I ENDTC("FR")>ENDTC("I"),ENDTC("FR")<ENDTC("F?") D
. . S ENDOC(ENDTC("FR"),"6915.6;"_ENDA("FR"))=""
; Loop thru chrono list and update initial values as appropriate
S ENDTC="" F S ENDTC=$O(ENDOC(ENDTC)) Q:ENDTC="" D
. S ENY="" F S ENY=$O(ENDOC(ENDTC,ENY)) Q:ENY="" D
. . S ENFILE=$P(ENY,";"),ENDA=$P(ENY,";",2)
. . I ENFILE=6915.4 D ; FC Document
. . . S ENY(3)=$G(^ENG(6915.4,ENDA,3))
. . . S:$P(ENY(3),U,10)]"" EN(33)=$P(ENY(3),U,10) ; location
. . I ENFILE=6915.6 D ; FR Document
. . . S ENY(3)=$G(^ENG(6915.6,ENDA,3))
. . . S:$P(ENY(3),U,9)]"" EN(28)=$P(ENY(3),U,9) ; fund
. . . S:$P(ENY(3),U,10)]"" EN(29)=$P(ENY(3),U,10) ; a/o
. . . S:$P(ENY(3),U,13)]"" EN(32)=$P(ENY(3),U,13) ; boc
. . . S:$P(ENY(3),U,14)]"" EN(33)=$P(ENY(3),U,14) ; location
. . . S:$P(ENY(3),U,15)]"" EN(34)=$P(ENY(3),U,15) ; cost ctr
. . . S:$P(ENY(3),U,18)]"" EN(37)=$P(ENY(3),U,18) ; xarea
Q
;ENFARC3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFARC3 6307 printed Nov 22, 2024@17:03:57 Page 2
ENFARC3 ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER (CONT); 12/16/1998
+1 ;;7.0;ENGINEERING;**39,60**;Aug 17, 1993
+2 QUIT
+3 ;
FCPVAL(ENFILE,ENIEN,ENFAIEN) ; Determine prior values at time of FC
+1 ; Input Variables
+2 ; ENFILE - FAP document file for the input document
+3 ; ENIEN - IEN of the input document in ENFILE
+4 ; ENFAIEN - IEN of the assoicated FA document
+5 ; Returns
+6 ; EN(30) - previous DESCRIPTION
+7 ; EN(34) - previous ACQ METHOD CODE
+8 ; EN(105) - previous ACQ DATE (FileMan format)
+9 ; also when betterment = 00
+10 ; EN(29) - previous LOCATION (NATIONAL EIL)
+11 ; EN(37) - previous USEFUL LIFE
+12 ; EN(106) - previous REPL DATE (FileMan format)
+13 ; must be FC Document
if ENFILE'=6915.4
QUIT
+14 NEW ENDA,ENDOC,ENDTC,ENFC,ENY
+15 ; get initial values (from FA or FB)
+16 SET (EN(30),EN(34),EN(105),EN(29),EN(37),EN(106))=""
+17 SET ENFC("BETR")=$PIECE($GET(^ENG(ENFILE,ENIEN,3)),U,8)
+18 IF ENFC("BETR")="00"
Begin DoDot:1
+19 ; date/time of FA
SET ENDTC("I")=$PIECE($GET(^ENG(6915.2,ENFAIEN,0)),U,2)
+20 SET ENY(3)=$GET(^ENG(6915.2,ENFAIEN,3))
+21 SET EN(30)=$PIECE(ENY(3),U,15)
+22 SET EN(34)=$PIECE(ENY(3),U,19)
+23 IF $PIECE(ENY(3),U,16)]""
Begin DoDot:2
+24 SET EN(105)=$PIECE(ENY(3),U,16)-1700
+25 SET EN(105)=EN(105)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,17)))_$PIECE(ENY(3),U,17)
+26 SET EN(105)=EN(105)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,18)))_$PIECE(ENY(3),U,18)
End DoDot:2
+27 SET EN(29)=$PIECE(ENY(3),U,8)
+28 SET EN(37)=$PIECE(ENY(3),U,24)
+29 IF $PIECE(ENY(3),U,21)]""
Begin DoDot:2
+30 SET EN(106)=$PIECE(ENY(3),U,21)-1700
+31 SET EN(106)=EN(106)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,22)))_$PIECE(ENY(3),U,22)
+32 SET EN(106)=EN(106)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,23)))_$PIECE(ENY(3),U,23)
End DoDot:2
End DoDot:1
+33 IF ENFC("BETR")'="00"
Begin DoDot:1
+34 ; betterment pointer
SET ENFC("FB")=$PIECE($GET(^ENG(6915.4,ENIEN,100)),U,5)
+35 ; date/time of FB
SET ENDTC("I")=$PIECE($GET(^ENG(6915.3,ENFC("FB"),0)),U,2)
+36 SET ENY(3)=$SELECT(ENFC("FB"):$GET(^ENG(6915.3,ENFC("FB"),3)),1:"")
+37 SET EN(30)=$PIECE(ENY(3),U,8)
+38 SET EN(34)=$PIECE(ENY(3),U,12)
+39 IF $PIECE(ENY(3),U,9)]""
Begin DoDot:2
+40 SET EN(105)=$PIECE(ENY(3),U,9)-1700
+41 SET EN(105)=EN(105)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,10)))_$PIECE(ENY(3),U,10)
+42 SET EN(105)=EN(105)_$EXTRACT("00",1,2-$LENGTH($PIECE(ENY(3),U,11)))_$PIECE(ENY(3),U,11)
End DoDot:2
End DoDot:1
+43 ; Construct chrono list of FC and FR in time frame for Equipment
+44 SET ENY(0)=$GET(^ENG(ENFILE,ENIEN,0))
+45 ; equip id
SET ENDA("EQ")=$PIECE(ENY(0),U)
+46 ; date/time of input doc
SET ENDTC("F?")=$PIECE(ENY(0),U,2)
+47 ; add FC documents to list
+48 SET ENDA("FC")=0
+49 FOR
SET ENDA("FC")=$ORDER(^ENG(6915.4,"B",ENDA("EQ"),ENDA("FC")))
if 'ENDA("FC")
QUIT
Begin DoDot:1
+50 SET ENDTC("FC")=$PIECE($GET(^ENG(6915.4,ENDA("FC"),0)),U,2)
+51 IF ENDTC("FC")>ENDTC("I")
IF ENDTC("FC")<ENDTC("F?")
Begin DoDot:2
+52 ; diff betr
if ENFC("BETR")'=$PIECE($GET(^ENG(ENFILE,ENDA("FC"),3)),U,8)
QUIT
+53 SET ENDOC(ENDTC("FC"),"6915.4;"_ENDA("FC"))=""
End DoDot:2
End DoDot:1
+54 ; add FR documents to list
+55 SET ENDA("FR")=0
+56 FOR
SET ENDA("FR")=$ORDER(^ENG(6915.6,"B",ENDA("EQ"),ENDA("FR")))
if 'ENDA("FR")
QUIT
Begin DoDot:1
+57 SET ENDTC("FR")=$PIECE($GET(^ENG(6915.6,ENDA("FR"),0)),U,2)
+58 IF ENDTC("FR")>ENDTC("I")
IF ENDTC("FR")<ENDTC("F?")
Begin DoDot:2
+59 SET ENDOC(ENDTC("FR"),"6915.6;"_ENDA("FR"))=""
End DoDot:2
End DoDot:1
+60 ; Loop thru chrono list and update initial values as appropriate
+61 SET ENDTC=""
FOR
SET ENDTC=$ORDER(ENDOC(ENDTC))
if ENDTC=""
QUIT
Begin DoDot:1
+62 SET ENY=""
FOR
SET ENY=$ORDER(ENDOC(ENDTC,ENY))
if ENY=""
QUIT
Begin DoDot:2
+63 SET ENFILE=$PIECE(ENY,";")
SET ENDA=$PIECE(ENY,";",2)
+64 ; FC Document
IF ENFILE=6915.4
Begin DoDot:3
+65 SET ENY(3)=$GET(^ENG(6915.4,ENDA,3))
+66 SET ENY(4)=$GET(^ENG(6915.4,ENDA,4))
+67 SET ENY(100)=$GET(^ENG(6915.4,ENDA,100))
+68 if $PIECE(ENY(3),U,11)]""
SET EN(30)=$PIECE(ENY(3),U,11)
+69 if $PIECE(ENY(3),U,15)]""
SET EN(34)=$PIECE(ENY(3),U,15)
+70 if $PIECE(ENY(100),U,6)]""
SET EN(105)=$PIECE(ENY(100),U,6)
+71 if $PIECE(ENY(3),U,10)]""
SET EN(29)=$PIECE(ENY(3),U,10)
+72 if $PIECE(ENY(4),U,3)]""
SET EN(37)=$PIECE(ENY(4),U,3)
+73 if $PIECE(ENY(100),U,7)]""
SET EN(106)=$PIECE(ENY(100),U,Y)
End DoDot:3
+74 ; FR Document
IF ENFILE=6915.6
Begin DoDot:3
+75 SET ENY(3)=$GET(^ENG(6915.6,ENDA,3))
+76 if $PIECE(ENY(3),U,14)]""
SET EN(29)=$PIECE(ENY(3),U,14)
End DoDot:3
End DoDot:2
End DoDot:1
+77 QUIT
FRPVAL(ENFILE,ENIEN,ENFAIEN) ; Determine prior values at time of FR
+1 ; Input Variables
+2 ; ENFILE - FAP document file for the input document
+3 ; ENIEN - IEN of the input document in ENFILE
+4 ; ENFAIEN - IEN of the assoicated FA document
+5 ; Returns
+6 ; EN(28) - previous FUND
+7 ; EN(29) - previous A/O
+8 ; EN(32) - previous BOC
+9 ; EN(33) - previous LOCATION (NATIONAL EIL)
+10 ; EN(34) - previous COST CENTER
+11 ; EN(37) - previous XAREA (CMR)
+12 ; must be FR Document
if ENFILE'=6915.6
QUIT
+13 NEW ENDA,ENDOC,ENDTC,ENFC,ENY
+14 ; get initial values (from FA)
+15 SET (EN(28),EN(29),EN(32),EN(33),EN(34))=""
+16 ; date/time of FA
SET ENDTC("I")=$PIECE($GET(^ENG(6915.2,ENFAIEN,0)),U,2)
+17 SET ENY(3)=$GET(^ENG(6915.2,ENFAIEN,3))
+18 SET EN(28)=$PIECE(ENY(3),U,10)
+19 SET EN(29)=$PIECE(ENY(3),U,11)
+20 SET EN(32)=$PIECE(ENY(3),U,14)
+21 SET EN(33)=$PIECE(ENY(3),U,8)
+22 SET EN(34)=$PIECE(ENY(3),U,28)
+23 SET EN(37)=$PIECE(ENY(3),U,31)
+24 ; Construct chrono list of FC and FR in time frame for Equipment
+25 SET ENY(0)=$GET(^ENG(ENFILE,ENIEN,0))
+26 ; equip id
SET ENDA("EQ")=$PIECE(ENY(0),U)
+27 ; date/time of input doc
SET ENDTC("F?")=$PIECE(ENY(0),U,2)
+28 ; add FC documents to list
+29 SET ENDA("FC")=0
+30 FOR
SET ENDA("FC")=$ORDER(^ENG(6915.4,"B",ENDA("EQ"),ENDA("FC")))
if 'ENDA("FC")
QUIT
Begin DoDot:1
+31 SET ENDTC("FC")=$PIECE($GET(^ENG(6915.4,ENDA("FC"),0)),U,2)
+32 IF ENDTC("FC")>ENDTC("I")
IF ENDTC("FC")<ENDTC("F?")
Begin DoDot:2
+33 ; not FC to FA
if $PIECE($GET(^ENG(ENFILE,ENDA("FC"),3)),U,8)'="00"
QUIT
+34 SET ENDOC(ENDTC("FC"),"6915.4;"_ENDA("FC"))=""
End DoDot:2
End DoDot:1
+35 ; add FR documents to list
+36 SET ENDA("FR")=0
+37 FOR
SET ENDA("FR")=$ORDER(^ENG(6915.6,"B",ENDA("EQ"),ENDA("FR")))
if 'ENDA("FR")
QUIT
Begin DoDot:1
+38 SET ENDTC("FR")=$PIECE($GET(^ENG(6915.6,ENDA("FR"),0)),U,2)
+39 IF ENDTC("FR")>ENDTC("I")
IF ENDTC("FR")<ENDTC("F?")
Begin DoDot:2
+40 SET ENDOC(ENDTC("FR"),"6915.6;"_ENDA("FR"))=""
End DoDot:2
End DoDot:1
+41 ; Loop thru chrono list and update initial values as appropriate
+42 SET ENDTC=""
FOR
SET ENDTC=$ORDER(ENDOC(ENDTC))
if ENDTC=""
QUIT
Begin DoDot:1
+43 SET ENY=""
FOR
SET ENY=$ORDER(ENDOC(ENDTC,ENY))
if ENY=""
QUIT
Begin DoDot:2
+44 SET ENFILE=$PIECE(ENY,";")
SET ENDA=$PIECE(ENY,";",2)
+45 ; FC Document
IF ENFILE=6915.4
Begin DoDot:3
+46 SET ENY(3)=$GET(^ENG(6915.4,ENDA,3))
+47 ; location
if $PIECE(ENY(3),U,10)]""
SET EN(33)=$PIECE(ENY(3),U,10)
End DoDot:3
+48 ; FR Document
IF ENFILE=6915.6
Begin DoDot:3
+49 SET ENY(3)=$GET(^ENG(6915.6,ENDA,3))
+50 ; fund
if $PIECE(ENY(3),U,9)]""
SET EN(28)=$PIECE(ENY(3),U,9)
+51 ; a/o
if $PIECE(ENY(3),U,10)]""
SET EN(29)=$PIECE(ENY(3),U,10)
+52 ; boc
if $PIECE(ENY(3),U,13)]""
SET EN(32)=$PIECE(ENY(3),U,13)
+53 ; location
if $PIECE(ENY(3),U,14)]""
SET EN(33)=$PIECE(ENY(3),U,14)
+54 ; cost ctr
if $PIECE(ENY(3),U,15)]""
SET EN(34)=$PIECE(ENY(3),U,15)
+55 ; xarea
if $PIECE(ENY(3),U,18)]""
SET EN(37)=$PIECE(ENY(3),U,18)
End DoDot:3
End DoDot:2
End DoDot:1
+56 QUIT
+57 ;ENFARC3
