| 1 | ENFAAV ;IRMFO/SAB-ADJUSTMENT VOUCHER ENTRY ;6.30.97
|
---|
| 2 | ;;7.0;ENGINEERING;**39**;AUG 17, 1993
|
---|
| 3 | EN ; 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)
|
---|
| 8 | ASKDOC ; 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
|
---|
| 23 | SHOWDOC ; 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
|
---|
| 66 | CHECKAV ;
|
---|
| 67 | I $$GET1^DIQ(ENFILE,ENDA("F?"),301)]"" D G ASKDOC
|
---|
| 68 | . W $C(7),!,"This FAP Document already has an Adjustment Voucher!",!
|
---|
| 69 | EDITAV ;
|
---|
| 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
|
---|
| 77 | EXIT ;
|
---|
| 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 | ;
|
---|
| 83 | AVP(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 | ;
|
---|
| 111 | AVPED 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 | ;
|
---|
| 121 | AVPX ; exit
|
---|
| 122 | Q ENAV
|
---|
| 123 | ;
|
---|
| 124 | AVC(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
|
---|