source: FOIAVistA/trunk/r/ENGINEERING-EN/ENFADEL.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1ENFADEL ;WASHINGTON IRMFO/KLD/DH/SAB; Equipment Disposition ;10/23/97
2 ;;7.0;ENGINEERING;**29,33,38,39,46**;Aug 17, 1993
3 ;This routine should not be modified.
4ST D GETEQ^ENUTL G K:Y'>0
5 S (DA,ENEQ("DA"))=+Y
6 L +^ENG(6914,DA):5 I '$T W !!,$C(7),"Another user is editing this Equipment Record. Please try again later." G K
7 I '$D(^ENG(6915.2,"B",DA)) D G K
8 . W $C(7),!,"There is no FA document on file for this asset. No action taken."
9 I $D(^ENG(6915.5,"B",DA)) S X=$$CHKFA^ENFAUTL(DA) I +X=0 D G K
10 . S Y=$P(X,U,3) D DD^%DT
11 . W $C(7),!,"An FD document for ENTRY #",DA," was processed on ",Y,"."
12 . W !,"No action taken."
13 F I=2,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
14 S DIC="^ENG(6915.5,",DIC(0)="L",DLAYGO=6915.5
15 S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
16 K DD,DO D FILE^DICN K DLAYGO
17 S ENFD("DA")=+Y
18 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
19 ; ask type of FD
20 S DIE="^ENG(6915.5,",DA=ENFD("DA"),DR="100"
21 D ^DIE I $D(Y)!$D(DTOUT) D G EXIT
22 . W !!,$C(7),"The type of FD Document is required. No action taken."
23 . S DIK=DIE D ^DIK K DIK
24 S ENFD("TYPE")=$P($G(^ENG(6915.5,ENFD("DA"),100)),U)
25 I ENFD("TYPE")="T",$$GET1^DIQ(6914,ENEQ("DA"),38)="1524" D I 'Y W !!,"No action taken." S DIK=DIE D ^DIK K DIK G EXIT
26 . W !,"This equipment item is already on SGL 1524 (Excess)."
27 . S DIR(0)="Y",DIR("A")="Are you sure you want to process a Turn-In"
28 . S DIR("B")="NO" D ^DIR K DIR
29DIE ;Enter data for FD DOC
30 S DIE="^ENG(6915.5,",DIE("NO^")="BACKOUTOK"
31 S DA=ENFD("DA"),DR="[ENFA DELETE-"_ENFD("TYPE")_"]"
32 W ! D ^DIE I $D(Y)!($D(DTOUT)) D G EXIT
33 . W !!,$C(7),"This FD document is incomplete and is being deleted..."
34 . S DIK=DIE D ^DIK K DIK
35 I ENFD("TYPE")="T" D I $D(Y)!($D(DTOUT)) G EXIT
36 . ; ask fair market value at turn-in
37 . W !!,"When equipment is turned-in, its TOTAL ASSET VALUE must be"
38 . W !,"changed to the fair market value per VA Accounting Standards."
39 . W !,"NOTE: The current TOTAL ASSET VALUE will automatically be saved"
40 . W !,"in the ORIGINAL ASSET VALUE field."
41 . ; compute repair costs (exclude PM)
42 . S (ENT,ENT("L"),ENT("M"),ENT("V"))=0
43 . S ENI=0 F S ENI=$O(^ENG(6914,ENEQ("DA"),6,ENI)) Q:'ENI D
44 . . S ENY=$G(^ENG(6914,ENEQ("DA"),6,ENI,0))
45 . . Q:$E($P(ENY,U,2),1,3)="PM-" ; exclude PM
46 . . S ENT("L")=ENT("L")+$P(ENY,U,5)
47 . . S ENT("M")=ENT("M")+$P(ENY,U,6)
48 . . S ENT("V")=ENT("V")+$P(ENY,U,7)
49 . S ENT=ENT("L")+ENT("M")+ENT("V")
50 . ; display info to assist determination of fair market value
51 . W !!,"Current TOTAL ASSET VALUE: ",$FN($P(ENEQ(2),U,3),",",2)
52 . W !,"Acquisition Date: ",$$FMTE^XLFDT($P(ENEQ(2),U,4))," Life Expectancy: ",$P(ENEQ(2),U,6)
53 . W !,"Replacement Date: ",$$FMTE^XLFDT($P(ENEQ(2),U,10))
54 . W " Condition: ",$$GET1^DIQ(6914,ENEQ("DA"),53)
55 . W !,"Repair Costs (excluding preventive maintenance)"
56 . W !," Labor$ :",$FN(ENT("L"),",",0)," Material$: ",$FN(ENT("M"),",",0)," Vendor$: ",$FN(ENT("V"),",",0)," Total$: ",$FN(ENT,",",0),!
57 . K ENT
58 . S DIE="^ENG(6915.5,",DA=ENFD("DA"),DR="104R"
59 . D ^DIE I $D(Y)!($D(DTOUT)) D
60 . . W !!,$C(7),"Fair Market Value unspecified. This FD document is being deleted..."
61 . . S DIK=DIE D ^DIK K DIK
62 S ENFAP("DOC")="FD"
63 S ENFAP(0)=$G(^ENG(6915.5,DA,0)),ENFAP(5)=$G(^(5)),ENFAP(100)=$G(^(100))
64 I $P(ENFAP(5),U,8)="" S $P(ENFAP(5),U,8)="0.00"
65 I $P(ENFAP(100),U,4)="" S $P(ENFAP(100),U,4)=7
66 S $P(^ENG(6915.5,ENFD("DA"),100),U,2)=$$GET1^DIQ(6914,ENEQ("DA"),12)
67 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)
68 S X=$P(ENFAP(100),U,4) S:X $P(ENFAP(5),U,4)=$$GET1^DIQ(6914.8,X,.01)
69 S ^ENG(6915.5,ENFD("DA"),5)=ENFAP(5)
70 K ^TMP($J) D ^ENFAVAL
71 I $D(^TMP($J)) D LISTP^ENFAXMTM D G DIE:"Yy"[X,EXIT
72 .R !!,"Re-edit this disposition? Y// ",X:DTIME S:'$T X=U Q:"Yy"[X
73 .W !,"Sorry, I must then delete this FD document!"
74 .S DIK=DIE,DA=ENFD("DA") D ^DIK W " ...deleted" S X=U
75 S ENAV=$$AVP^ENFAAV("6915.5",ENFD("DA"))
76 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
77 S DIR(0)="Y",DIR("A")="Sure you want to process this disposition",DIR("B")="YES"
78 D ^DIR I 'Y!($D(DIRUT)) S DIK=DIE D ^DIK W "...data base unchanged." K DIR G EXIT
79EQ ; update
80 ;update FAP Balance
81 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))
82 W !!,"Updating the Equipment File..."
83 S DA=ENEQ("DA"),DIE="^ENG(6914," K DIC
84 S DR="31////"_$P(ENFAP(100),U,4)_";32////"_$P(ENFAP(5),U,8) D ^DIE
85 S DR="20////4;19////@;38////@" D ^DIE
86 I ENFD("TYPE")="T" D
87 . I $P(^ENG(6914,DA,3),U,15)'>0 S $P(^(3),U,15)=$P(ENEQ(2),U,3) ; orig.$
88 . S DR="20.5////"_$P(ENFAP(100),U,3)
89 . S DR=DR_";12////"_$$DEC^ENFAUTL($P(ENFAP(100),U,5))
90 . D ^DIE
91 I ENFD("TYPE")="D" S DR="22////"_$P(ENFAP(100),U,3) D ^DIE
92 W !!,"Sending FD document to FAP." D ^ENFAXMT
93 I $G(ENAV) D
94 . S DIE="^ENG(6915.5,",DR="301///NOW",DA=ENFD("DA") D ^DIE
95 . W !,"Adjustment Voucher was created.",!
96 I ENFD("TYPE")="T" D
97 . W !!,"Editing Equipment Data"
98 . S DA=ENEQ("DA"),DIE="^ENG(6914,"
99 . S DR="20;19//996;38//1524"
100 . D ^DIE Q:$D(DTOUT)
101 . Q:$$GET1^DIQ(6914,ENEQ("DA"),38)'=1524
102 . S DIR(0)="Y",DIR("A")="Should a FA Document also be sent"
103 . S DIR("?",1)="The FD Document removed the asset from Fixed Assets."
104 . S DIR("?",2)="Since the asset was placed in the Excess (1524) account"
105 . S DIR("?",3)="a FA Document should be sent adding it to Fixed Assets"
106 . S DIR("?",4)="as excess equipment."
107 . S DIR("?")="Enter YES to send a FA Document"
108 . W ! D ^DIR K DIR Q:$D(DIRUT)!'Y
109 . D ^ENFAACQ
110EXIT L -^ENG(6915.5,ENFD("DA")),-^ENG(6914,ENEQ("DA"))
111 ;
112K K DA,DIC,DIE,DR,ENAV,ENEQ,ENFA,ENFAP,ENFD,I,X,Y Q
113 ;
114 ;ENFADEL
Note: See TracBrowser for help on using the repository browser.