source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAXFR.m@ 1042

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1ENFAXFR ;WCIOFO/KLD,SAB; EQUIPMENT TRANSFERS ;11/29/2000
2 ;;7.0;ENGINEERING;**29,33,39,57,60,66**;Aug 17, 1993
3 ;This routine should not be modified.
4ST ;
5 D SETUP
6 D:ENDO ASKEQ
7 D:ENDO ADDFR
8EDIT D:ENDO ASKDATA
9 D:ENDO CVTDATA
10 D:ENDO VALFR I $D(ENREEDIT) K ENREEDIT G EDIT
11 K ENAV I ENDO D I $G(ENUT) S ENDO=0 K ENUT
12 . S ENAV=$$AVP^ENFAAV("6915.6",ENFR("DA"))
13 . I 'ENAV W !,"Adjustment voucher was NOT created."
14 D:ENDO ASKOK
15 D:'ENDO DEL
16 D:ENDO UPDATE
17 D:ENDO PSEQED
18 D WRAPUP
19 Q
20SETUP ;
21 S ENDO=1
22 S (ENEQ("DA"),ENFA("DA"),ENFR("DA"))=""
23 Q
24ASKEQ ; ask for equipment item
25 D GETEQ^ENUTL I Y'>0 S ENDO=0 Q
26 L +^ENG(6914,+Y):5 I '$T D S ENDO=0 Q
27 . W !!,"Someone else is editing this Equipment Record."
28 . W !,"Please try again later."
29 S ENEQ("DA")=+Y
30 I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D S ENDO=0 Q
31 . W !!,"There is no FA document on file for this asset."
32 . W !,"Nothing to change."
33 S X=$$CHKFA^ENFAUTL(ENEQ("DA")) I +X=0 D S ENDO=0 Q
34 . S Y=$P(X,U,3) D DD^%DT
35 . W !!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
36 . W !,"No action taken."
37 S ENFA("DA")=$P(X,U,4)
38 F I=1,2,3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
39 Q
40ADDFR ; create entry for FR code sheet
41 S DIC="^ENG(6915.6,",DIC(0)="L",DLAYGO=6915.6
42 S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
43 K DD,DO D FILE^DICN K DIC,DLAYGO
44 I Y'>0 D S ENDO=0 Q
45 . I $D(ENBAT("SILENT")) D BAD("Can't add to FR DOCUMENT LOG") Q
46 . W !!,"Can't update FR document log. Better contact IRM."
47 S ENFR("DA")=+Y
48 L +^ENG(6915.6,+Y):0 I '$T D S ENDO=0 Q
49 . I $D(ENBAT("SILENT")) D BAD("Can't lock FR Document") Q
50 . W !!,"The FR document that you just created is being edited"
51 . W !,"by someone else. Please notify IRM."
52 ; populate non-editable fields from FA
53 S X=$G(^ENG(6915.2,ENFA("DA"),3))
54 S $P(^ENG(6915.6,ENFR("DA"),3),U,11)=$P(X,U,12) ; owning station
55 S $P(^ENG(6915.6,ENFR("DA"),3),U,17)=$P(X,U,30) ; satellite station
56 K X
57 ; save current asset value on FR
58 S $P(^ENG(6915.6,ENFR("DA"),100),U,8)=$$GET1^DIQ(6914,ENEQ("DA"),12)
59 Q
60ASKDATA ;ask data for FR document
61 S DIE="^ENG(6915.6,",DA=ENFR("DA"),DR="[ENFA XFR]"
62 S DIE("NO^")="BACKOUTOK"
63 W ! D ^DIE K DIE("NO^")
64 I $D(DTOUT) W !!,"Timeout" S ENDO=0 Q
65 Q
66CVTDATA ; convert user-entered pseudo field data into exported data
67 S ENFAP(100)=$G(^ENG(6915.6,ENFR("DA"),100))
68 ;
69 ; populate required fields (send even when not changed)
70 K DR S DR=""
71 I $P(ENFAP(100),U,2)]"" D
72 . S DR=";28///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),101)"
73 I $P(ENFAP(100),U,3)]"" D
74 . S DR=DR_";29///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),102)"
75 S:$E(DR)=";" DR=$E(DR,2,200)
76 I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
77 ;
78 S ENFAP("BUDFY")="" ; default budget fiscal year
79 S X=$P(ENFAP(100),U,2) I X]"" D
80 . I $$GET1^DIQ(6914.6,X,.01)="4539" S ENFAP("BUDFY")=2000 Q ; EN*7*66
81 . I $$GET1^DIQ(6914.6,X,2,"I") S ENFAP("BUDFY")=1994 Q ; rev. funds
82 . I $E($$GET1^DIQ(6914.6,X,.01),1,4)="AMAF" S ENFAP("BUDFY")=1995 Q
83 . S ENFAP("BUDFY")=$E(DT,1,3)+1700+$E(DT,4)
84 . ;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
85 S $P(^ENG(6915.6,ENFR("DA"),3),U,8)=$E(ENFAP("BUDFY"),3,4)
86 ;
87 S ENACC="000000000" ; default xprogram
88 ;I $P(ENFAP(100),U,4)]"" D ;Get ACC - don't send per Bob Landrum
89 ;. N ENDOCFY,ENY
90 ;. S X="PRC0C" X ^%ZOSF("TEST") D:$T
91 ;. . S ENFAP("STATION")=$P(^ENG(6915.2,ENFA("DA"),3),U,12)
92 ;. . S ENY=$G(^ENG(6915.2,ENFA("DA"),3))
93 ;. . S ENDOCFY=$E($P(ENY,U,16)+$E($P(ENY,U,17)),3,4)
94 ;. . S X=$$ACC^PRC0C(ENFAP("STATION"),$P(ENFAP(100),U,4)_U_ENDOCFY_U_ENFAP("BUDFY"))
95 ;. . I $P(X,U,3)?9AN S ENACC=$P(X,U,3)
96 S $P(^ENG(6915.6,ENFR("DA"),3),U,12)=ENACC
97 K ENACC
98 ;
99 ; populate optional fields (recompute cost center when CMR specified)
100 K DR S DR=""
101 I $P(ENFAP(100),U,5)]"" S DR=";32///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),104)"
102 I $P(ENFAP(100),U,6)]"" D
103 . S ENFAP("CMR")=$E($$GET1^DIQ(6915.6,ENFR("DA"),105),1,5)
104 . S DR=DR_";37///^S X=ENFAP(""CMR"")"
105 . S DR=DR_";33///^S X=$$LOC^ENFAVAL(ENFAP(""CMR""))"
106 . S ENFAP("CC")=$$GET1^DIQ(6914.1,$P(ENFAP(100),U,6),10)
107 . I ENFAP("CC")]"" S DR=DR_";34///^S X=ENFAP(""CC"")"
108 S:$E(DR)=";" DR=$E(DR,2,200)
109 I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
110 K DR
111 ;
112 F I=0,3,100 S ENFAP(I)=^ENG(6915.6,ENFR("DA"),I)
113 Q
114VALFR ; validate FR document
115 K ENREEDIT
116 S ENFAP("DOC")="FR" K ^TMP($J) D ^ENFAVAL
117 I $D(^TMP($J)) D LISTP^ENFAXMTM D
118 . S DIR(0)="Y",DIR("A")="Re-edit this transaction",DIR("B")="YES"
119 . D ^DIR K DIR
120 . I 'Y W !!,"Sorry, I must then delete this FR document!" S ENDO=0 Q
121 . S ENREEDIT=1
122 . ; initialize derived values
123 . S $P(ENFAP(3),U,7,10)="^^^",$P(ENFAP(3),U,12,15)="^^^"
124 . S $P(ENFAP(3),U,18)=""
125 . S ^ENG(6915.6,ENFR("DA"),3)=ENFAP(3)
126 Q
127ASKOK ;
128 S DIR(0)="Y",DIR("A")="Sure you want to process these changes"
129 S DIR("B")="YES" D ^DIR K DIR I 'Y!($D(DIRUT)) S ENDO=0
130 Q
131 ;
132DEL ;
133 I $G(ENFR("DA"))]"" D
134 . S DA=ENFR("DA"),DIK="^ENG(6915.6," D ^DIK K DIK
135 . W !,"FR Document deleted."
136 W $C(7),!,"No action taken. Database unchanged."
137 Q
138UPDATE ; update
139 ;update FAP Balance if fund changed
140 I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) D
141 . 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)) ; remove from old
142 . D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENFAP(100),U,2),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),$P(ENEQ(2),U,3)) ; add to new
143 W:'$D(ENBAT("SILENT")) !!,"Updating the AEMS/MERS Equipment File."
144 S ENEQ("XCMR")="" ; initialize CMR changed flag
145 S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
146 I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) S DR=DR_";62////^S X=$P(ENFAP(100),U,2)"
147 I $P(ENFAP(100),U,3)]"",$P(ENFAP(100),U,3)'=$P(ENEQ(9),U,8) S DR=DR_";63////^S X=$P(ENFAP(100),U,3)"
148 I $P(ENFAP(100),U,4)]"",$P(ENFAP(100),U,4)'=$P(ENEQ(8),U,3) S DR=DR_";35////^S X=$P(ENFAP(100),U,4)"
149 I $P(ENFAP(100),U,5)]"",$P(ENFAP(100),U,5)'=$P(ENEQ(9),U,6) S DR=DR_";61////^S X=$P(ENFAP(100),U,5)"
150 I $P(ENFAP(100),U,6)]"",$P(ENFAP(100),U,6)'=$P(ENEQ(2),U,9) S DR=DR_";19////^S X=$P(ENFAP(100),U,6)",ENEQ("XCMR")=1
151 I $E(DR)=";" S DR=$E(DR,2,200)
152 D ^DIE
153 ; transmit document
154 W:'$D(ENBAT("SILENT")) !!,"Sending FR document to FAP."
155 D ^ENFAXMT
156 ; save adjustment voucher
157 I $G(ENAV) D
158 . S DIE="^ENG(6915.6,",DR="301///NOW",DA=ENFR("DA") D ^DIE
159 . W !,"Adjustment Voucher was created.",!
160 Q
161 ;
162PSEQED ; Post FR Equipment Edit (selected fields)
163 N ENX
164 S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
165 ; edit Service when CMR changes and new CMR's service is different
166 I $G(ENEQ("XCMR"))]"" D
167 . S ENX=$$GET1^DIQ(6914,ENEQ("DA"),"19:.5") ; get CMR's service
168 . Q:ENX="" ; CMR's service not specified
169 . Q:ENX=$$GET1^DIQ(6914,ENEQ("DA"),21) ; already equals using svc
170 . ; include in user edit
171 . S DR=";21USING SERVICE"
172 . W !!,"This FR Document changed the equipment's CMR value."
173 . W !,"The service accountable for the new CMR is ",ENX,"."
174 . W !,"You can update the equipment's Using Service if appropriate."
175 . W !,"Just press <ENTER> to leave it unchanged."
176 S:$E(DR)=";" DR=$E(DR,2,999)
177 I DR]"" W !!,"Editing Equipment ENTRY # ",DA D ^DIE
178 Q
179 ;
180WRAPUP ;
181 I $G(ENEQ("DA"))]"" L -^ENG(6914,ENEQ("DA"))
182 I $G(ENFR("DA"))]"" L -^ENG(6915.6,ENFR("DA"))
183 K DA,DIC,DIE,DR,DIR,I,X,Y
184 K ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFR
185 Q
186 ;
187BAD(X) ; add text to validation problem list
188 N I
189 S I=$P($G(^TMP($J,"BAD",ENEQ("DA"))),U)+1
190 S ^TMP($J,"BAD",ENEQ("DA"),I)=X
191 S ^TMP($J,"BAD",ENEQ("DA"))=I
192 Q
193 ;ENFAXFR
Note: See TracBrowser for help on using the repository browser.