Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFFU11

PRCFFU11.m

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