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