Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENFABETR

ENFABETR.m

Go to the documentation of this file.
  1. ENFABETR ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT BETTERMENTS; 6/9/97
  1. ;;7.0;ENGINEERING;**29,33,39**;Aug 17, 1993
  1. ; This routine should not be modified.
  1. ST D GETEQ^ENUTL G K:Y<0 S ENEQ("DA")=+Y
  1. L +^ENG(6914,ENEQ("DA")):5 I '$T W !!,$C(7),"Another user is editing this Equipment Record. Please try again later." G K
  1. I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D L -^ENG(6914,ENEQ("DA")) G K
  1. . W $C(7),!!,"There is no FA document on file for this asset. Nothing to better."
  1. 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
  1. . S Y=$P(X,U,3) D DD^%DT
  1. . W $C(7),!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
  1. . W !,"No action taken."
  1. S ENEQ(2)=$G(^ENG(6914,ENEQ("DA"),2)),ENEQ(8)=$G(^(8)),ENEQ(9)=$G(^(9))
  1. D BETNUM
  1. S DIC="^ENG(6915.3,",DIC(0)="L",DLAYGO=6915.3,X=ENEQ("DA")
  1. S DIC("DR")="1///NOW;1.5////^S X=DUZ;23///^S X=ENFB(""BETNUM"");35///^S X=$P(ENEQ(9),U,9)"
  1. K DD,DO D FILE^DICN K DLAYGO
  1. I Y'>0 W !!,$C(7),"Can't update betterment log. Better notify IRM." L -^ENG(6914,ENEQ("DA")) G K
  1. 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
  1. S ENFB("DA")=+Y
  1. W !!,"Current Asset Value is $",$P(ENEQ(2),U,3)
  1. DIE ;Edit the FB DOC LOG entry
  1. S DIE="^ENG(6915.3,",DIE("NO^")="BACKOUTOK"
  1. S DA=ENFB("DA")
  1. S DR="24;100;28;32BETTERMENT VALUE"
  1. W ! D ^DIE K DIE("NO^")
  1. I '$D(^ENG(6915.3,DA,4))!($D(DTOUT)) D G EXIT
  1. . W !!,$C(7),"This BETTERMENT is incomplete and is being deleted..."
  1. . S DIK=DIE D ^DIK K DIK
  1. S ENFAP("DOC")="FB"
  1. F I=0:1:6,100 S ENFAP(I)=$G(^ENG(6915.3,ENFB("DA"),I))
  1. K ^TMP($J) D ^ENFAVAL
  1. I $D(^TMP($J)) D LISTP^ENFAXMTM D G:$D(DIRUT)!'Y EXIT G DIE
  1. .S DIR(0)="Y",DIR("A")="Re-edit this betterment",DIR("B")="Y"
  1. .D ^DIR K DIR Q:Y
  1. .W !,"Sorry, I must then delete this betterment!"
  1. .S DIK=DIE,DA=ENFB("DA") D ^DIK W " ...deleted" S Y=0
  1. S ENAV=$$AVP^ENFAAV("6915.3",ENFB("DA"))
  1. 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
  1. S DIR(0)="Y",DIR("A")="Sure you want to process this betterment",DIR("B")="YES"
  1. D ^DIR I 'Y!($D(DIRUT)) S DIK=DIE,DA=ENFB("DA") D ^DIK W "...data base unchanged." G EXIT
  1. EQ ;apply changes
  1. ;save data in adjusted node of FB document for later use as FC defaults
  1. S ENFAP(200)=$P(ENFAP(4),U,4)_U_$P(ENFAP(3),U,8)_U_$P(ENFAP(100),U)
  1. S ENFAP(200)=ENFAP(200)_U_$P(ENFAP(3),U,12)
  1. S $P(^ENG(6915.3,ENFB("DA"),200),U,1)=ENFAP(200)
  1. ;update FAP Balance
  1. 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))
  1. W !!,"Updating the Equipment File..."
  1. S DA=ENEQ("DA"),DIE="^ENG(6914,"
  1. S ENEQ("NEW VAL")=$P(ENEQ(2),U,3)+$P(ENFAP(4),U,4)
  1. S DR="12////"_$$DEC^ENFAUTL(ENEQ("NEW VAL")) D ^DIE
  1. W !!,"Sending FB document to FAP." D ^ENFAXMT
  1. I ENAV D
  1. . S DIE="^ENG(6915.3,",DR="301///NOW",DA=ENFB("DA") D ^DIE
  1. . W !,"Adjustment Voucher was created.",!
  1. EXIT L -^ENG(6915.3,ENFB("DA")),-^ENG(6914,ENEQ("DA"))
  1. K K DA,DIC,DIE,DIK,DIR,DR,ENAV,ENFAP,ENFB,ENEQ,I,Y Q
  1. ;
  1. BETNUM N COUNT S COUNT=0 F I=0:0 S I=$O(^ENG(6915.3,"B",ENEQ("DA"),I)) Q:'I D
  1. .S COUNT=COUNT+1
  1. S COUNT=COUNT+1 S:COUNT<10 COUNT=0_COUNT S ENFB("BETNUM")=COUNT
  1. Q
  1. ;ENFABETR