- 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 Mar 13, 2025@20:58:28 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
