[613] | 1 | PRCFFU10 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;7/24/00 23:16
|
---|
| 2 | V ;;5.1;IFCAP;**58**;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 | ; Check overcommit for control point for P.O.
|
---|
| 8 | ;
|
---|
| 9 | ; AMT is obtained from PO (Net Amount field #92) if original entry
|
---|
| 10 | ; or from amendment multiple subfield (Amount Changed field #2)
|
---|
| 11 | ; if modification
|
---|
| 12 | ;
|
---|
| 13 | OVCOM N PARAM,AMT,TYPE
|
---|
| 14 | S PRCFA("OVCOM")=0
|
---|
| 15 | I '$D(PRCFA("MOD")) D G OV1
|
---|
| 16 | .S AMT=$P(PO(0),U,16)
|
---|
| 17 | .I $D(^PRC(443.6,+PO,6)),$D(PO(6)) S AMT=$P(PO(6),U,3)
|
---|
| 18 | .Q
|
---|
| 19 | I $D(PRCFA("MOD")) S TYPE=$P(PRCFA("MOD"),U)
|
---|
| 20 | S:TYPE="E" AMT=$P(PO(0),U,16)
|
---|
| 21 | I $D(PO(6)) S:TYPE="M" AMT=$P(PO(6),U,3)
|
---|
| 22 | OV1 ;S PARAM=PRC("SITE")_U_+$P(PO(0),U,3)_U_PRC("FY")_U_PRC("QTR")
|
---|
| 23 | ;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
|
---|
| 24 | ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
|
---|
| 25 | ;
|
---|
| 26 | ; **Add call to OBLDAT^PRCFFUD1 as part of PRC*5.1*58
|
---|
| 27 | S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_+PRC("CP")_"^"_$P($$DATE^PRC0C($$OBLDAT^PRCFFUD1(PRC("RBDT"),$G(PRC("AMENDT"))),"I"),"^",1,2),AMT,1)
|
---|
| 28 | K OBLDAT
|
---|
| 29 | ; **End fix for PRC*5.1*58
|
---|
| 30 | ;
|
---|
| 31 | Q
|
---|
| 32 | POFAIL ; Display error message for P.O if failure
|
---|
| 33 | W !!," This Purchase Order would overcommit the funds available for the"
|
---|
| 34 | W !," Fund Control Point. Please return the Purchase Order to the Service.",!
|
---|
| 35 | Q
|
---|
| 36 | OVCOM1 ; Check overcommit for control point for 1358
|
---|
| 37 | N PARAM,AMT
|
---|
| 38 | S PRCFA("OVCOM")=0,AMT=$P(TRNODE(4),U,8)
|
---|
| 39 | ;S PARAM=PRC("SITE")_U_+$P(TRNODE(3),U)_U_PRC("FY")_U_PRC("QTR")
|
---|
| 40 | ;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
|
---|
| 41 | ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
|
---|
| 42 | S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_PRC("CP")_"^"_$P($$DATE^PRC0C(PRC("RBDT"),"I"),"^",1,2),AMT,1)
|
---|
| 43 | Q
|
---|
| 44 | REQFAIL ; Display error message for 1358 if failure
|
---|
| 45 | W !!," This 1358 request would overcommit the funds available for the"
|
---|
| 46 | W !," Fund Control Point. Please return the 1358 to the Service."
|
---|
| 47 | Q
|
---|