source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFACTX.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1ENFACTX ;(WCIOFO)/SAB-FAP CAPITALIZATION THRESHOLD EXPENSE ITEM ;5/29/2002
2 ;;7.0;ENGINEERING;**63,71**;August 17, 1993
3 ;
4EXP(ENDA) ; Expense Equipment Item
5 ; input ENDA - equipment entry # to expense
6 ; returns 1 if success or 0 if failed
7 ; output ^TMP($J,"BAD",entry #
8 ; will be defined if problem
9 ;
10 N DA,DIC,DIE,DIK,DR,ENAVC,ENDO,ENEQ,ENFA,ENFAP,ENFD,ENX,I,X,Y
11 S ENDO=1 ; initialize return value as success
12 S ENEQ("DA")=ENDA
13 F I=2,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
14 ;
15 ; create FD Document
16 S ENFD("DA")=""
17 D:ENDO ADDFD
18 ; populate FD document with 'user' data
19 D:ENDO
20 . N ENFDA,ENERR
21 . S ENFDA(6915.5,ENFD("DA")_",",100)="FINAL DISPOSITION"
22 . S ENFDA(6915.5,ENFD("DA")_",",102)=$$FMTE^XLFDT(DT)
23 . S ENFDA(6915.5,ENFD("DA")_",",33)="0.00"
24 . S ENFDA(6915.5,ENFD("DA")_",",103)="OTHER"
25 . S ENFDA(6915.5,ENFD("DA")_",",34)="THRESH CHG 100K"
26 . S ENFDA(6915.5,ENFD("DA")_",",303)="OTHER"
27 . S ENFDA(6915.5,ENFD("DA")_",",310)="ENAVC"
28 . S ENAVC(1)="Expensed due to new capitalization threshold of $100,000."
29 . D FILE^DIE("E","ENFDA","ENERR")
30 . I $D(ENERR) D BAD("ERROR FILING DATA IN FD") S ENDO=0
31 ; convert 'user' data
32 D:ENDO CVTDATA
33 ; validate FD document
34 D:ENDO
35 . S ENFAP("DOC")="FD"
36 . K ^TMP($J,"BAD",ENEQ("DA"))
37 . D ^ENFAVAL
38 . I $D(^TMP($J,"BAD",ENEQ("DA"))) S ENDO=0
39 ; delete FD Document when problem
40 I 'ENDO,$G(ENFD("DA"))]"" D
41 . S DA=ENFD("DA"),DIK="^ENG(6915.5," D ^DIK K DIK
42 ; process and xmit FD
43 D:ENDO UPDATE
44 ; unlock FD
45 I $G(ENFD("DA"))]"" L -^ENG(6915.5,ENFD("DA"))
46 ; return success OR failure
47 Q ENDO
48 ;
49ADDFD ; create/lock stub entry for FD codesheet
50 S DIC="^ENG(6915.5,",DIC(0)="L",DLAYGO=6915.5
51 S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
52 K DD,DO D FILE^DICN K DIC,DLAYGO
53 I Y'>0 D BAD("Can't add to FD DOCUMENT LOG") S ENDO=0 Q
54 S ENFD("DA")=+Y
55 L +^ENG(6915.5,ENFD("DA")):0
56 I '$T D BAD("Can't lock FD Document") S ENDO=0 Q
57 ; save current asset value on FD
58 S $P(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
59 Q
60 ;
61CVTDATA ; convert 'user' pseudo field data into exported data
62 ; get data from file
63 F I=0,5,100 S ENFAP(I)=$G(^ENG(6915.5,ENFD("DA"),I))
64 ; convert into exported data
65 I $P(ENFAP(100),U,4)="" S $P(ENFAP(100),U,4)=7
66 I $P(ENFAP(5),U,8)="" S $P(ENFAP(5),U,8)="0.00"
67 S X=$P(ENFAP(100),U,3) I X]"" D
68 . S $P(ENFAP(5),U,5)=$E(X,1,3)+1700
69 . S $P(ENFAP(5),U,6)=$E(X,4,5)
70 . S $P(ENFAP(5),U,7)=$E(X,6,7)
71 S X=$P(ENFAP(100),U,4) I X S $P(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
72 ; update file
73 S ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
74 S ^ENG(6915.5,ENFD("DA"),100)=ENFAP(100)
75 Q
76 ;
77UPDATE ; update files based on FD Document
78 ; update FAP Balance
79 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))
80 ; update EQUIPMENT INV file
81 S DA=ENEQ("DA"),DIE="^ENG(6914," S DR="34////A;38///6100" D ^DIE
82 ; send FD Document to FAP
83 D ^ENFAXMT
84 ; save adjustment voucher
85 S DIE="^ENG(6915.5,",DR="301///NOW",DA=ENFD("DA") D ^DIE
86 Q
87 ;
88BAD(X) ; add text to validation problem list
89 N I
90 S I=$P($G(^TMP($J,"BAD",ENEQ("DA"))),U)+1
91 S ^TMP($J,"BAD",ENEQ("DA"),I)=X
92 S ^TMP($J,"BAD",ENEQ("DA"))=I
93 Q
94 ;
95 ;ENFACTX
Note: See TracBrowser for help on using the repository browser.