ENFACTX ;(WCIOFO)/SAB-FAP CAPITALIZATION THRESHOLD EXPENSE ITEM ;5/29/2002
;;7.0;ENGINEERING;**63,71**;August 17, 1993
;
EXP(ENDA) ; Expense Equipment Item
; input ENDA - equipment entry # to expense
; returns 1 if success or 0 if failed
; output ^TMP($J,"BAD",entry #
; will be defined if problem
;
N DA,DIC,DIE,DIK,DR,ENAVC,ENDO,ENEQ,ENFA,ENFAP,ENFD,ENX,I,X,Y
S ENDO=1 ; initialize return value as success
S ENEQ("DA")=ENDA
F I=2,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
;
; create FD Document
S ENFD("DA")=""
D:ENDO ADDFD
; populate FD document with 'user' data
D:ENDO
. N ENFDA,ENERR
. S ENFDA(6915.5,ENFD("DA")_",",100)="FINAL DISPOSITION"
. S ENFDA(6915.5,ENFD("DA")_",",102)=$$FMTE^XLFDT(DT)
. S ENFDA(6915.5,ENFD("DA")_",",33)="0.00"
. S ENFDA(6915.5,ENFD("DA")_",",103)="OTHER"
. S ENFDA(6915.5,ENFD("DA")_",",34)="THRESH CHG 100K"
. S ENFDA(6915.5,ENFD("DA")_",",303)="OTHER"
. S ENFDA(6915.5,ENFD("DA")_",",310)="ENAVC"
. S ENAVC(1)="Expensed due to new capitalization threshold of $100,000."
. D FILE^DIE("E","ENFDA","ENERR")
. I $D(ENERR) D BAD("ERROR FILING DATA IN FD") S ENDO=0
; convert 'user' data
D:ENDO CVTDATA
; validate FD document
D:ENDO
. S ENFAP("DOC")="FD"
. K ^TMP($J,"BAD",ENEQ("DA"))
. D ^ENFAVAL
. I $D(^TMP($J,"BAD",ENEQ("DA"))) S ENDO=0
; delete FD Document when problem
I 'ENDO,$G(ENFD("DA"))]"" D
. S DA=ENFD("DA"),DIK="^ENG(6915.5," D ^DIK K DIK
; process and xmit FD
D:ENDO UPDATE
; unlock FD
I $G(ENFD("DA"))]"" L -^ENG(6915.5,ENFD("DA"))
; return success OR failure
Q ENDO
;
ADDFD ; create/lock stub entry for FD codesheet
S DIC="^ENG(6915.5,",DIC(0)="L",DLAYGO=6915.5
S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
K DD,DO D FILE^DICN K DIC,DLAYGO
I Y'>0 D BAD("Can't add to FD DOCUMENT LOG") S ENDO=0 Q
S ENFD("DA")=+Y
L +^ENG(6915.5,ENFD("DA")):0
I '$T D BAD("Can't lock FD Document") S ENDO=0 Q
; save current asset value on FD
S $P(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
Q
;
CVTDATA ; convert 'user' pseudo field data into exported data
; get data from file
F I=0,5,100 S ENFAP(I)=$G(^ENG(6915.5,ENFD("DA"),I))
; convert into exported data
I $P(ENFAP(100),U,4)="" S $P(ENFAP(100),U,4)=7
I $P(ENFAP(5),U,8)="" S $P(ENFAP(5),U,8)="0.00"
S X=$P(ENFAP(100),U,3) I X]"" D
. S $P(ENFAP(5),U,5)=$E(X,1,3)+1700
. S $P(ENFAP(5),U,6)=$E(X,4,5)
. S $P(ENFAP(5),U,7)=$E(X,6,7)
S X=$P(ENFAP(100),U,4) I X S $P(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
; update file
S ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
S ^ENG(6915.5,ENFD("DA"),100)=ENFAP(100)
Q
;
UPDATE ; update files based on FD Document
; update FAP Balance
D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENEQ(9),U,7),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),-$P(ENEQ(2),U,3))
; update EQUIPMENT INV file
S DA=ENEQ("DA"),DIE="^ENG(6914," S DR="34////A;38///6100" D ^DIE
; send FD Document to FAP
D ^ENFAXMT
; save adjustment voucher
S DIE="^ENG(6915.5,",DR="301///NOW",DA=ENFD("DA") D ^DIE
Q
;
BAD(X) ; add text to validation problem list
N I
S I=$P($G(^TMP($J,"BAD",ENEQ("DA"))),U)+1
S ^TMP($J,"BAD",ENEQ("DA"),I)=X
S ^TMP($J,"BAD",ENEQ("DA"))=I
Q
;
;ENFACTX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFACTX 3251 printed Nov 22, 2024@17:03:38 Page 2
ENFACTX ;(WCIOFO)/SAB-FAP CAPITALIZATION THRESHOLD EXPENSE ITEM ;5/29/2002
+1 ;;7.0;ENGINEERING;**63,71**;August 17, 1993
+2 ;
EXP(ENDA) ; Expense Equipment Item
+1 ; input ENDA - equipment entry # to expense
+2 ; returns 1 if success or 0 if failed
+3 ; output ^TMP($J,"BAD",entry #
+4 ; will be defined if problem
+5 ;
+6 NEW DA,DIC,DIE,DIK,DR,ENAVC,ENDO,ENEQ,ENFA,ENFAP,ENFD,ENX,I,X,Y
+7 ; initialize return value as success
SET ENDO=1
+8 SET ENEQ("DA")=ENDA
+9 FOR I=2,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+10 ;
+11 ; create FD Document
+12 SET ENFD("DA")=""
+13 if ENDO
DO ADDFD
+14 ; populate FD document with 'user' data
+15 if ENDO
Begin DoDot:1
+16 NEW ENFDA,ENERR
+17 SET ENFDA(6915.5,ENFD("DA")_",",100)="FINAL DISPOSITION"
+18 SET ENFDA(6915.5,ENFD("DA")_",",102)=$$FMTE^XLFDT(DT)
+19 SET ENFDA(6915.5,ENFD("DA")_",",33)="0.00"
+20 SET ENFDA(6915.5,ENFD("DA")_",",103)="OTHER"
+21 SET ENFDA(6915.5,ENFD("DA")_",",34)="THRESH CHG 100K"
+22 SET ENFDA(6915.5,ENFD("DA")_",",303)="OTHER"
+23 SET ENFDA(6915.5,ENFD("DA")_",",310)="ENAVC"
+24 SET ENAVC(1)="Expensed due to new capitalization threshold of $100,000."
+25 DO FILE^DIE("E","ENFDA","ENERR")
+26 IF $DATA(ENERR)
DO BAD("ERROR FILING DATA IN FD")
SET ENDO=0
End DoDot:1
+27 ; convert 'user' data
+28 if ENDO
DO CVTDATA
+29 ; validate FD document
+30 if ENDO
Begin DoDot:1
+31 SET ENFAP("DOC")="FD"
+32 KILL ^TMP($JOB,"BAD",ENEQ("DA"))
+33 DO ^ENFAVAL
+34 IF $DATA(^TMP($JOB,"BAD",ENEQ("DA")))
SET ENDO=0
End DoDot:1
+35 ; delete FD Document when problem
+36 IF 'ENDO
IF $GET(ENFD("DA"))]""
Begin DoDot:1
+37 SET DA=ENFD("DA")
SET DIK="^ENG(6915.5,"
DO ^DIK
KILL DIK
End DoDot:1
+38 ; process and xmit FD
+39 if ENDO
DO UPDATE
+40 ; unlock FD
+41 IF $GET(ENFD("DA"))]""
LOCK -^ENG(6915.5,ENFD("DA"))
+42 ; return success OR failure
+43 QUIT ENDO
+44 ;
ADDFD ; create/lock stub entry for FD codesheet
+1 SET DIC="^ENG(6915.5,"
SET DIC(0)="L"
SET DLAYGO=6915.5
+2 SET X=ENEQ("DA")
SET DIC("DR")="1///NOW;1.5////^S X=DUZ"
+3 KILL DD,DO
DO FILE^DICN
KILL DIC,DLAYGO
+4 IF Y'>0
DO BAD("Can't add to FD DOCUMENT LOG")
SET ENDO=0
QUIT
+5 SET ENFD("DA")=+Y
+6 LOCK +^ENG(6915.5,ENFD("DA")):0
+7 IF '$TEST
DO BAD("Can't lock FD Document")
SET ENDO=0
QUIT
+8 ; save current asset value on FD
+9 SET $PIECE(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
+10 QUIT
+11 ;
CVTDATA ; convert 'user' pseudo field data into exported data
+1 ; get data from file
+2 FOR I=0,5,100
SET ENFAP(I)=$GET(^ENG(6915.5,ENFD("DA"),I))
+3 ; convert into exported data
+4 IF $PIECE(ENFAP(100),U,4)=""
SET $PIECE(ENFAP(100),U,4)=7
+5 IF $PIECE(ENFAP(5),U,8)=""
SET $PIECE(ENFAP(5),U,8)="0.00"
+6 SET X=$PIECE(ENFAP(100),U,3)
IF X]""
Begin DoDot:1
+7 SET $PIECE(ENFAP(5),U,5)=$EXTRACT(X,1,3)+1700
+8 SET $PIECE(ENFAP(5),U,6)=$EXTRACT(X,4,5)
+9 SET $PIECE(ENFAP(5),U,7)=$EXTRACT(X,6,7)
End DoDot:1
+10 SET X=$PIECE(ENFAP(100),U,4)
IF X
SET $PIECE(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
+11 ; update file
+12 SET ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
+13 SET ^ENG(6915.5,ENFD("DA"),100)=ENFAP(100)
+14 QUIT
+15 ;
UPDATE ; update files based on FD Document
+1 ; update FAP Balance
+2 DO ADJBAL^ENFABAL($PIECE(ENEQ(9),U,5),$PIECE(ENEQ(9),U,7),$PIECE(ENEQ(8),U,6),$PIECE($PIECE(ENFAP(0),U,2),"."),-$PIECE(ENEQ(2),U,3))
+3 ; update EQUIPMENT INV file
+4 SET DA=ENEQ("DA")
SET DIE="^ENG(6914,"
SET DR="34////A;38///6100"
DO ^DIE
+5 ; send FD Document to FAP
+6 DO ^ENFAXMT
+7 ; save adjustment voucher
+8 SET DIE="^ENG(6915.5,"
SET DR="301///NOW"
SET DA=ENFD("DA")
DO ^DIE
+9 QUIT
+10 ;
BAD(X) ; add text to validation problem list
+1 NEW I
+2 SET I=$PIECE($GET(^TMP($JOB,"BAD",ENEQ("DA"))),U)+1
+3 SET ^TMP($JOB,"BAD",ENEQ("DA"),I)=X
+4 SET ^TMP($JOB,"BAD",ENEQ("DA"))=I
+5 QUIT
+6 ;
+7 ;ENFACTX
