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

PRCFFU10.m

Go to the documentation of this file.
  1. PRCFFU10 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;7/24/00 23:16
  1. V ;;5.1;IFCAP;**58**;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. ; Check overcommit for control point for P.O.
  1. ;
  1. ; AMT is obtained from PO (Net Amount field #92) if original entry
  1. ; or from amendment multiple subfield (Amount Changed field #2)
  1. ; if modification
  1. ;
  1. OVCOM N PARAM,AMT,TYPE
  1. S PRCFA("OVCOM")=0
  1. I '$D(PRCFA("MOD")) D G OV1
  1. .S AMT=$P(PO(0),U,16)
  1. .I $D(^PRC(443.6,+PO,6)),$D(PO(6)) S AMT=$P(PO(6),U,3)
  1. .Q
  1. I $D(PRCFA("MOD")) S TYPE=$P(PRCFA("MOD"),U)
  1. S:TYPE="E" AMT=$P(PO(0),U,16)
  1. I $D(PO(6)) S:TYPE="M" AMT=$P(PO(6),U,3)
  1. OV1 ;S PARAM=PRC("SITE")_U_+$P(PO(0),U,3)_U_PRC("FY")_U_PRC("QTR")
  1. ;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
  1. ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
  1. ;
  1. ; **Add call to OBLDAT^PRCFFUD1 as part of PRC*5.1*58
  1. S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_+PRC("CP")_"^"_$P($$DATE^PRC0C($$OBLDAT^PRCFFUD1(PRC("RBDT"),$G(PRC("AMENDT"))),"I"),"^",1,2),AMT,1)
  1. K OBLDAT
  1. ; **End fix for PRC*5.1*58
  1. ;
  1. Q
  1. POFAIL ; Display error message for P.O if failure
  1. W !!," This Purchase Order would overcommit the funds available for the"
  1. W !," Fund Control Point. Please return the Purchase Order to the Service.",!
  1. Q
  1. OVCOM1 ; Check overcommit for control point for 1358
  1. N PARAM,AMT
  1. S PRCFA("OVCOM")=0,AMT=$P(TRNODE(4),U,8)
  1. ;S PARAM=PRC("SITE")_U_+$P(TRNODE(3),U)_U_PRC("FY")_U_PRC("QTR")
  1. ;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
  1. ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
  1. S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_PRC("CP")_"^"_$P($$DATE^PRC0C(PRC("RBDT"),"I"),"^",1,2),AMT,1)
  1. Q
  1. REQFAIL ; Display error message for 1358 if failure
  1. W !!," This 1358 request would overcommit the funds available for the"
  1. W !," Fund Control Point. Please return the 1358 to the Service."
  1. Q