source: FOIAVistA/tag/r/ENGINEERING-EN/ENFAAV.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1ENFAAV ;IRMFO/SAB-ADJUSTMENT VOUCHER ENTRY ;6.30.97
2 ;;7.0;ENGINEERING;**39**;AUG 17, 1993
3EN ; Entry point for option
4 ; load table for converting FA Type to SGL
5 K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
6 . S ENY0=$G(^ENG(6914.3,ENDA,0))
7 . I $P(ENY0,U,3)]"" S ENFAPTY($P(ENY0,U,3))=$P(ENY0,U)
8ASKDOC ; ask FAP Document
9 W !
10 S DIR(0)="SBO^FA:FA DOCs;FB:FB DOCs;FC:FC DOCs;FD:FD DOCs;FR:FR DOCs"
11 S DIR("A")="Select Type of FAP Document"
12 S DIR("?",1)="Choose the type of FAP Document for which an Adjustment"
13 S DIR("?",2)="Voucher should be created. After the type is chosen, you"
14 S DIR("?",3)="will be asked to select the specific FAP Document."
15 S DIR("?")=" "
16 D ^DIR K DIR G:Y']""!$D(DIRUT) EXIT
17 S ENFILE="6915."_$F("ABCDR",$E(Y,2,2))
18 ;
19 S DIC="^ENG("_ENFILE_",",DIC(0)="AQEM"
20 S DIC("A")="Select "_Y_" DOCUMENT (by Transaction Number or Equipment ENTRY #): "
21 D ^DIC G:Y'>0 EXIT
22 S ENDA("F?")=+Y
23SHOWDOC ; show info for FAP Document/Adjustment Voucher
24 S ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),301,"I")
25 S ENY0=$G(^ENG(ENFILE,ENDA("F?"),0))
26 S ENY1=$G(^ENG(ENFILE,ENDA("F?"),1))
27 S ENDA=$P($G(^ENG(ENFILE,ENDA("F?"),0)),U)
28 S ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?")) ; associated FA
29 S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
30 S ENSN=$TR($E($P(ENFAY3,U,5),1,5)," ","")
31 S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
32 S:ENFILE'=6915.2 ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
33 S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
34 S ENAMT=0
35 I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
36 I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
37 I ENFILE=6915.4 S ENX=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,6),ENAMT=$S(ENX="":0,1:ENX-$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,4))
38 I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
39 I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
40 W @IOF,!,"ADJ. VOUCHER",?16,"TRANSACTION .............",?43,"STN"
41 W ?50,"FUND",?58,"SGL",?63,"NET AMOUNT"
42 W !,"DATE/TIME",?16,"CODE NUMBER DATE"
43 W !,"--------------",?16,"---- ----------- --------",?43,"-----"
44 W ?50,"------",?58,"----",?63,"----------------"
45 W !,$E($TR($$FMTE^XLFDT(ENDT,"2F")," ",0),1,14)
46 W ?16,$P(ENY1,U,6),?21,$P(ENY1,U,9)
47 W ?33,$TR($$FMTE^XLFDT($P(ENY0,U,2),"2DF")," ",0)
48 W ?43,ENSN,?50,ENFUND,?58,ENSGL
49 I ENFILE=6915.6 D ; check FR doc for FUND change
50 . S ENFUNDNW=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,9)
51 . I ENFUND=ENFUNDNW S ENAMT=0 Q ; fund didn't change
52 . S ENAMT=-ENAMT ; subtract from old fund
53 W ?63,$J($FN(ENAMT,",",2),16)
54 I ENFILE=6915.6,ENFUND'=ENFUNDNW D
55 . ; show addition to new fund
56 . W !,?43,ENSN,?50,ENFUNDNW,?58,ENSGL
57 . W ?63,$J($FN(-ENAMT,",",2),16)
58 W !,?5,"EQUIP #: ",ENDA,?26,$$GET1^DIQ(6914,ENDA,3)
59 S ENX=$$GET1^DIQ(ENFILE,ENDA("F?"),303)
60 I ENX]"" W !,?5,"REASON: ",ENX
61 I $O(^ENG(ENFILE,ENDA("F?"),301,0)) D G:$D(DIRUT) EXIT
62 . K ^UTILITY($J,"W") S DIWL=6,DIWR=(IOM-5),DIWF="W|"
63 . S X="COMMENTS: ",ENI=0
64 . F S ENI=$O(^ENG(ENFILE,ENDA("F?"),301,ENI)) Q:'ENI S X=X_^(ENI,0) D ^DIWP S X="" I $Y+4>IOSL S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)!'Y W @IOF
65 . D ^DIWW
66CHECKAV ;
67 I $$GET1^DIQ(ENFILE,ENDA("F?"),301)]"" D G ASKDOC
68 . W $C(7),!,"This FAP Document already has an Adjustment Voucher!",!
69EDITAV ;
70 W !
71 S ENAV=$$AVP(ENFILE,ENDA("F?"))
72 I 'ENAV W !,"Adjustment voucher was NOT created." I $G(ENUT) G EXIT
73 I ENAV D
74 . S DIE="^ENG("_ENFILE_",",DR="301///NOW",DA=ENDA("F?") D ^DIE
75 . W !,"Adjustment Voucher was created.",!
76 G ASKDOC
77EXIT ;
78 K DA,DIC,DIE,DIR,DIRUT,DIROUT,DR,DTOUT,DUOUT,X,Y
79 K ENAMT,ENAV,ENDA,ENDT,ENFAPTY,ENFAY3,ENFILE,ENFUND,ENFUNDNW
80 K ENSGL,ENSN,ENUT,ENY0,ENY1
81 Q
82 ;
83AVP(ENF,ENDA) ; adjustment voucher preparation
84 ; This program gathers all the information required for an adjustment
85 ; voucher. The calling program must evaluate the return value and
86 ; actually create the adjustment voucher at the appropriate time
87 ; by storing NOW in the appropriate A.V. DATE field.
88 ;
89 ; Called by this routine for existing FAP Documents or by routines
90 ; ENFAACQ, ENFABETR, ENFACHG, ENFADEL, ENFAXF during creation of
91 ; new FAP Documents
92 ;
93 ; in
94 ; ENF - # of file (e.g. 6915.2 for FA DOCUMENT LOG)
95 ; ENDA - ien of entry in ENF to create adjustment voucher for
96 ; out
97 ; $D(ENUT) true if time-out or uparrow '^' during call
98 ; returns 0 (cancelled) or 1 (fully prepared)
99 ;
100 N DA,DIE,DIR,DR,ENAV,X,Y
101 K ENUT S ENAV=0
102 ;
103 S DIR(0)="Y"
104 S DIR("A")="Should an Adjustment Voucher be created",DIR("B")="YES"
105 S DIR("?",1)="Adjustment Vouchers are used to inform Fiscal personnel"
106 S DIR("?",2)="of FAP transactions that Fiscal must take action on."
107 S DIR("?",3)=" "
108 S DIR("?")="Enter YES or NO"
109 D ^DIR K DIR S:$D(DIRUT) ENUT=1 G:'Y!$D(DIRUT) AVPX
110 ;
111AVPED S DIE="^ENG("_ENF_",",DR="303R;310R",DA=ENDA D ^DIE
112 S DIR(0)="Y",DIR("A")="Is adjustment voucher correct"
113 D ^DIR K DIR I $D(DIRUT) S ENUT=1 G AVPX
114 I 'Y D G:Y AVPED S Y=$$AVC(ENF,ENDA) G AVPX
115 . S DIR(0)="Y",DIR("A")="Do you want to re-edit it"
116 . D ^DIR K DIR I $D(DIRUT) S ENUT=1
117 I $P($G(^ENG(ENF,ENDA,300)),U,3)=""!'$O(^ENG(ENF,ENDA,301,0)) D G AVPED
118 . W $C(7),!,"Both Reason Code and Comments are required!"
119 S ENAV=1
120 ;
121AVPX ; exit
122 Q ENAV
123 ;
124AVC(ENF,ENDA) ; Adjustment Voucher Clean Up
125 ; This code is used to clean up an aborted adjustment voucher.
126 ; in
127 ; ENF - file number (e.g. 6915.2)
128 ; ENDA - ien
129 ; returns 1 (done) or 0 (can't because a.v. completed)
130 ;
131 I ENF'?1"6915."1N Q 0
132 I $$GET1^DIQ(ENF,ENDA,301)]"" Q 0
133 S DIE="^ENG("_ENF_",",DR="303///@;310///@",DA=ENDA D ^DIE Q 1
134 ;
135 ;ENFAAV
Note: See TracBrowser for help on using the repository browser.