ENFAXMT ;WCIOFO/KLD/DH/SAB; TRANSMIT FAP RECORDS ; 12/16/1998
;;7.0;ENGINEERING;**29,33,39,57,60**;Aug 17, 1993
; This routine should not be modified.
;
; Input
; ENEQ("DA") - equipment entry number
; ENFAP("DOC") - type of FAP document
; ENFA("DA") or ENFB("DA")... - ien of document
ST K X F I=0:1:3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
S ENFAP("STATION")=$P(ENEQ(9),U,5) ;Owning station
I '$D(ENFAP("FY")) S ENFAP("FY")=$E($E(DT,1,3)+$E(DT,4),2,3)
COUNT ;Update document counter
S:'$D(ENFAP("SITE")) ENFAP("SITE")=+^ENG(6915.1,1,0)
S DIC="^ENG(6915.1,",DIC(0)="M",X=ENFAP("SITE") D ^DIC
L +^ENG(6915.1,+Y):5
S X=$S(ENFAP("DOC")="FR":6,1:$A(ENFAP("DOC"),2)-63) ; piece in node
S ENFAP("COUNT")=$P(^ENG(6915.1,+Y,0),U,X)+1
S:ENFAP("COUNT")>9999 ENFAP("COUNT")=1
S $P(^ENG(6915.1,+Y,0),U,X)=ENFAP("COUNT")
L -^ENG(6915.1,+Y)
S ENFAP("COUNT")="000"_ENFAP("COUNT"),ENFAP("COUNT")=$E(ENFAP("COUNT"),$L(ENFAP("COUNT"))-3,$L(ENFAP("COUNT")))
FX1 ; set up first 4 fields of first data segment
S ENFAP("AO")=$$GET1^DIQ(6914,ENEQ("DA"),63)
S ENFAP("FUND")=$$GET1^DIQ(6914,ENEQ("DA"),62)
S ENFAP("CFO")=$S(ENFAP("AO")=10:"01",ENFAP("AO")=40:"05",ENFAP("AO")=20:"02",ENFAP("AO")="02":"06",ENFAP("AO")="00":"05",1:10)
S ENFAP("TRANS")=$S(ENFAP("STATION")]"":$E(ENFAP("STATION"),1,3),1:ENFAP("SITE"))_$E(ENFAP("FY"),2)_"N"_ENFAP("COUNT")
S X(1)=ENFAP("DOC")_"1"_U_ENFAP("DOC")_U_ENFAP("AO")_U_ENFAP("TRANS")
; add remaining data to first segment
FA I ENFAP("DOC")="FA" D
. D FANUM^ENFAXMT3(1)
. S ENFAP("GRP")=$$GROUP^ENFAVAL($$GET1^DIQ(6914,ENEQ("DA"),18))
. S ENFAP("CMR")=$E($$GET1^DIQ(6914,ENEQ("DA"),19),1,5)
. S ENFAP("LOC")=$$LOC^ENFAVAL(ENFAP("CMR"))
. S X(1)=X(1)_U_ENFAP("GRP")_U_ENFAP("LOC")
. D BUDFY^ENFAXMT3($P(ENEQ(9),U,7))
. S X(1)=X(1)_"^^"_ENFAP("FUND")_U_ENFAP("AO")
. D XORG,XPROG^ENFAXMT3
. S X(1)=X(1)_U_$$GET1^DIQ(6914,ENEQ("DA"),61)_U_$$GET1^DIQ(6914,ENEQ("DA"),18)
. D ACQTIME,ACQMETH,XAREA,FUNDSRC
. I ENFAP("TY")="X" S X(1)=X(1)_"^^^^^^" ; excessed
. E D REPLTIME,LIFEXP,SALDEPM
. D SUMAV,COSTCEN
. D SUBORG
. S $P(X(1),U,33)="~"
FB I ENFAP("DOC")="FB" D
. S X(1)=X(1)_"^^^^^"
. D FANUM^ENFAXMT3(1) S X(1)=X(1)_U_$P(ENFAP(3),U,7,8)
. D CVTDATE($P($G(^ENG(6915.3,ENFB("DA"),100)),U))
. S X(1)=X(1)_U_$P(ENFAP(3),U,12)
. S $P(X(1),U,26)="~"
FC I ENFAP("DOC")="FC" D
. S X(1)=X(1)_"^^^^^"
. D BUDFY^ENFAXMT3($P(ENEQ(9),U,7))
. S X(1)=X(1)_"^" ;No END BUDGET FY
. D FANUM^ENFAXMT3(1) S X(1)=X(1)_U_$P(ENFAP(3),U,8)
. I $P(ENFAP(3),U,8)="00" D Q ;FC against an FA
. . S X=$$GROUP^ENFAVAL($$GET1^DIQ(6915.4,ENFC("DA"),100))
. . S X(1)=X(1)_U_$S(X="0":"",1:X) ; csn may not have been entered
. . S X(1)=X(1)_U_$$LOC^ENFAVAL($$GET1^DIQ(6915.4,ENFC("DA"),101))
. . S X(1)=X(1)_U_$$GET1^DIQ(6915.4,ENFC("DA"),100) ;Description (CSN)
. . D ACQTIME,ACQMETH S $P(X(1),U,32)="~"
. S X(1)=X(1)_"^^" ;FC against a betterment
. S X(1)=X(1)_U_$P(ENFAP(3),U,11)
. D CVTDATE($P(ENFAP(100),U,6)) ; acquisition date from FC
. S X(1)=X(1)_U_$P(ENFAP(3),U,15) ; acquisition method from FC
. S $P(X(1),U,32)="~"
FD I ENFAP("DOC")="FD" D
. S X(1)=X(1)_"^^^^^"
. D BUDFY^ENFAXMT3($P(ENEQ(9),U,7))
. S $P(X(1),U,12)="~"
FR I ENFAP("DOC")="FR" D
. S X(1)=X(1)_"^^^^^"
. D FANUM^ENFAXMT3(1)
. S X(1)=X(1)_U_$P(^ENG(6915.6,ENFR("DA"),3),U,7,8)_"^^"_$P(^(3),U,9,18)
. S $P(X(1),U,25)="~"
;end of Fx1 document
D:ENFAP("DOC")'="FR" ^ENFAXMT1
D SEND^ENFAXMT2
;
K K X,Y ;Campground cleanup performed by calling routine
Q
;
FUNDXDIV S X(1)=X(1)_U_ENFAP("FUND")_U_ENFAP("AO") Q
;
XORG S X(1)=X(1)_U_$E(ENFAP("STATION"),1,3) Q
;
ACQTIME S X=$P(ENEQ(2),U,4)
S X(1)=X(1)_U_($E(X,1,3)+1700)_U_$E(X,4,5)_U_$E(X,6,7)
Q
;
ACQMETH S X(1)=X(1)_U_$P(ENEQ(3),U,4) Q
;
XAREA S X(1)=X(1)_U_ENFAP("CMR") Q
;
FUNDSRC S X(1)=X(1)_U_$E($P(ENEQ(2),U,4),2,3)_$E(ENFAP("FUND"),1,4)_ENFAP("CFO") Q
;
REPLTIME S X=$P(ENEQ(2),U,10)
I X="" S X(1)=X(1)_"^^^" Q
S X(1)=X(1)_U_($E(X,1,3)+1700)_U_$E(X,4,5)_U_$E(X,6,7) Q
;
LIFEXP S X(1)=X(1)_U_$P(ENEQ(2),U,6) Q
SALDEPM S X(1)=X(1)_"^0.00^SL" Q ;Salvage value & Deprec. method
;
SUMAV ;Summary asset value
S X(1)=X(1)_U_$P(ENEQ(2),U,3) Q
;
COSTCEN S X(1)=X(1)_U_$$GET1^DIQ(6914,ENEQ("DA"),"19:10") ; cost center num
S X(1)=X(1)_U ; not passing sub-cost center
Q
;
SUBORG ;Used for satellite designator
I $E(ENFAP("STATION"),4,5)?2UN S X(1)=X(1)_U_$E(ENFAP("STATION"),4,5)
E S X(1)=X(1)_U
Q
CVTDATE(ENX) ; year^month^date from FileMan date
I ENX="" S X(1)=X(1)_"^^^" Q
S X(1)=X(1)_U_($E(ENX,1,3)+1700)_U_$E(ENX,4,5)_U_$E(ENX,6,7) Q
;ENFAXMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAXMT 4669 printed Nov 22, 2024@17:04 Page 2
ENFAXMT ;WCIOFO/KLD/DH/SAB; TRANSMIT FAP RECORDS ; 12/16/1998
+1 ;;7.0;ENGINEERING;**29,33,39,57,60**;Aug 17, 1993
+2 ; This routine should not be modified.
+3 ;
+4 ; Input
+5 ; ENEQ("DA") - equipment entry number
+6 ; ENFAP("DOC") - type of FAP document
+7 ; ENFA("DA") or ENFB("DA")... - ien of document
ST KILL X
FOR I=0:1:3,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+1 ;Owning station
SET ENFAP("STATION")=$PIECE(ENEQ(9),U,5)
+2 IF '$DATA(ENFAP("FY"))
SET ENFAP("FY")=$EXTRACT($EXTRACT(DT,1,3)+$EXTRACT(DT,4),2,3)
COUNT ;Update document counter
+1 if '$DATA(ENFAP("SITE"))
SET ENFAP("SITE")=+^ENG(6915.1,1,0)
+2 SET DIC="^ENG(6915.1,"
SET DIC(0)="M"
SET X=ENFAP("SITE")
DO ^DIC
+3 LOCK +^ENG(6915.1,+Y):5
+4 ; piece in node
SET X=$SELECT(ENFAP("DOC")="FR":6,1:$ASCII(ENFAP("DOC"),2)-63)
+5 SET ENFAP("COUNT")=$PIECE(^ENG(6915.1,+Y,0),U,X)+1
+6 if ENFAP("COUNT")>9999
SET ENFAP("COUNT")=1
+7 SET $PIECE(^ENG(6915.1,+Y,0),U,X)=ENFAP("COUNT")
+8 LOCK -^ENG(6915.1,+Y)
+9 SET ENFAP("COUNT")="000"_ENFAP("COUNT")
SET ENFAP("COUNT")=$EXTRACT(ENFAP("COUNT"),$LENGTH(ENFAP("COUNT"))-3,$LENGTH(ENFAP("COUNT")))
FX1 ; set up first 4 fields of first data segment
+1 SET ENFAP("AO")=$$GET1^DIQ(6914,ENEQ("DA"),63)
+2 SET ENFAP("FUND")=$$GET1^DIQ(6914,ENEQ("DA"),62)
+3 SET ENFAP("CFO")=$SELECT(ENFAP("AO")=10:"01",ENFAP("AO")=40:"05",ENFAP("AO")=20:"02",ENFAP("AO")="02":"06",ENFAP("AO")="00":"05",1:10)
+4 SET ENFAP("TRANS")=$SELECT(ENFAP("STATION")]"":$EXTRACT(ENFAP("STATION"),1,3),1:ENFAP("SITE"))_$EXTRACT(ENFAP("FY"),2)_"N"_ENFAP("COUNT")
+5 SET X(1)=ENFAP("DOC")_"1"_U_ENFAP("DOC")_U_ENFAP("AO")_U_ENFAP("TRANS")
+6 ; add remaining data to first segment
FA IF ENFAP("DOC")="FA"
Begin DoDot:1
+1 DO FANUM^ENFAXMT3(1)
+2 SET ENFAP("GRP")=$$GROUP^ENFAVAL($$GET1^DIQ(6914,ENEQ("DA"),18))
+3 SET ENFAP("CMR")=$EXTRACT($$GET1^DIQ(6914,ENEQ("DA"),19),1,5)
+4 SET ENFAP("LOC")=$$LOC^ENFAVAL(ENFAP("CMR"))
+5 SET X(1)=X(1)_U_ENFAP("GRP")_U_ENFAP("LOC")
+6 DO BUDFY^ENFAXMT3($PIECE(ENEQ(9),U,7))
+7 SET X(1)=X(1)_"^^"_ENFAP("FUND")_U_ENFAP("AO")
+8 DO XORG
DO XPROG^ENFAXMT3
+9 SET X(1)=X(1)_U_$$GET1^DIQ(6914,ENEQ("DA"),61)_U_$$GET1^DIQ(6914,ENEQ("DA"),18)
+10 DO ACQTIME
DO ACQMETH
DO XAREA
DO FUNDSRC
+11 ; excessed
IF ENFAP("TY")="X"
SET X(1)=X(1)_"^^^^^^"
+12 IF '$TEST
DO REPLTIME
DO LIFEXP
DO SALDEPM
+13 DO SUMAV
DO COSTCEN
+14 DO SUBORG
+15 SET $PIECE(X(1),U,33)="~"
End DoDot:1
FB IF ENFAP("DOC")="FB"
Begin DoDot:1
+1 SET X(1)=X(1)_"^^^^^"
+2 DO FANUM^ENFAXMT3(1)
SET X(1)=X(1)_U_$PIECE(ENFAP(3),U,7,8)
+3 DO CVTDATE($PIECE($GET(^ENG(6915.3,ENFB("DA"),100)),U))
+4 SET X(1)=X(1)_U_$PIECE(ENFAP(3),U,12)
+5 SET $PIECE(X(1),U,26)="~"
End DoDot:1
FC IF ENFAP("DOC")="FC"
Begin DoDot:1
+1 SET X(1)=X(1)_"^^^^^"
+2 DO BUDFY^ENFAXMT3($PIECE(ENEQ(9),U,7))
+3 ;No END BUDGET FY
SET X(1)=X(1)_"^"
+4 DO FANUM^ENFAXMT3(1)
SET X(1)=X(1)_U_$PIECE(ENFAP(3),U,8)
+5 ;FC against an FA
IF $PIECE(ENFAP(3),U,8)="00"
Begin DoDot:2
+6 SET X=$$GROUP^ENFAVAL($$GET1^DIQ(6915.4,ENFC("DA"),100))
+7 ; csn may not have been entered
SET X(1)=X(1)_U_$SELECT(X="0":"",1:X)
+8 SET X(1)=X(1)_U_$$LOC^ENFAVAL($$GET1^DIQ(6915.4,ENFC("DA"),101))
+9 ;Description (CSN)
SET X(1)=X(1)_U_$$GET1^DIQ(6915.4,ENFC("DA"),100)
+10 DO ACQTIME
DO ACQMETH
SET $PIECE(X(1),U,32)="~"
End DoDot:2
QUIT
+11 ;FC against a betterment
SET X(1)=X(1)_"^^"
+12 SET X(1)=X(1)_U_$PIECE(ENFAP(3),U,11)
+13 ; acquisition date from FC
DO CVTDATE($PIECE(ENFAP(100),U,6))
+14 ; acquisition method from FC
SET X(1)=X(1)_U_$PIECE(ENFAP(3),U,15)
+15 SET $PIECE(X(1),U,32)="~"
End DoDot:1
FD IF ENFAP("DOC")="FD"
Begin DoDot:1
+1 SET X(1)=X(1)_"^^^^^"
+2 DO BUDFY^ENFAXMT3($PIECE(ENEQ(9),U,7))
+3 SET $PIECE(X(1),U,12)="~"
End DoDot:1
FR IF ENFAP("DOC")="FR"
Begin DoDot:1
+1 SET X(1)=X(1)_"^^^^^"
+2 DO FANUM^ENFAXMT3(1)
+3 SET X(1)=X(1)_U_$PIECE(^ENG(6915.6,ENFR("DA"),3),U,7,8)_"^^"_$PIECE(^(3),U,9,18)
+4 SET $PIECE(X(1),U,25)="~"
End DoDot:1
+5 ;end of Fx1 document
+6 if ENFAP("DOC")'="FR"
DO ^ENFAXMT1
+7 DO SEND^ENFAXMT2
+8 ;
K ;Campground cleanup performed by calling routine
KILL X,Y
+1 QUIT
+2 ;
FUNDXDIV SET X(1)=X(1)_U_ENFAP("FUND")_U_ENFAP("AO")
QUIT
+1 ;
XORG SET X(1)=X(1)_U_$EXTRACT(ENFAP("STATION"),1,3)
QUIT
+1 ;
ACQTIME SET X=$PIECE(ENEQ(2),U,4)
+1 SET X(1)=X(1)_U_($EXTRACT(X,1,3)+1700)_U_$EXTRACT(X,4,5)_U_$EXTRACT(X,6,7)
+2 QUIT
+3 ;
ACQMETH SET X(1)=X(1)_U_$PIECE(ENEQ(3),U,4)
QUIT
+1 ;
XAREA SET X(1)=X(1)_U_ENFAP("CMR")
QUIT
+1 ;
FUNDSRC SET X(1)=X(1)_U_$EXTRACT($PIECE(ENEQ(2),U,4),2,3)_$EXTRACT(ENFAP("FUND"),1,4)_ENFAP("CFO")
QUIT
+1 ;
REPLTIME SET X=$PIECE(ENEQ(2),U,10)
+1 IF X=""
SET X(1)=X(1)_"^^^"
QUIT
+2 SET X(1)=X(1)_U_($EXTRACT(X,1,3)+1700)_U_$EXTRACT(X,4,5)_U_$EXTRACT(X,6,7)
QUIT
+3 ;
LIFEXP SET X(1)=X(1)_U_$PIECE(ENEQ(2),U,6)
QUIT
SALDEPM ;Salvage value & Deprec. method
SET X(1)=X(1)_"^0.00^SL"
QUIT
+1 ;
SUMAV ;Summary asset value
+1 SET X(1)=X(1)_U_$PIECE(ENEQ(2),U,3)
QUIT
+2 ;
COSTCEN ; cost center num
SET X(1)=X(1)_U_$$GET1^DIQ(6914,ENEQ("DA"),"19:10")
+1 ; not passing sub-cost center
SET X(1)=X(1)_U
+2 QUIT
+3 ;
SUBORG ;Used for satellite designator
+1 IF $EXTRACT(ENFAP("STATION"),4,5)?2UN
SET X(1)=X(1)_U_$EXTRACT(ENFAP("STATION"),4,5)
+2 IF '$TEST
SET X(1)=X(1)_U
+3 QUIT
CVTDATE(ENX) ; year^month^date from FileMan date
+1 IF ENX=""
SET X(1)=X(1)_"^^^"
QUIT
+2 SET X(1)=X(1)_U_($EXTRACT(ENX,1,3)+1700)_U_$EXTRACT(ENX,4,5)_U_$EXTRACT(ENX,6,7)
QUIT
+3 ;ENFAXMT
