81 lines
4.3 KiB
Mathematica
81 lines
4.3 KiB
Mathematica
PRCEADJ1 ;WISC/CLH/LDB/SJG-FISCAL 1358 ADJUSTMENTS ; 04/21/93 4:20 PM
|
|
V ;;5.1;IFCAP;**23**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
; Adjustment processing FISCAL
|
|
N PRC410,PRC442,DA,I,PO,PRC,PRCB,PRCF,PRCFA,DIC,TRNODE,X,Y,FSO,PX,TRDA,X1,PODA,NOGO
|
|
V1 D OUT S PRCF("X")="AB" D ^PRCFSITE Q:'%
|
|
D LU^PRCS58OB(.Y,.PRC,.PRCF) G:Y<0 OUT
|
|
S PRCFA("RETRAN")=0
|
|
RETRAN ; Entry point for rebuild/transmit
|
|
W !,"...retrieving 1358 information...",! D WAIT^DICD
|
|
S (DA,TRDA)=+Y
|
|
D NODE^PRCS58OB(DA,.TRNODE)
|
|
S (X,X1)=$P(TRNODE(4),U,5) D VER^PRCH58OB(.PRC,.X)
|
|
I X="" W !!,"Unable to Process due to lack of Obligation Number." G OUT
|
|
S PODA=X,PRC410=TRDA,PRC442=X,NOGO="" D OB1^PRCS58OB(TRDA,X)
|
|
D PO^PRCH58OB(PODA,.PO) S PO=PODA
|
|
D HILO^PRCFQ
|
|
FMSCHK ;
|
|
; Patch 23, disable obligation process for SO with "Q" & "T" status
|
|
I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 D FMSTAT I $D(SOSTAT),("^Q^T^R^E^")[$E(SOSTAT,1),SOSTAT'="CALM" D G V1
|
|
.W !! K MSG S MSG(1)=" One of the previous documents has not been accepted in FMS."
|
|
.S MSG(2)=" The adjustment to this 1358 cannot be obligated at this time."
|
|
.S MSG(3)=" In order for the obligation of this adjustment to proceed, the"
|
|
.S MSG(4)=" previous document cannot have a status of 'REJECTED', 'ERROR"
|
|
.S MSG(5)=" IN TRANSMISSION', 'QUEUED FOR TRANSMISSION', or 'TRANSMITTED'.",MSG(6)=" "
|
|
.S MSG(7)=" FMS Document: "_SODOC,MSG(8)=" Status: "_SOSTAT,MSG(9)=" "
|
|
.S MSG(10)=" No further action is being taken on this obligation."
|
|
.D EN^DDIOL(.MSG) K MSG W !
|
|
.Q
|
|
SC W:$D(IOF) @IOF W "PROCESS 1358 ADJUSTMENT",?40,"Obligation #: ",IOINHI,$P(PO(0),"^")
|
|
W !!,IOINLOW," Service Balance: $ ",IOINHI,$FN(+PO(8)-$P(PO(8),"^",3),"P,",2)
|
|
W !,IOINLOW," Fiscal Balance: $ ",IOINHI,$FN(+PO(8)-$P(PO(8),"^",2),"P,",2)
|
|
W !,IOINLOW,"Amount of Adjustment: $ ",IOINHI,$FN($P(TRNODE(4),"^",8),",P",2)
|
|
W !!,IOINLOW,?20,"ORIGINAL",?45,"ADJUSTMENT"
|
|
W !!,IOINLOW," COST CENTER: ",?21,IOINHI,+$P(PO(0),"^",5),?48,+$P(TRNODE(3),"^",3) I +$P(PO(0),"^",5)'=+$P(TRNODE(3),"^",3) S NOGO=NOGO_3 W $C(7),?60,"*****"
|
|
W !!,IOINLOW,?10,"BOC #1:",?22,IOINHI,$P($P(PO(0),"^",6)," "),?49,$P($P(TRNODE(3),"^",6)," ") I +$P(PO(0),"^",6)'=+$P(TRNODE(3),"^",6) W $C(7),?60,"*****" S NOGO=NOGO_2
|
|
I +$P(PO(0),"^",8)>0!(+$P(TRNODE(3),"^",8)>0) W !,IOINLOW,?10,"BOC #2:",?22,IOINHI,$P($P(PO(0),"^",8)," "),?49,$P($P(TRNODE(3),"^",8)," ") I +$P(PO(0),"^",8)'=+$P(TRNODE(3),"^",8) W $C(7),?60,"*****" S NOGO=NOGO_2
|
|
W IOINORM
|
|
I NOGO[2 D SUB G OUT ;G:'Y V D SAEDIT^PRCS58OB(.PO,TRDA) S I=4
|
|
I NOGO[3 D CC G OUT
|
|
CHECK ; Check adjustment amount with obligation/liquidation/authorization amounts
|
|
I PRC442,+$G(PRCFA("RETRAN"))=0,$$EN1^PRCE0A(PRC410,PRC442,1) W !,$C(7),"Send 1358 adjustment back to service.",! G OUT
|
|
S PRCFA("MOD")="M^1^Modification Entry"
|
|
W ! D VENCONM^PRCFFU15(+PO)
|
|
D EN^PRCFFU14(TRDA) I ACCEDIT G SC
|
|
D AUTACC^PRCFFU6 S PRCFA("ACCEDIT")=1
|
|
N Y S PRCFA("IDES")="1358 Obligation Adjustment" W ! D OKAY^PRCFFU
|
|
; Patch 23, fix Y undef error
|
|
;I Y K DIR,Y D ^PRCESOM I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 G V1
|
|
I Y K DIR,Y D ^PRCESOM G:'$G(PRCFA("RETRAN")) V1 S Y=0 ; patch 23
|
|
I 'Y!($D(DIRUT)) W ! D EN^DDIOL("No further processing is being taken on this adjustment.")
|
|
OUT K DTOUT,DIR,DUOUT,DIRUT,DIROUT
|
|
OUT1 K DA,D0,ACCEDIT,BBFY,BEGDATE,CONT,CONTEND,CONTIEN,ENDDATE,ESIGMSG,EXIT
|
|
K FMSMOD,FMSVENID,GECSFMS,I,NEWACC,NEWDATE,NOGO
|
|
K NUMB,OB,PARAM1,PO,PODA,PODATE,POIEN,PRC410,PRC442,PRCCC,PRCCCC,PRCCSCC
|
|
K PRCCP,PRCFA,PRCFMO,PRCREQST,PRCSTA,PRCSTR,PRCTMP,SODOC,SOSTAT
|
|
K STR2,TMP410,TMP442,TRDA,TRNODE,VENCONT,X,X1
|
|
Q
|
|
FMSTAT ; Check status of prior FMS Documments
|
|
D FMSTAT^PRCEADJ(+PO,.SODOC,.SOSTAT)
|
|
Q
|
|
SUB ; Check BOCs (subaccounts)
|
|
K MSG W !!
|
|
S MSG(1)=" BOCs on the adjustment are not the same as on the original obligation."
|
|
S MSG(2)=" Processing cannot continue - please return to the Service for correction.",MSG(3)=" "
|
|
S MSG(4)=" No further processing is being taken on this adjustment."
|
|
D MSG(.MSG)
|
|
Q
|
|
CC ; Check Cost Centers
|
|
K MSG W !!
|
|
S MSG(1)=" Cost Center on the adjustment is not the same as on the original"
|
|
S MSG(2)=" obligation. Processing cannot continue - please return to the"
|
|
S MSG(3)=" Service for correction.",MSG(4)=" "
|
|
S MSG(5)=" No further processing is being taken on this adjustment."
|
|
D MSG(.MSG)
|
|
Q
|
|
MSG(X) ; Display message
|
|
Q:'$D(MSG)
|
|
D EN^DDIOL(.MSG),ENCON^PRCFQ
|
|
Q
|