| [613] | 1 | PRCELIQ ;WISC/CLH/CTB-LIQUIDATE 1358 ;9/14/95 11:40 [1/27/99 3:19pm]
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN K PO,PRCFA,PRC,X,X1,%,ER,Y,Z,CNT,IOINHI,IOINLOW,IOINORM,LD,LAMT,DIC,DIE,DR,DA
|
|---|
| 5 | S PRCF("X")="AS" D ^PRCFSITE Q:'%
|
|---|
| 6 | D LIQ^PRCH58LQ(.PRCFA,.Y,.ER,.PO)
|
|---|
| 7 | I 'ER G EXIT
|
|---|
| 8 | EN1 ;entry point when obligation number defined
|
|---|
| 9 | K ^TMP($J,"PRCE","LIQ")
|
|---|
| 10 | EN2 D SCREEN G EXIT:$D(OUT) S DIR("A")="Ok to post liquidation",DIR("B")="Yes",DIR(0)="YO" D ^DIR K DIR G:'Y EXIT
|
|---|
| 11 | S (X,Z)=$P(PO(0),"^") I '$D(^PRC(424,"C",PRCFA("PODA"))) W $C(7),!!,"This obligation has not yet established in the 1358 file." H 2 G EXIT
|
|---|
| 12 | D EN1^PRCSUT3 S X1=X,DLAYGO=424,DIC="^PRC(424,",DIC(0)="LXZ" D ^DIC K DLAYGO I Y<0 W !!,"YOU DO NOT HAVE THE RIGHT SECURITY ACCESS CODE FOR THIS FILE!!",$C(7) H 3 G EXIT
|
|---|
| 13 | W !!,"This 1358 Liquidation entry is assigned entry number ",X1,"."
|
|---|
| 14 | S ZX1=X1,DA=+Y
|
|---|
| 15 | S DIR(0)="D^"_$E($P($G(PO(12)),U,5),1,7)_":"_DT_".235959"_":EST",DIR("A")="LIQUIDATION DATE",DIR("?")="Enter liquidation date or '^' to quit "
|
|---|
| 16 | S DIR("B")=$$DATE^PRCH58 D ^DIR K DIR I $D(DIRUT) D DEL G OUT
|
|---|
| 17 | S LD=Y
|
|---|
| 18 | R S DIR(0)="N^-999999999.99:999999999.99:2",DIR("A")="LIQUIDATION AMOUNT",DIR("?")="Enter the amount of this liquidation or '^' to QUIT"
|
|---|
| 19 | I $G(PRCFA("LIQAMT"))]"",+PRCFA("LIQAMT")'=0 S DIR("B")=PRCFA("LIQAMT")
|
|---|
| 20 | D ^DIR K DIR I $D(DIRUT) D DEL G OUT
|
|---|
| 21 | S LAMT=Y W " $",$FN(LAMT,",",2)
|
|---|
| 22 | I ($P(PO(8),U,2)+LAMT)>+PO(8) D OVER G R
|
|---|
| 23 | I '$D(Y) S DIR(0)="Y",DIR("A")="OK to Post",DIR("B")="Yes",DIR("?")="Enter 'Yes' to POST, 'No' or an '^' to DELETE and quit" D ^DIR K DIR I $D(DIRUT)!('Y) D DEL G OUT
|
|---|
| 24 | S DIE="^PRC(424,",DR=".1;1.1;.02////^S X=PRCFA(""PODA"");.03////^S X=""L"";.04////^S X=LAMT;.07////^S X=LD;.08////^S X=DUZ;.15////^S X=$G(PRCFA(""TRDA""))" D ^DIE
|
|---|
| 25 | D WAIT^PRCFYN,POST^PRCH58LQ(.PRCFA,LAMT,.PO) S ^TMP($J,"PRCE","LIQ",ZX1)=LAMT,X=" ---POSTED---" D MSG^PRCFQ
|
|---|
| 26 | I $D(PRCFD("PAYMENT")) S ^TMP("PRCFDA",$J,"LIQ")=-LAMT_U_PRCFA("PODA")_U_ZX1_U_DA
|
|---|
| 27 | OUT G:$D(PRCFD("PAYMENT")) EXIT W ! S DIR("A")="Would you like to enter another Liquidation for THIS OBLIGATION",DIR(0)="YO",DIR("B")="No"
|
|---|
| 28 | S DIR("?",1)="If you want to make further liquidations on this obligation",DIR("?")="enter (Y)es, <RETURN> or '^' to quit" D ^DIR K DIR I Y G EN2
|
|---|
| 29 | D SHOW
|
|---|
| 30 | S DIR("A")="Would you like to select another 1358 (obligation number)",DIR(0)="YO",DIR("?",1)="Enter yes to make liquidations on a different 1358 obligation"
|
|---|
| 31 | S DIR("?")="<RETURN> or '^' to quit",DIR("B")="Yes" D ^DIR K DIR I Y G EN
|
|---|
| 32 | EXIT K DIRUT,DTOUT,DUOUT,DIRUT,DIROUT,%,^TMP($J,"PRCE","LIQ"),ZX1
|
|---|
| 33 | Q
|
|---|
| 34 | SCREEN ;display balance data prior to posting
|
|---|
| 35 | K OUT S:'$D(CNT) CNT=0
|
|---|
| 36 | D HILO^PRCFQ W @IOF,IOINHI,"Post Liquidation to 1358",IOINLOW,?40,"Obligation #: ",IOINHI,$P(PO(0),"^")
|
|---|
| 37 | W !?20,IOINLOW,"Status: ",IOINHI,$S(+$P(PO(7),"^")>0:$P(^PRCD(442.3,$P(PO(7),"^"),0),"^"),1:"Unknown"),!!,IOINLOW,"Current amount obligated: ",IOINHI,"$ "_$FN($P(PO(8),U),",",2),IOINLOW
|
|---|
| 38 | W ?40," Authorization Balance: ",IOINHI,"$ "_$FN(+PO(8)-$P(PO(8),"^",3),",",2),IOINLOW,!!?41,"Unliquidated Balance: ",IOINHI,"$ "_$FN(+PO(8)-$P(PO(8),"^",2),",",2),IOINORM,!!
|
|---|
| 39 | S PRCUNLIQ=+PO(8)-(+$P(PO(8),U,2))
|
|---|
| 40 | S DIR(0)="YO",DIR("B")="No",DIR("A")="Do you wish to display/print the entire 1358"_$S($G(PRCOUNT)="":"",1:" again") D ^DIR K DIR I 'Y K PRCOUNT S OUT=""
|
|---|
| 41 | I Y S PRCSQ=1,DA=$P(PO(0),"^",12) D @$S($D(PRCFD("PAYMENT")):"EN1^PRCEFIS5",1:"^PRCEFIS5") K PRCSQ S PRCOUNT=1 G SCREEN
|
|---|
| 42 | K OUT
|
|---|
| 43 | Q
|
|---|
| 44 | OVER ;over drawn notice
|
|---|
| 45 | N X
|
|---|
| 46 | S X=LAMT+$P(PO(8),U,2)-PO(8)
|
|---|
| 47 | W !,$C(7),"This amount EXCEEDS available funds by $ ",$FN(X,",",2),".",!
|
|---|
| 48 | S X="Liquidating an amount this large CANNOT occur until the responsible service has submitted and Fiscal obligates an increase adjustment." D MSG^PRCFQ
|
|---|
| 49 | Q:$P($G(PO(0)),U,3)="" N MSG,XMSUB,XMDUZ,XMTEXT,CP,ZX S CP=+$P(PO(0),U,3)
|
|---|
| 50 | W !! S X="Control point being notified...." D MSG^PRCFQ W !!
|
|---|
| 51 | S MSG(1)=" *** NOTICE ***",MSG(2)=" ",MSG(3)="On "_$E(LD,4,5)_"/"_$E(LD,6,7)_"/"_$E(LD,2,3)_" Fiscal Service attempted to process a payment against"
|
|---|
| 52 | S MSG(4)="PAT#: "_$P($G(PO(0)),U)_" for $ "_$FN(LAMT,",",2)_". The payment WAS NOT processed due to",MSG(5)="INSUFFICIENT FUNDS on the obligation."
|
|---|
| 53 | S MSG(6)=" ",MSG(7)="Review and take appropriate action on the above PAT Reference Number."
|
|---|
| 54 | S MSG(8)="Payment CANNOT be processed until action has been taken."
|
|---|
| 55 | S XMTEXT="MSG(",XMSUB="1358 PAYMENT NOT PROCESSED"
|
|---|
| 56 | S ZX=0 F S ZX=$O(^PRC(420,PRC("SITE"),1,CP,1,ZX)) Q:'ZX I $P($G(^(ZX,0)),U,2)<3 S XMY(ZX)="",XMY(ZX,1)="I"
|
|---|
| 57 | D:$O(XMY(0)) ^XMD
|
|---|
| 58 | Q
|
|---|
| 59 | DEL S DIK="^PRC(424," D WAIT^PRCFYN,^DIK K DIK S X="Liquidation entry deleted*" D MSG^PRCFQ G EXIT
|
|---|
| 60 | ;
|
|---|
| 61 | SHOW ;show all transactions posted
|
|---|
| 62 | N ZDA,ZTOT
|
|---|
| 63 | Q:'$D(^TMP($J,"PRCE","LIQ"))
|
|---|
| 64 | S ZTOT=0 W:$D(IOF) @IOF,!!,?27,"Obligation #: ",$P(PO(0),"^")
|
|---|
| 65 | W !!,"Sequence #",?40,"Amount",!! S ZDA="" F S ZDA=$O(^TMP($J,"PRCE","LIQ",ZDA)) Q:'ZDA W ?6,$P(ZDA,"-",3),?36,$J(^TMP($J,"PRCE","LIQ",ZDA),10,2),! S ZTOT=ZTOT+^TMP($J,"PRCE","LIQ",ZDA)
|
|---|
| 66 | W !!,?29,"Total: ",$J(ZTOT,10,2),!!
|
|---|
| 67 | Q
|
|---|
