source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU11.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCFFU11 ;WISC/SJG-ADJUST FCP BALANCES ;
2V ;;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
28FCP 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
Note: See TracBrowser for help on using the repository browser.