ENFABETR ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT BETTERMENTS; 6/9/97
;;7.0;ENGINEERING;**29,33,39**;Aug 17, 1993
; This routine should not be modified.
ST D GETEQ^ENUTL G K:Y<0 S ENEQ("DA")=+Y
L +^ENG(6914,ENEQ("DA")):5 I '$T W !!,$C(7),"Another user is editing this Equipment Record. Please try again later." G K
I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D L -^ENG(6914,ENEQ("DA")) G K
. W $C(7),!!,"There is no FA document on file for this asset. Nothing to better."
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
. S Y=$P(X,U,3) D DD^%DT
. W $C(7),!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
. W !,"No action taken."
S ENEQ(2)=$G(^ENG(6914,ENEQ("DA"),2)),ENEQ(8)=$G(^(8)),ENEQ(9)=$G(^(9))
D BETNUM
S DIC="^ENG(6915.3,",DIC(0)="L",DLAYGO=6915.3,X=ENEQ("DA")
S DIC("DR")="1///NOW;1.5////^S X=DUZ;23///^S X=ENFB(""BETNUM"");35///^S X=$P(ENEQ(9),U,9)"
K DD,DO D FILE^DICN K DLAYGO
I Y'>0 W !!,$C(7),"Can't update betterment log. Better notify IRM." L -^ENG(6914,ENEQ("DA")) G K
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
S ENFB("DA")=+Y
W !!,"Current Asset Value is $",$P(ENEQ(2),U,3)
DIE ;Edit the FB DOC LOG entry
S DIE="^ENG(6915.3,",DIE("NO^")="BACKOUTOK"
S DA=ENFB("DA")
S DR="24;100;28;32BETTERMENT VALUE"
W ! D ^DIE K DIE("NO^")
I '$D(^ENG(6915.3,DA,4))!($D(DTOUT)) D G EXIT
. W !!,$C(7),"This BETTERMENT is incomplete and is being deleted..."
. S DIK=DIE D ^DIK K DIK
S ENFAP("DOC")="FB"
F I=0:1:6,100 S ENFAP(I)=$G(^ENG(6915.3,ENFB("DA"),I))
K ^TMP($J) D ^ENFAVAL
I $D(^TMP($J)) D LISTP^ENFAXMTM D G:$D(DIRUT)!'Y EXIT G DIE
.S DIR(0)="Y",DIR("A")="Re-edit this betterment",DIR("B")="Y"
.D ^DIR K DIR Q:Y
.W !,"Sorry, I must then delete this betterment!"
.S DIK=DIE,DA=ENFB("DA") D ^DIK W " ...deleted" S Y=0
S ENAV=$$AVP^ENFAAV("6915.3",ENFB("DA"))
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
S DIR(0)="Y",DIR("A")="Sure you want to process this betterment",DIR("B")="YES"
D ^DIR I 'Y!($D(DIRUT)) S DIK=DIE,DA=ENFB("DA") D ^DIK W "...data base unchanged." G EXIT
EQ ;apply changes
;save data in adjusted node of FB document for later use as FC defaults
S ENFAP(200)=$P(ENFAP(4),U,4)_U_$P(ENFAP(3),U,8)_U_$P(ENFAP(100),U)
S ENFAP(200)=ENFAP(200)_U_$P(ENFAP(3),U,12)
S $P(^ENG(6915.3,ENFB("DA"),200),U,1)=ENFAP(200)
;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(ENFAP(4),U,4))
W !!,"Updating the Equipment File..."
S DA=ENEQ("DA"),DIE="^ENG(6914,"
S ENEQ("NEW VAL")=$P(ENEQ(2),U,3)+$P(ENFAP(4),U,4)
S DR="12////"_$$DEC^ENFAUTL(ENEQ("NEW VAL")) D ^DIE
W !!,"Sending FB document to FAP." D ^ENFAXMT
I ENAV D
. S DIE="^ENG(6915.3,",DR="301///NOW",DA=ENFB("DA") D ^DIE
. W !,"Adjustment Voucher was created.",!
EXIT L -^ENG(6915.3,ENFB("DA")),-^ENG(6914,ENEQ("DA"))
K K DA,DIC,DIE,DIK,DIR,DR,ENAV,ENFAP,ENFB,ENEQ,I,Y Q
;
BETNUM N COUNT S COUNT=0 F I=0:0 S I=$O(^ENG(6915.3,"B",ENEQ("DA"),I)) Q:'I D
.S COUNT=COUNT+1
S COUNT=COUNT+1 S:COUNT<10 COUNT=0_COUNT S ENFB("BETNUM")=COUNT
Q
;ENFABETR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFABETR 3370 printed Apr 09, 2024@20:57:25 Page 2
ENFABETR ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT BETTERMENTS; 6/9/97
+1 ;;7.0;ENGINEERING;**29,33,39**;Aug 17, 1993
+2 ; This routine should not be modified.
ST DO GETEQ^ENUTL
if Y<0
GOTO K
SET ENEQ("DA")=+Y
+1 LOCK +^ENG(6914,ENEQ("DA")):5
IF '$TEST
WRITE !!,$CHAR(7),"Another user is editing this Equipment Record. Please try again later."
GOTO K
+2 IF '$DATA(^ENG(6915.2,"B",ENEQ("DA")))
Begin DoDot:1
+3 WRITE $CHAR(7),!!,"There is no FA document on file for this asset. Nothing to better."
End DoDot:1
LOCK -^ENG(6914,ENEQ("DA"))
GOTO K
+4 IF $DATA(^ENG(6915.5,"B",ENEQ("DA")))
SET X=$$CHKFA^ENFAUTL(ENEQ("DA"))
IF +X=0
Begin DoDot:1
+5 SET Y=$PIECE(X,U,3)
DO DD^%DT
+6 WRITE $CHAR(7),!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
+7 WRITE !,"No action taken."
End DoDot:1
LOCK -^ENG(6914,ENEQ("DA"))
GOTO K
+8 SET ENEQ(2)=$GET(^ENG(6914,ENEQ("DA"),2))
SET ENEQ(8)=$GET(^(8))
SET ENEQ(9)=$GET(^(9))
+9 DO BETNUM
+10 SET DIC="^ENG(6915.3,"
SET DIC(0)="L"
SET DLAYGO=6915.3
SET X=ENEQ("DA")
+11 SET DIC("DR")="1///NOW;1.5////^S X=DUZ;23///^S X=ENFB(""BETNUM"");35///^S X=$P(ENEQ(9),U,9)"
+12 KILL DD,DO
DO FILE^DICN
KILL DLAYGO
+13 IF Y'>0
WRITE !!,$CHAR(7),"Can't update betterment log. Better notify IRM."
LOCK -^ENG(6914,ENEQ("DA"))
GOTO K
+14 LOCK +^ENG(6915.3,+Y):0
IF '$TEST
WRITE !!,$CHAR(7),"The FB document that you just created is being edited by someone else.",!,"Please notify your ADPAC."
LOCK -^ENG(6914,ENEQ("DA"))
GOTO K
+15 SET ENFB("DA")=+Y
+16 WRITE !!,"Current Asset Value is $",$PIECE(ENEQ(2),U,3)
DIE ;Edit the FB DOC LOG entry
+1 SET DIE="^ENG(6915.3,"
SET DIE("NO^")="BACKOUTOK"
+2 SET DA=ENFB("DA")
+3 SET DR="24;100;28;32BETTERMENT VALUE"
+4 WRITE !
DO ^DIE
KILL DIE("NO^")
+5 IF '$DATA(^ENG(6915.3,DA,4))!($DATA(DTOUT))
Begin DoDot:1
+6 WRITE !!,$CHAR(7),"This BETTERMENT is incomplete and is being deleted..."
+7 SET DIK=DIE
DO ^DIK
KILL DIK
End DoDot:1
GOTO EXIT
+8 SET ENFAP("DOC")="FB"
+9 FOR I=0:1:6,100
SET ENFAP(I)=$GET(^ENG(6915.3,ENFB("DA"),I))
+10 KILL ^TMP($JOB)
DO ^ENFAVAL
+11 IF $DATA(^TMP($JOB))
DO LISTP^ENFAXMTM
Begin DoDot:1
+12 SET DIR(0)="Y"
SET DIR("A")="Re-edit this betterment"
SET DIR("B")="Y"
+13 DO ^DIR
KILL DIR
if Y
QUIT
+14 WRITE !,"Sorry, I must then delete this betterment!"
+15 SET DIK=DIE
SET DA=ENFB("DA")
DO ^DIK
WRITE " ...deleted"
SET Y=0
End DoDot:1
if $DATA(DIRUT)!'Y
GOTO EXIT
GOTO DIE
+16 SET ENAV=$$AVP^ENFAAV("6915.3",ENFB("DA"))
+17 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
IF $GET(ENUT)
SET DIK=DIE
SET DA=ENFB("DA")
DO ^DIK
WRITE "...data base unchanged."
GOTO EXIT
+18 SET DIR(0)="Y"
SET DIR("A")="Sure you want to process this betterment"
SET DIR("B")="YES"
+19 DO ^DIR
IF 'Y!($DATA(DIRUT))
SET DIK=DIE
SET DA=ENFB("DA")
DO ^DIK
WRITE "...data base unchanged."
GOTO EXIT
EQ ;apply changes
+1 ;save data in adjusted node of FB document for later use as FC defaults
+2 SET ENFAP(200)=$PIECE(ENFAP(4),U,4)_U_$PIECE(ENFAP(3),U,8)_U_$PIECE(ENFAP(100),U)
+3 SET ENFAP(200)=ENFAP(200)_U_$PIECE(ENFAP(3),U,12)
+4 SET $PIECE(^ENG(6915.3,ENFB("DA"),200),U,1)=ENFAP(200)
+5 ;update FAP Balance
+6 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(ENFAP(4),U,4))
+7 WRITE !!,"Updating the Equipment File..."
+8 SET DA=ENEQ("DA")
SET DIE="^ENG(6914,"
+9 SET ENEQ("NEW VAL")=$PIECE(ENEQ(2),U,3)+$PIECE(ENFAP(4),U,4)
+10 SET DR="12////"_$$DEC^ENFAUTL(ENEQ("NEW VAL"))
DO ^DIE
+11 WRITE !!,"Sending FB document to FAP."
DO ^ENFAXMT
+12 IF ENAV
Begin DoDot:1
+13 SET DIE="^ENG(6915.3,"
SET DR="301///NOW"
SET DA=ENFB("DA")
DO ^DIE
+14 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
EXIT LOCK -^ENG(6915.3,ENFB("DA")),-^ENG(6914,ENEQ("DA"))
K KILL DA,DIC,DIE,DIK,DIR,DR,ENAV,ENFAP,ENFB,ENEQ,I,Y
QUIT
+1 ;
BETNUM NEW COUNT
SET COUNT=0
FOR I=0:0
SET I=$ORDER(^ENG(6915.3,"B",ENEQ("DA"),I))
if 'I
QUIT
Begin DoDot:1
+1 SET COUNT=COUNT+1
End DoDot:1
+2 SET COUNT=COUNT+1
if COUNT<10
SET COUNT=0_COUNT
SET ENFB("BETNUM")=COUNT
+3 QUIT
+4 ;ENFABETR
