- ENFAR5A ;WIRMFO/SAB-FIXED ASSET RPT, VOUCHER SUMMARY (CONT); 8/1/96
- ;;7.0;ENGINEERING;**29,33**;Aug 17, 1993
- GETDATA ; collect/sort data
- ; load table for converting FA Type to SGL
- K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
- . S ENY0=$G(^ENG(6914.3,ENDA,0))
- . I $P(ENY0,U,3)]"" S ENFAPTY($P(ENY0,U,3))=$P(ENY0,U)
- ; loop thru FAP document file transactions within selected date range
- K ^TMP($J) F ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6" D
- . S ENDT=ENDTS
- . F S ENDT=$O(^ENG(ENFILE,"D",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
- . . S ENDA("F?")=0
- . . F S ENDA("F?")=$O(^ENG(ENFILE,"D",ENDT,ENDA("F?"))) Q:'ENDA("F?") D
- . . . S ENDA("FA")=$$AFA(ENFILE,ENDA("F?")) ; associated FA
- . . . S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
- . . . S ENX=$TR($E($P(ENFAY3,U,5),1,5)," ","")
- . . . Q:ENSNR'=ENX ; not station
- . . . S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
- . . . S:ENFILE'=6915.2 ENFUND=$$FUND(ENFILE,ENDA("F?"),ENDA("FA"))
- . . . S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
- . . . Q:ENFUND=""!(ENSGL="")
- . . . I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
- . . . I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
- . . . I ENFILE=6915.4 S ENX=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,6),ENAMT=$S(ENX="":0,1:ENX-$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,4))
- . . . I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
- . . . I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
- . . . Q:+ENAMT=0 ; don't include transactions for $0
- . . . I ENFILE'=6915.6 D ; process non-FR doc
- . . . . S ^TMP($J,ENFUND,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))=ENAMT
- . . . I ENFILE=6915.6 D ; process FR doc
- . . . . S ENFUNDNW=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,9)
- . . . . Q:ENFUND=ENFUNDNW ; don't include if fund unchanged by FR
- . . . . S ^TMP($J,ENFUNDNW,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))=ENAMT
- . . . . S ^TMP($J,ENFUND,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))="-"_ENAMT
- K ENFAPTY
- Q
- AFA(ENFILE,ENIEN) ; Associated FA Document Extrinsic Function
- ; Input Variables
- ; ENFILE - FAP document file of the input document
- ; ENIEN - IEN of the input document in ENFILE
- ; Returns
- ; IEN of the FA document which is associated with the input document
- ; 0 if no associated FA document could be found
- N ENDA,ENDTC,ENY0
- Q:ENFILE="6915.2" ENIEN ; FA document associated with itself
- S ENY0=$G(^ENG(ENFILE,ENIEN,0))
- S ENDA=$P(ENY0,U) ; equip id
- S ENDTC("F?")=$P(ENY0,U,2) ; date/time of non-FA document
- S ENDA("LFA")=0,ENDTC("LFA")="" ; initialize latest FA ien and date/time
- ; loop thru FA's for equip to determine latest FA before the input doc
- S ENDA("FA")=0
- F S ENDA("FA")=$O(^ENG(6915.2,"B",ENDA,ENDA("FA"))) Q:'ENDA("FA") D
- . S ENDTC("FA")=$P($G(^ENG(6915.2,ENDA("FA"),0)),U,2)
- . I ENDTC("FA")<ENDTC("F?"),ENDTC("FA")>ENDTC("LFA") S ENDA("LFA")=ENDA("FA"),ENDTC("LFA")=ENDTC("FA")
- Q ENDA("LFA")
- ;
- FUND(ENFILE,ENIEN,ENFAIEN) ; Determine FUND at time of non-FA transaction
- ; 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
- ; Fund of equipment just before input document was processed
- N ENDA,ENDTC,ENFUND,ENY0
- S ENFUND=$P($G(^ENG(6915.2,ENFAIEN,3)),U,10) ; initial fund from FA
- S ENDTC("FA")=$P($G(^ENG(6915.2,ENFAIEN,0)),U,2) ; date/time of FA
- S ENY0=$G(^ENG(ENFILE,ENIEN,0))
- S ENDA=$P(ENY0,U) ; equip id
- S ENDTC("F?")=$P(ENY0,U,2) ; date/time of input doc
- ; Retrieve fund values from any FR's between FA and input document
- ; by looping thru FR's for equip id
- S ENDA("FR")=0
- F S ENDA("FR")=$O(^ENG(6915.6,"B",ENDA,ENDA("FR"))) Q:'ENDA("FR") D
- . S ENDTC("FR")=$P($G(^ENG(6915.6,ENDA("FR"),0)),U,2)
- . I ENDTC("FR")>ENDTC("FA"),ENDTC("FR")<ENDTC("F?") S ENFUND(ENDTC("FR"))=$P($G(^ENG(6915.6,ENDA("FR"),3)),U,9)
- ; update initial fund from FA with any subsequent values from FR docs
- S ENDTC="" F S ENDTC=$O(ENFUND(ENDTC)) Q:ENDTC="" I ENFUND(ENDTC)]"" S ENFUND=ENFUND(ENDTC)
- Q ENFUND
- ;ENFAR5A
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR5A 4132 printed Feb 18, 2025@23:20 Page 2
- ENFAR5A ;WIRMFO/SAB-FIXED ASSET RPT, VOUCHER SUMMARY (CONT); 8/1/96
- +1 ;;7.0;ENGINEERING;**29,33**;Aug 17, 1993
- GETDATA ; collect/sort data
- +1 ; load table for converting FA Type to SGL
- +2 KILL ENFAPTY
- SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6914.3,ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +3 SET ENY0=$GET(^ENG(6914.3,ENDA,0))
- +4 IF $PIECE(ENY0,U,3)]""
- SET ENFAPTY($PIECE(ENY0,U,3))=$PIECE(ENY0,U)
- End DoDot:1
- +5 ; loop thru FAP document file transactions within selected date range
- +6 KILL ^TMP($JOB)
- FOR ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6"
- Begin DoDot:1
- +7 SET ENDT=ENDTS
- +8 FOR
- SET ENDT=$ORDER(^ENG(ENFILE,"D",ENDT))
- if ENDT=""!($PIECE(ENDT,".")>ENDTE)
- QUIT
- Begin DoDot:2
- +9 SET ENDA("F?")=0
- +10 FOR
- SET ENDA("F?")=$ORDER(^ENG(ENFILE,"D",ENDT,ENDA("F?")))
- if 'ENDA("F?")
- QUIT
- Begin DoDot:3
- +11 ; associated FA
- SET ENDA("FA")=$$AFA(ENFILE,ENDA("F?"))
- +12 SET ENFAY3=$GET(^ENG(6915.2,ENDA("FA"),3))
- +13 SET ENX=$TRANSLATE($EXTRACT($PIECE(ENFAY3,U,5),1,5)," ","")
- +14 ; not station
- if ENSNR'=ENX
- QUIT
- +15 if ENFILE=6915.2
- SET ENFUND=$PIECE(ENFAY3,U,10)
- +16 if ENFILE'=6915.2
- SET ENFUND=$$FUND(ENFILE,ENDA("F?"),ENDA("FA"))
- +17 SET ENSGL=$SELECT($PIECE(ENFAY3,U,6)]"":$GET(ENFAPTY($PIECE(ENFAY3,U,6))),1:"")
- +18 if ENFUND=""!(ENSGL="")
- QUIT
- +19 IF ENFILE=6915.2
- SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,27)
- +20 IF ENFILE=6915.3
- SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,4)
- +21 IF ENFILE=6915.4
- SET ENX=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,6)
- SET ENAMT=$SELECT(ENX="":0,1:ENX-$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,4))
- +22 IF ENFILE=6915.5
- SET ENAMT="-"_$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,2)
- +23 IF ENFILE=6915.6
- SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,8)
- +24 ; don't include transactions for $0
- if +ENAMT=0
- QUIT
- +25 ; process non-FR doc
- IF ENFILE'=6915.6
- Begin DoDot:4
- +26 SET ^TMP($JOB,ENFUND,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))=ENAMT
- End DoDot:4
- +27 ; process FR doc
- IF ENFILE=6915.6
- Begin DoDot:4
- +28 SET ENFUNDNW=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,9)
- +29 ; don't include if fund unchanged by FR
- if ENFUND=ENFUNDNW
- QUIT
- +30 SET ^TMP($JOB,ENFUNDNW,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))=ENAMT
- +31 SET ^TMP($JOB,ENFUND,ENSGL,ENDT,ENFILE_";"_ENDA("F?"))="-"_ENAMT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 KILL ENFAPTY
- +33 QUIT
- AFA(ENFILE,ENIEN) ; Associated FA Document Extrinsic Function
- +1 ; Input Variables
- +2 ; ENFILE - FAP document file of the input document
- +3 ; ENIEN - IEN of the input document in ENFILE
- +4 ; Returns
- +5 ; IEN of the FA document which is associated with the input document
- +6 ; 0 if no associated FA document could be found
- +7 NEW ENDA,ENDTC,ENY0
- +8 ; FA document associated with itself
- if ENFILE="6915.2"
- QUIT ENIEN
- +9 SET ENY0=$GET(^ENG(ENFILE,ENIEN,0))
- +10 ; equip id
- SET ENDA=$PIECE(ENY0,U)
- +11 ; date/time of non-FA document
- SET ENDTC("F?")=$PIECE(ENY0,U,2)
- +12 ; initialize latest FA ien and date/time
- SET ENDA("LFA")=0
- SET ENDTC("LFA")=""
- +13 ; loop thru FA's for equip to determine latest FA before the input doc
- +14 SET ENDA("FA")=0
- +15 FOR
- SET ENDA("FA")=$ORDER(^ENG(6915.2,"B",ENDA,ENDA("FA")))
- if 'ENDA("FA")
- QUIT
- Begin DoDot:1
- +16 SET ENDTC("FA")=$PIECE($GET(^ENG(6915.2,ENDA("FA"),0)),U,2)
- +17 IF ENDTC("FA")<ENDTC("F?")
- IF ENDTC("FA")>ENDTC("LFA")
- SET ENDA("LFA")=ENDA("FA")
- SET ENDTC("LFA")=ENDTC("FA")
- End DoDot:1
- +18 QUIT ENDA("LFA")
- +19 ;
- FUND(ENFILE,ENIEN,ENFAIEN) ; Determine FUND at time of non-FA transaction
- +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 ; Fund of equipment just before input document was processed
- +7 NEW ENDA,ENDTC,ENFUND,ENY0
- +8 ; initial fund from FA
- SET ENFUND=$PIECE($GET(^ENG(6915.2,ENFAIEN,3)),U,10)
- +9 ; date/time of FA
- SET ENDTC("FA")=$PIECE($GET(^ENG(6915.2,ENFAIEN,0)),U,2)
- +10 SET ENY0=$GET(^ENG(ENFILE,ENIEN,0))
- +11 ; equip id
- SET ENDA=$PIECE(ENY0,U)
- +12 ; date/time of input doc
- SET ENDTC("F?")=$PIECE(ENY0,U,2)
- +13 ; Retrieve fund values from any FR's between FA and input document
- +14 ; by looping thru FR's for equip id
- +15 SET ENDA("FR")=0
- +16 FOR
- SET ENDA("FR")=$ORDER(^ENG(6915.6,"B",ENDA,ENDA("FR")))
- if 'ENDA("FR")
- QUIT
- Begin DoDot:1
- +17 SET ENDTC("FR")=$PIECE($GET(^ENG(6915.6,ENDA("FR"),0)),U,2)
- +18 IF ENDTC("FR")>ENDTC("FA")
- IF ENDTC("FR")<ENDTC("F?")
- SET ENFUND(ENDTC("FR"))=$PIECE($GET(^ENG(6915.6,ENDA("FR"),3)),U,9)
- End DoDot:1
- +19 ; update initial fund from FA with any subsequent values from FR docs
- +20 SET ENDTC=""
- FOR
- SET ENDTC=$ORDER(ENFUND(ENDTC))
- if ENDTC=""
- QUIT
- IF ENFUND(ENDTC)]""
- SET ENFUND=ENFUND(ENDTC)
- +21 QUIT ENFUND
- +22 ;ENFAR5A
