| [613] | 1 | PRCFFU11 ;WISC/SJG-ADJUST FCP BALANCES ;
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | QUIT
|
|---|
| 6 | ; No top level entry
|
|---|
| 7 | ; Called when PO amendment is cancelled by Authority E
|
|---|
| 8 | ;
|
|---|
| 9 | ; The following lines commented out by patch 172 but
|
|---|
| 10 | ; if reinstated, conditionalize CPB update on PRCFA("NEW410") existence
|
|---|
| 11 | ; PRCFA("NEW410") is set when the CPB is updated - see field25,file410
|
|---|
| 12 | ; This field is set in PRC0F which is called by NEW410^PRCFFUD
|
|---|
| 13 | ;
|
|---|
| 14 | ; Q:'$D(PRCOAMT) Q:'$D(PRCFMO)
|
|---|
| 15 | ; N TRDA,Z,AMT,DEL,X,TIME,DA
|
|---|
| 16 | ; S TRDA=$P(^PRC(442,PRCFA("PODA"),0),"^",12),AMT=$P(^(0),"^",$P(PRCFMO,"^",12)="N"+15),DEL=$P(^(0),"^",10)
|
|---|
| 17 | ; D NOW^%DTC S TIME=X
|
|---|
| 18 | ; D GENDIQ^PRCFFU7(442,PRCFA("PODA"),.5,"I","")
|
|---|
| 19 | ; S POSTAT=PRCTMP(442,PRCFA("PODA"),.5,"I") K PRCTMP(442,PRCFA("PODA"),.5,"I")
|
|---|
| 20 | ; W !!,"...now updating Control Point balances..."
|
|---|
| 21 | ; Adjust FCP Committed and Obligated Balances
|
|---|
| 22 | ; I TRDA="" D QUIT
|
|---|
| 23 | ; .N A
|
|---|
| 24 | ; .S A=$$DATE^PRC0C($P(PRCOAMT,"^",3),"I"),$P(PRCOAMT,"^",3,4)=$E(A,3,4)_"^"_$P(A,"^",2)
|
|---|
| 25 | ; .D EBAL^PRCSEZ(PRCOAMT,"C")
|
|---|
| 26 | ; .D:$G(MTOPDA)="" EBAL^PRCSEZ(PRCOAMT,"O")
|
|---|
| 27 | ; .QUIT
|
|---|
| 28 | FCP N DA,MESSAGE
|
|---|
| 29 | S DA=$P(^PRC(442,PRCFA("PODA"),0),"^",12)
|
|---|
| 30 | I DA="" Q
|
|---|
| 31 | I '$D(^PRCS(410,DA,4)) Q
|
|---|
| 32 | S $P(^PRCS(410,DA,9),"^",2)=$P(^PRC(442,PRCFA("PODA"),0),"^",10) ; delivery date
|
|---|
| 33 | D REMOVE^PRCSC2(DA),ENCODE^PRCSC2(DA,DUZ,.MESSAGE) ; signatures
|
|---|
| 34 | QUIT
|
|---|
