| 1 | PRCEADJ1 ;WISC/CLH/LDB/SJG-FISCAL 1358 ADJUSTMENTS ; 04/21/93 4:20 PM
|
|---|
| 2 | V ;;5.1;IFCAP;**23**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; Adjustment processing FISCAL
|
|---|
| 5 | N PRC410,PRC442,DA,I,PO,PRC,PRCB,PRCF,PRCFA,DIC,TRNODE,X,Y,FSO,PX,TRDA,X1,PODA,NOGO
|
|---|
| 6 | V1 D OUT S PRCF("X")="AB" D ^PRCFSITE Q:'%
|
|---|
| 7 | D LU^PRCS58OB(.Y,.PRC,.PRCF) G:Y<0 OUT
|
|---|
| 8 | S PRCFA("RETRAN")=0
|
|---|
| 9 | RETRAN ; Entry point for rebuild/transmit
|
|---|
| 10 | W !,"...retrieving 1358 information...",! D WAIT^DICD
|
|---|
| 11 | S (DA,TRDA)=+Y
|
|---|
| 12 | D NODE^PRCS58OB(DA,.TRNODE)
|
|---|
| 13 | S (X,X1)=$P(TRNODE(4),U,5) D VER^PRCH58OB(.PRC,.X)
|
|---|
| 14 | I X="" W !!,"Unable to Process due to lack of Obligation Number." G OUT
|
|---|
| 15 | S PODA=X,PRC410=TRDA,PRC442=X,NOGO="" D OB1^PRCS58OB(TRDA,X)
|
|---|
| 16 | D PO^PRCH58OB(PODA,.PO) S PO=PODA
|
|---|
| 17 | D HILO^PRCFQ
|
|---|
| 18 | FMSCHK ;
|
|---|
| 19 | ; Patch 23, disable obligation process for SO with "Q" & "T" status
|
|---|
| 20 | I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 D FMSTAT I $D(SOSTAT),("^Q^T^R^E^")[$E(SOSTAT,1),SOSTAT'="CALM" D G V1
|
|---|
| 21 | .W !! K MSG S MSG(1)=" One of the previous documents has not been accepted in FMS."
|
|---|
| 22 | .S MSG(2)=" The adjustment to this 1358 cannot be obligated at this time."
|
|---|
| 23 | .S MSG(3)=" In order for the obligation of this adjustment to proceed, the"
|
|---|
| 24 | .S MSG(4)=" previous document cannot have a status of 'REJECTED', 'ERROR"
|
|---|
| 25 | .S MSG(5)=" IN TRANSMISSION', 'QUEUED FOR TRANSMISSION', or 'TRANSMITTED'.",MSG(6)=" "
|
|---|
| 26 | .S MSG(7)=" FMS Document: "_SODOC,MSG(8)=" Status: "_SOSTAT,MSG(9)=" "
|
|---|
| 27 | .S MSG(10)=" No further action is being taken on this obligation."
|
|---|
| 28 | .D EN^DDIOL(.MSG) K MSG W !
|
|---|
| 29 | .Q
|
|---|
| 30 | SC W:$D(IOF) @IOF W "PROCESS 1358 ADJUSTMENT",?40,"Obligation #: ",IOINHI,$P(PO(0),"^")
|
|---|
| 31 | W !!,IOINLOW," Service Balance: $ ",IOINHI,$FN(+PO(8)-$P(PO(8),"^",3),"P,",2)
|
|---|
| 32 | W !,IOINLOW," Fiscal Balance: $ ",IOINHI,$FN(+PO(8)-$P(PO(8),"^",2),"P,",2)
|
|---|
| 33 | W !,IOINLOW,"Amount of Adjustment: $ ",IOINHI,$FN($P(TRNODE(4),"^",8),",P",2)
|
|---|
| 34 | W !!,IOINLOW,?20,"ORIGINAL",?45,"ADJUSTMENT"
|
|---|
| 35 | 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,"*****"
|
|---|
| 36 | 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
|
|---|
| 37 | 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
|
|---|
| 38 | W IOINORM
|
|---|
| 39 | I NOGO[2 D SUB G OUT ;G:'Y V D SAEDIT^PRCS58OB(.PO,TRDA) S I=4
|
|---|
| 40 | I NOGO[3 D CC G OUT
|
|---|
| 41 | CHECK ; Check adjustment amount with obligation/liquidation/authorization amounts
|
|---|
| 42 | I PRC442,+$G(PRCFA("RETRAN"))=0,$$EN1^PRCE0A(PRC410,PRC442,1) W !,$C(7),"Send 1358 adjustment back to service.",! G OUT
|
|---|
| 43 | S PRCFA("MOD")="M^1^Modification Entry"
|
|---|
| 44 | W ! D VENCONM^PRCFFU15(+PO)
|
|---|
| 45 | D EN^PRCFFU14(TRDA) I ACCEDIT G SC
|
|---|
| 46 | D AUTACC^PRCFFU6 S PRCFA("ACCEDIT")=1
|
|---|
| 47 | N Y S PRCFA("IDES")="1358 Obligation Adjustment" W ! D OKAY^PRCFFU
|
|---|
| 48 | ; Patch 23, fix Y undef error
|
|---|
| 49 | ;I Y K DIR,Y D ^PRCESOM I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 G V1
|
|---|
| 50 | I Y K DIR,Y D ^PRCESOM G:'$G(PRCFA("RETRAN")) V1 S Y=0 ; patch 23
|
|---|
| 51 | I 'Y!($D(DIRUT)) W ! D EN^DDIOL("No further processing is being taken on this adjustment.")
|
|---|
| 52 | OUT K DTOUT,DIR,DUOUT,DIRUT,DIROUT
|
|---|
| 53 | OUT1 K DA,D0,ACCEDIT,BBFY,BEGDATE,CONT,CONTEND,CONTIEN,ENDDATE,ESIGMSG,EXIT
|
|---|
| 54 | K FMSMOD,FMSVENID,GECSFMS,I,NEWACC,NEWDATE,NOGO
|
|---|
| 55 | K NUMB,OB,PARAM1,PO,PODA,PODATE,POIEN,PRC410,PRC442,PRCCC,PRCCCC,PRCCSCC
|
|---|
| 56 | K PRCCP,PRCFA,PRCFMO,PRCREQST,PRCSTA,PRCSTR,PRCTMP,SODOC,SOSTAT
|
|---|
| 57 | K STR2,TMP410,TMP442,TRDA,TRNODE,VENCONT,X,X1
|
|---|
| 58 | Q
|
|---|
| 59 | FMSTAT ; Check status of prior FMS Documments
|
|---|
| 60 | D FMSTAT^PRCEADJ(+PO,.SODOC,.SOSTAT)
|
|---|
| 61 | Q
|
|---|
| 62 | SUB ; Check BOCs (subaccounts)
|
|---|
| 63 | K MSG W !!
|
|---|
| 64 | S MSG(1)=" BOCs on the adjustment are not the same as on the original obligation."
|
|---|
| 65 | S MSG(2)=" Processing cannot continue - please return to the Service for correction.",MSG(3)=" "
|
|---|
| 66 | S MSG(4)=" No further processing is being taken on this adjustment."
|
|---|
| 67 | D MSG(.MSG)
|
|---|
| 68 | Q
|
|---|
| 69 | CC ; Check Cost Centers
|
|---|
| 70 | K MSG W !!
|
|---|
| 71 | S MSG(1)=" Cost Center on the adjustment is not the same as on the original"
|
|---|
| 72 | S MSG(2)=" obligation. Processing cannot continue - please return to the"
|
|---|
| 73 | S MSG(3)=" Service for correction.",MSG(4)=" "
|
|---|
| 74 | S MSG(5)=" No further processing is being taken on this adjustment."
|
|---|
| 75 | D MSG(.MSG)
|
|---|
| 76 | Q
|
|---|
| 77 | MSG(X) ; Display message
|
|---|
| 78 | Q:'$D(MSG)
|
|---|
| 79 | D EN^DDIOL(.MSG),ENCON^PRCFQ
|
|---|
| 80 | Q
|
|---|
