source: FOIAVistA/tag/r/ENGINEERING-EN/ENFABETR.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1ENFABETR ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT BETTERMENTS; 6/9/97
2 ;;7.0;ENGINEERING;**29,33,39**;Aug 17, 1993
3 ; This routine should not be modified.
4ST D GETEQ^ENUTL G K:Y<0 S ENEQ("DA")=+Y
5 L +^ENG(6914,ENEQ("DA")):5 I '$T W !!,$C(7),"Another user is editing this Equipment Record. Please try again later." G K
6 I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D L -^ENG(6914,ENEQ("DA")) G K
7 . W $C(7),!!,"There is no FA document on file for this asset. Nothing to better."
8 I $D(^ENG(6915.5,"B",ENEQ("DA"))) S X=$$CHKFA^ENFAUTL(ENEQ("DA")) I +X=0 D L -^ENG(6914,ENEQ("DA")) G K
9 . S Y=$P(X,U,3) D DD^%DT
10 . W $C(7),!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
11 . W !,"No action taken."
12 S ENEQ(2)=$G(^ENG(6914,ENEQ("DA"),2)),ENEQ(8)=$G(^(8)),ENEQ(9)=$G(^(9))
13 D BETNUM
14 S DIC="^ENG(6915.3,",DIC(0)="L",DLAYGO=6915.3,X=ENEQ("DA")
15 S DIC("DR")="1///NOW;1.5////^S X=DUZ;23///^S X=ENFB(""BETNUM"");35///^S X=$P(ENEQ(9),U,9)"
16 K DD,DO D FILE^DICN K DLAYGO
17 I Y'>0 W !!,$C(7),"Can't update betterment log. Better notify IRM." L -^ENG(6914,ENEQ("DA")) G K
18 L +^ENG(6915.3,+Y):0 I '$T W !!,$C(7),"The FB document that you just created is being edited by someone else.",!,"Please notify your ADPAC." L -^ENG(6914,ENEQ("DA")) G K
19 S ENFB("DA")=+Y
20 W !!,"Current Asset Value is $",$P(ENEQ(2),U,3)
21DIE ;Edit the FB DOC LOG entry
22 S DIE="^ENG(6915.3,",DIE("NO^")="BACKOUTOK"
23 S DA=ENFB("DA")
24 S DR="24;100;28;32BETTERMENT VALUE"
25 W ! D ^DIE K DIE("NO^")
26 I '$D(^ENG(6915.3,DA,4))!($D(DTOUT)) D G EXIT
27 . W !!,$C(7),"This BETTERMENT is incomplete and is being deleted..."
28 . S DIK=DIE D ^DIK K DIK
29 S ENFAP("DOC")="FB"
30 F I=0:1:6,100 S ENFAP(I)=$G(^ENG(6915.3,ENFB("DA"),I))
31 K ^TMP($J) D ^ENFAVAL
32 I $D(^TMP($J)) D LISTP^ENFAXMTM D G:$D(DIRUT)!'Y EXIT G DIE
33 .S DIR(0)="Y",DIR("A")="Re-edit this betterment",DIR("B")="Y"
34 .D ^DIR K DIR Q:Y
35 .W !,"Sorry, I must then delete this betterment!"
36 .S DIK=DIE,DA=ENFB("DA") D ^DIK W " ...deleted" S Y=0
37 S ENAV=$$AVP^ENFAAV("6915.3",ENFB("DA"))
38 I 'ENAV W !,"Adjustment voucher was NOT created." I $G(ENUT) S DIK=DIE,DA=ENFB("DA") D ^DIK W "...data base unchanged." G EXIT
39 S DIR(0)="Y",DIR("A")="Sure you want to process this betterment",DIR("B")="YES"
40 D ^DIR I 'Y!($D(DIRUT)) S DIK=DIE,DA=ENFB("DA") D ^DIK W "...data base unchanged." G EXIT
41EQ ;apply changes
42 ;save data in adjusted node of FB document for later use as FC defaults
43 S ENFAP(200)=$P(ENFAP(4),U,4)_U_$P(ENFAP(3),U,8)_U_$P(ENFAP(100),U)
44 S ENFAP(200)=ENFAP(200)_U_$P(ENFAP(3),U,12)
45 S $P(^ENG(6915.3,ENFB("DA"),200),U,1)=ENFAP(200)
46 ;update FAP Balance
47 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(ENFAP(4),U,4))
48 W !!,"Updating the Equipment File..."
49 S DA=ENEQ("DA"),DIE="^ENG(6914,"
50 S ENEQ("NEW VAL")=$P(ENEQ(2),U,3)+$P(ENFAP(4),U,4)
51 S DR="12////"_$$DEC^ENFAUTL(ENEQ("NEW VAL")) D ^DIE
52 W !!,"Sending FB document to FAP." D ^ENFAXMT
53 I ENAV D
54 . S DIE="^ENG(6915.3,",DR="301///NOW",DA=ENFB("DA") D ^DIE
55 . W !,"Adjustment Voucher was created.",!
56EXIT L -^ENG(6915.3,ENFB("DA")),-^ENG(6914,ENEQ("DA"))
57K K DA,DIC,DIE,DIK,DIR,DR,ENAV,ENFAP,ENFB,ENEQ,I,Y Q
58 ;
59BETNUM N COUNT S COUNT=0 F I=0:0 S I=$O(^ENG(6915.3,"B",ENEQ("DA"),I)) Q:'I D
60 .S COUNT=COUNT+1
61 S COUNT=COUNT+1 S:COUNT<10 COUNT=0_COUNT S ENFB("BETNUM")=COUNT
62 Q
63 ;ENFABETR
Note: See TracBrowser for help on using the repository browser.