ENFADEL ;WASHINGTON IRMFO/KLD/DH/SAB; Equipment Disposition ; 4/15/13 11:52am
;;7.0;ENGINEERING;**29,33,38,39,46,92**;Aug 17, 1993;Build 10
;This routine should not be modified.
;patch 92 renamed gl 1524 to 1995
ST D GETEQ^ENUTL G K:Y'>0
S (DA,ENEQ("DA"))=+Y
L +^ENG(6914,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",DA)) D G K
. W $C(7),!,"There is no FA document on file for this asset. No action taken."
I $D(^ENG(6915.5,"B",DA)) S X=$$CHKFA^ENFAUTL(DA) I +X=0 D G K
. S Y=$P(X,U,3) D DD^%DT
. W $C(7),!,"An FD document for ENTRY #",DA," was processed on ",Y,"."
. W !,"No action taken."
F I=2,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
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 DLAYGO
S ENFD("DA")=+Y
L +^ENG(6915.5,ENFD("DA")):0 I '$T W !!,$C(7),"Another user is editing the FD document that you just created.",!,"Please notify your ADPAC." L -^ENG(6914,ENEQ("DA")) G K
; ask type of FD
S DIE="^ENG(6915.5,",DA=ENFD("DA"),DR="100"
D ^DIE I $D(Y)!$D(DTOUT) D G EXIT
. W !!,$C(7),"The type of FD Document is required. No action taken."
. S DIK=DIE D ^DIK K DIK
S ENFD("TYPE")=$P($G(^ENG(6915.5,ENFD("DA"),100)),U)
I ENFD("TYPE")="T",$$GET1^DIQ(6914,ENEQ("DA"),38)="1995" D I 'Y W !!,"No action taken." S DIK=DIE D ^DIK K DIK G EXIT
. W !,"This equipment item is already on SGL 1995 (Excess)."
. S DIR(0)="Y",DIR("A")="Are you sure you want to process a Turn-In"
. S DIR("B")="NO" D ^DIR K DIR
DIE ;Enter data for FD DOC
S DIE="^ENG(6915.5,",DIE("NO^")="BACKOUTOK"
S DA=ENFD("DA"),DR="[ENFA DELETE-"_ENFD("TYPE")_"]"
W ! D ^DIE I $D(Y)!($D(DTOUT)) D G EXIT
. W !!,$C(7),"This FD document is incomplete and is being deleted..."
. S DIK=DIE D ^DIK K DIK
I ENFD("TYPE")="T" D I $D(Y)!($D(DTOUT)) G EXIT
. ; ask fair market value at turn-in
. W !!,"When equipment is turned-in, its TOTAL ASSET VALUE must be"
. W !,"changed to the fair market value per VA Accounting Standards."
. W !,"NOTE: The current TOTAL ASSET VALUE will automatically be saved"
. W !,"in the ORIGINAL ASSET VALUE field."
. ; compute repair costs (exclude PM)
. S (ENT,ENT("L"),ENT("M"),ENT("V"))=0
. S ENI=0 F S ENI=$O(^ENG(6914,ENEQ("DA"),6,ENI)) Q:'ENI D
. . S ENY=$G(^ENG(6914,ENEQ("DA"),6,ENI,0))
. . Q:$E($P(ENY,U,2),1,3)="PM-" ; exclude PM
. . S ENT("L")=ENT("L")+$P(ENY,U,5)
. . S ENT("M")=ENT("M")+$P(ENY,U,6)
. . S ENT("V")=ENT("V")+$P(ENY,U,7)
. S ENT=ENT("L")+ENT("M")+ENT("V")
. ; display info to assist determination of fair market value
. W !!,"Current TOTAL ASSET VALUE: ",$FN($P(ENEQ(2),U,3),",",2)
. W !,"Acquisition Date: ",$$FMTE^XLFDT($P(ENEQ(2),U,4))," Life Expectancy: ",$P(ENEQ(2),U,6)
. W !,"Replacement Date: ",$$FMTE^XLFDT($P(ENEQ(2),U,10))
. W " Condition: ",$$GET1^DIQ(6914,ENEQ("DA"),53)
. W !,"Repair Costs (excluding preventive maintenance)"
. W !," Labor$ :",$FN(ENT("L"),",",0)," Material$: ",$FN(ENT("M"),",",0)," Vendor$: ",$FN(ENT("V"),",",0)," Total$: ",$FN(ENT,",",0),!
. K ENT
. S DIE="^ENG(6915.5,",DA=ENFD("DA"),DR="104R"
. D ^DIE I $D(Y)!($D(DTOUT)) D
. . W !!,$C(7),"Fair Market Value unspecified. This FD document is being deleted..."
. . S DIK=DIE D ^DIK K DIK
S ENFAP("DOC")="FD"
S ENFAP(0)=$G(^ENG(6915.5,DA,0)),ENFAP(5)=$G(^(5)),ENFAP(100)=$G(^(100))
I $P(ENFAP(5),U,8)="" S $P(ENFAP(5),U,8)="0.00"
I $P(ENFAP(100),U,4)="" S $P(ENFAP(100),U,4)=7
S $P(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
S X=$P(ENFAP(100),U,3) I X]"" S $P(ENFAP(5),U,5)=$E(X,1,3)+1700,$P(ENFAP(5),U,6)=$E(X,4,5),$P(ENFAP(5),U,7)=$E(X,6,7)
S X=$P(ENFAP(100),U,4) S:X $P(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
S ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
K ^TMP($J) D ^ENFAVAL
I $D(^TMP($J)) D LISTP^ENFAXMTM D G DIE:"Yy"[X,EXIT
.R !!,"Re-edit this disposition? Y// ",X:DTIME S:'$T X=U Q:"Yy"[X
.W !,"Sorry, I must then delete this FD document!"
.S DIK=DIE,DA=ENFD("DA") D ^DIK W " ...deleted" S X=U
S ENAV=$$AVP^ENFAAV("6915.5",ENFD("DA"))
I 'ENAV W !,"Adjustment voucher was NOT created." I $G(ENUT) S DIK=DIE D ^DIK W !,"No action taken. Database unchanged." K DIR G EXIT
S DIR(0)="Y",DIR("A")="Sure you want to process this disposition",DIR("B")="YES"
D ^DIR I 'Y!($D(DIRUT)) S DIK=DIE D ^DIK W "...data base unchanged." K DIR G EXIT
EQ ; update
;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))
W !!,"Updating the Equipment File..."
S DA=ENEQ("DA"),DIE="^ENG(6914," K DIC
S DR="31////"_$P(ENFAP(100),U,4)_";32////"_$P(ENFAP(5),U,8) D ^DIE
S DR="20////4;19////@;38////@" D ^DIE
I ENFD("TYPE")="T" D
. I $P(^ENG(6914,DA,3),U,15)'>0 S $P(^(3),U,15)=$P(ENEQ(2),U,3) ; orig.$
. S DR="20.5////"_$P(ENFAP(100),U,3)
. S DR=DR_";12////"_$$DEC^ENFAUTL($P(ENFAP(100),U,5))
. D ^DIE
I ENFD("TYPE")="D" S DR="22////"_$P(ENFAP(100),U,3) D ^DIE
W !!,"Sending FD document to FAP." D ^ENFAXMT
I $G(ENAV) D
. S DIE="^ENG(6915.5,",DR="301///NOW",DA=ENFD("DA") D ^DIE
. W !,"Adjustment Voucher was created.",!
I ENFD("TYPE")="T" D
. W !!,"Editing Equipment Data"
. S DA=ENEQ("DA"),DIE="^ENG(6914,"
. S DR="20;19//996;38//1995"
. D ^DIE Q:$D(DTOUT)
. Q:$$GET1^DIQ(6914,ENEQ("DA"),38)'=1995
. S DIR(0)="Y",DIR("A")="Should a FA Document also be sent"
. S DIR("?",1)="The FD Document removed the asset from Fixed Assets."
. S DIR("?",2)="Since the asset was placed in the Excess (1995) account"
. S DIR("?",3)="a FA Document should be sent adding it to Fixed Assets"
. S DIR("?",4)="as excess equipment."
. S DIR("?")="Enter YES to send a FA Document"
. W ! D ^DIR K DIR Q:$D(DIRUT)!'Y
. D ^ENFAACQ
EXIT L -^ENG(6915.5,ENFD("DA")),-^ENG(6914,ENEQ("DA"))
;
K K DA,DIC,DIE,DR,ENAV,ENEQ,ENFA,ENFAP,ENFD,I,X,Y Q
;
;ENFADEL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFADEL 5982 printed Apr 09, 2024@20:59:17 Page 2
ENFADEL ;WASHINGTON IRMFO/KLD/DH/SAB; Equipment Disposition ; 4/15/13 11:52am
+1 ;;7.0;ENGINEERING;**29,33,38,39,46,92**;Aug 17, 1993;Build 10
+2 ;This routine should not be modified.
+3 ;patch 92 renamed gl 1524 to 1995
ST DO GETEQ^ENUTL
if Y'>0
GOTO K
+1 SET (DA,ENEQ("DA"))=+Y
+2 LOCK +^ENG(6914,DA):5
IF '$TEST
WRITE !!,$CHAR(7),"Another user is editing this Equipment Record. Please try again later."
GOTO K
+3 IF '$DATA(^ENG(6915.2,"B",DA))
Begin DoDot:1
+4 WRITE $CHAR(7),!,"There is no FA document on file for this asset. No action taken."
End DoDot:1
GOTO K
+5 IF $DATA(^ENG(6915.5,"B",DA))
SET X=$$CHKFA^ENFAUTL(DA)
IF +X=0
Begin DoDot:1
+6 SET Y=$PIECE(X,U,3)
DO DD^%DT
+7 WRITE $CHAR(7),!,"An FD document for ENTRY #",DA," was processed on ",Y,"."
+8 WRITE !,"No action taken."
End DoDot:1
GOTO K
+9 FOR I=2,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+10 SET DIC="^ENG(6915.5,"
SET DIC(0)="L"
SET DLAYGO=6915.5
+11 SET X=ENEQ("DA")
SET DIC("DR")="1///NOW;1.5////^S X=DUZ"
+12 KILL DD,DO
DO FILE^DICN
KILL DLAYGO
+13 SET ENFD("DA")=+Y
+14 LOCK +^ENG(6915.5,ENFD("DA")):0
IF '$TEST
WRITE !!,$CHAR(7),"Another user is editing the FD document that you just created.",!,"Please notify your ADPAC."
LOCK -^ENG(6914,ENEQ("DA"))
GOTO K
+15 ; ask type of FD
+16 SET DIE="^ENG(6915.5,"
SET DA=ENFD("DA")
SET DR="100"
+17 DO ^DIE
IF $DATA(Y)!$DATA(DTOUT)
Begin DoDot:1
+18 WRITE !!,$CHAR(7),"The type of FD Document is required. No action taken."
+19 SET DIK=DIE
DO ^DIK
KILL DIK
End DoDot:1
GOTO EXIT
+20 SET ENFD("TYPE")=$PIECE($GET(^ENG(6915.5,ENFD("DA"),100)),U)
+21 IF ENFD("TYPE")="T"
IF $$GET1^DIQ(6914,ENEQ("DA"),38)="1995"
Begin DoDot:1
+22 WRITE !,"This equipment item is already on SGL 1995 (Excess)."
+23 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to process a Turn-In"
+24 SET DIR("B")="NO"
DO ^DIR
KILL DIR
End DoDot:1
IF 'Y
WRITE !!,"No action taken."
SET DIK=DIE
DO ^DIK
KILL DIK
GOTO EXIT
DIE ;Enter data for FD DOC
+1 SET DIE="^ENG(6915.5,"
SET DIE("NO^")="BACKOUTOK"
+2 SET DA=ENFD("DA")
SET DR="[ENFA DELETE-"_ENFD("TYPE")_"]"
+3 WRITE !
DO ^DIE
IF $DATA(Y)!($DATA(DTOUT))
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"This FD document is incomplete and is being deleted..."
+5 SET DIK=DIE
DO ^DIK
KILL DIK
End DoDot:1
GOTO EXIT
+6 IF ENFD("TYPE")="T"
Begin DoDot:1
+7 ; ask fair market value at turn-in
+8 WRITE !!,"When equipment is turned-in, its TOTAL ASSET VALUE must be"
+9 WRITE !,"changed to the fair market value per VA Accounting Standards."
+10 WRITE !,"NOTE: The current TOTAL ASSET VALUE will automatically be saved"
+11 WRITE !,"in the ORIGINAL ASSET VALUE field."
+12 ; compute repair costs (exclude PM)
+13 SET (ENT,ENT("L"),ENT("M"),ENT("V"))=0
+14 SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6914,ENEQ("DA"),6,ENI))
if 'ENI
QUIT
Begin DoDot:2
+15 SET ENY=$GET(^ENG(6914,ENEQ("DA"),6,ENI,0))
+16 ; exclude PM
if $EXTRACT($PIECE(ENY,U,2),1,3)="PM-"
QUIT
+17 SET ENT("L")=ENT("L")+$PIECE(ENY,U,5)
+18 SET ENT("M")=ENT("M")+$PIECE(ENY,U,6)
+19 SET ENT("V")=ENT("V")+$PIECE(ENY,U,7)
End DoDot:2
+20 SET ENT=ENT("L")+ENT("M")+ENT("V")
+21 ; display info to assist determination of fair market value
+22 WRITE !!,"Current TOTAL ASSET VALUE: ",$FNUMBER($PIECE(ENEQ(2),U,3),",",2)
+23 WRITE !,"Acquisition Date: ",$$FMTE^XLFDT($PIECE(ENEQ(2),U,4))," Life Expectancy: ",$PIECE(ENEQ(2),U,6)
+24 WRITE !,"Replacement Date: ",$$FMTE^XLFDT($PIECE(ENEQ(2),U,10))
+25 WRITE " Condition: ",$$GET1^DIQ(6914,ENEQ("DA"),53)
+26 WRITE !,"Repair Costs (excluding preventive maintenance)"
+27 WRITE !," Labor$ :",$FNUMBER(ENT("L"),",",0)," Material$: ",$FNUMBER(ENT("M"),",",0)," Vendor$: ",$FNUMBER(ENT("V"),",",0)," Total$: ",$FNUMBER(ENT,",",0),!
+28 KILL ENT
+29 SET DIE="^ENG(6915.5,"
SET DA=ENFD("DA")
SET DR="104R"
+30 DO ^DIE
IF $DATA(Y)!($DATA(DTOUT))
Begin DoDot:2
+31 WRITE !!,$CHAR(7),"Fair Market Value unspecified. This FD document is being deleted..."
+32 SET DIK=DIE
DO ^DIK
KILL DIK
End DoDot:2
End DoDot:1
IF $DATA(Y)!($DATA(DTOUT))
GOTO EXIT
+33 SET ENFAP("DOC")="FD"
+34 SET ENFAP(0)=$GET(^ENG(6915.5,DA,0))
SET ENFAP(5)=$GET(^(5))
SET ENFAP(100)=$GET(^(100))
+35 IF $PIECE(ENFAP(5),U,8)=""
SET $PIECE(ENFAP(5),U,8)="0.00"
+36 IF $PIECE(ENFAP(100),U,4)=""
SET $PIECE(ENFAP(100),U,4)=7
+37 SET $PIECE(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
+38 SET X=$PIECE(ENFAP(100),U,3)
IF X]""
SET $PIECE(ENFAP(5),U,5)=$EXTRACT(X,1,3)+1700
SET $PIECE(ENFAP(5),U,6)=$EXTRACT(X,4,5)
SET $PIECE(ENFAP(5),U,7)=$EXTRACT(X,6,7)
+39 SET X=$PIECE(ENFAP(100),U,4)
if X
SET $PIECE(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
+40 SET ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
+41 KILL ^TMP($JOB)
DO ^ENFAVAL
+42 IF $DATA(^TMP($JOB))
DO LISTP^ENFAXMTM
Begin DoDot:1
+43 READ !!,"Re-edit this disposition? Y// ",X:DTIME
if '$TEST
SET X=U
if "Yy"[X
QUIT
+44 WRITE !,"Sorry, I must then delete this FD document!"
+45 SET DIK=DIE
SET DA=ENFD("DA")
DO ^DIK
WRITE " ...deleted"
SET X=U
End DoDot:1
if "Yy"[X
GOTO DIE
GOTO EXIT
+46 SET ENAV=$$AVP^ENFAAV("6915.5",ENFD("DA"))
+47 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
IF $GET(ENUT)
SET DIK=DIE
DO ^DIK
WRITE !,"No action taken. Database unchanged."
KILL DIR
GOTO EXIT
+48 SET DIR(0)="Y"
SET DIR("A")="Sure you want to process this disposition"
SET DIR("B")="YES"
+49 DO ^DIR
IF 'Y!($DATA(DIRUT))
SET DIK=DIE
DO ^DIK
WRITE "...data base unchanged."
KILL DIR
GOTO EXIT
EQ ; update
+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 WRITE !!,"Updating the Equipment File..."
+4 SET DA=ENEQ("DA")
SET DIE="^ENG(6914,"
KILL DIC
+5 SET DR="31////"_$PIECE(ENFAP(100),U,4)_";32////"_$PIECE(ENFAP(5),U,8)
DO ^DIE
+6 SET DR="20////4;19////@;38////@"
DO ^DIE
+7 IF ENFD("TYPE")="T"
Begin DoDot:1
+8 ; orig.$
IF $PIECE(^ENG(6914,DA,3),U,15)'>0
SET $PIECE(^(3),U,15)=$PIECE(ENEQ(2),U,3)
+9 SET DR="20.5////"_$PIECE(ENFAP(100),U,3)
+10 SET DR=DR_";12////"_$$DEC^ENFAUTL($PIECE(ENFAP(100),U,5))
+11 DO ^DIE
End DoDot:1
+12 IF ENFD("TYPE")="D"
SET DR="22////"_$PIECE(ENFAP(100),U,3)
DO ^DIE
+13 WRITE !!,"Sending FD document to FAP."
DO ^ENFAXMT
+14 IF $GET(ENAV)
Begin DoDot:1
+15 SET DIE="^ENG(6915.5,"
SET DR="301///NOW"
SET DA=ENFD("DA")
DO ^DIE
+16 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
+17 IF ENFD("TYPE")="T"
Begin DoDot:1
+18 WRITE !!,"Editing Equipment Data"
+19 SET DA=ENEQ("DA")
SET DIE="^ENG(6914,"
+20 SET DR="20;19//996;38//1995"
+21 DO ^DIE
if $DATA(DTOUT)
QUIT
+22 if $$GET1^DIQ(6914,ENEQ("DA"),38)'=1995
QUIT
+23 SET DIR(0)="Y"
SET DIR("A")="Should a FA Document also be sent"
+24 SET DIR("?",1)="The FD Document removed the asset from Fixed Assets."
+25 SET DIR("?",2)="Since the asset was placed in the Excess (1995) account"
+26 SET DIR("?",3)="a FA Document should be sent adding it to Fixed Assets"
+27 SET DIR("?",4)="as excess equipment."
+28 SET DIR("?")="Enter YES to send a FA Document"
+29 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
QUIT
+30 DO ^ENFAACQ
End DoDot:1
EXIT LOCK -^ENG(6915.5,ENFD("DA")),-^ENG(6914,ENEQ("DA"))
+1 ;
K KILL DA,DIC,DIE,DR,ENAV,ENEQ,ENFA,ENFAP,ENFD,I,X,Y
QUIT
+1 ;
+2 ;ENFADEL
