PRCFFU10 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;7/24/00 23:16
V ;;5.1;IFCAP;**58**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
QUIT
; No top level entry
; Check overcommit for control point for P.O.
;
; AMT is obtained from PO (Net Amount field #92) if original entry
; or from amendment multiple subfield (Amount Changed field #2)
; if modification
;
OVCOM N PARAM,AMT,TYPE
S PRCFA("OVCOM")=0
I '$D(PRCFA("MOD")) D G OV1
.S AMT=$P(PO(0),U,16)
.I $D(^PRC(443.6,+PO,6)),$D(PO(6)) S AMT=$P(PO(6),U,3)
.Q
I $D(PRCFA("MOD")) S TYPE=$P(PRCFA("MOD"),U)
S:TYPE="E" AMT=$P(PO(0),U,16)
I $D(PO(6)) S:TYPE="M" AMT=$P(PO(6),U,3)
OV1 ;S PARAM=PRC("SITE")_U_+$P(PO(0),U,3)_U_PRC("FY")_U_PRC("QTR")
;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
;
; **Add call to OBLDAT^PRCFFUD1 as part of PRC*5.1*58
S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_+PRC("CP")_"^"_$P($$DATE^PRC0C($$OBLDAT^PRCFFUD1(PRC("RBDT"),$G(PRC("AMENDT"))),"I"),"^",1,2),AMT,1)
K OBLDAT
; **End fix for PRC*5.1*58
;
Q
POFAIL ; Display error message for P.O if failure
W !!," This Purchase Order would overcommit the funds available for the"
W !," Fund Control Point. Please return the Purchase Order to the Service.",!
Q
OVCOM1 ; Check overcommit for control point for 1358
N PARAM,AMT
S PRCFA("OVCOM")=0,AMT=$P(TRNODE(4),U,8)
;S PARAM=PRC("SITE")_U_+$P(TRNODE(3),U)_U_PRC("FY")_U_PRC("QTR")
;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
S PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_PRC("CP")_"^"_$P($$DATE^PRC0C(PRC("RBDT"),"I"),"^",1,2),AMT,1)
Q
REQFAIL ; Display error message for 1358 if failure
W !!," This 1358 request would overcommit the funds available for the"
W !," Fund Control Point. Please return the 1358 to the Service."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFU10 1998 printed Dec 13, 2024@02:03:34 Page 2
PRCFFU10 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;7/24/00 23:16
V ;;5.1;IFCAP;**58**;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 ; Check overcommit for control point for P.O.
+6 ;
+7 ; AMT is obtained from PO (Net Amount field #92) if original entry
+8 ; or from amendment multiple subfield (Amount Changed field #2)
+9 ; if modification
+10 ;
OVCOM NEW PARAM,AMT,TYPE
+1 SET PRCFA("OVCOM")=0
+2 IF '$DATA(PRCFA("MOD"))
Begin DoDot:1
+3 SET AMT=$PIECE(PO(0),U,16)
+4 IF $DATA(^PRC(443.6,+PO,6))
IF $DATA(PO(6))
SET AMT=$PIECE(PO(6),U,3)
+5 QUIT
End DoDot:1
GOTO OV1
+6 IF $DATA(PRCFA("MOD"))
SET TYPE=$PIECE(PRCFA("MOD"),U)
+7 if TYPE="E"
SET AMT=$PIECE(PO(0),U,16)
+8 IF $DATA(PO(6))
if TYPE="M"
SET AMT=$PIECE(PO(6),U,3)
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")
+2 ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
+3 ;
+4 ; **Add call to OBLDAT^PRCFFUD1 as part of PRC*5.1*58
+5 SET PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_+PRC("CP")_"^"_$PIECE($$DATE^PRC0C($$OBLDAT^PRCFFUD1(PRC("RBDT"),$GET(PRC("AMENDT"))),"I"),"^",1,2),AMT,1)
+6 KILL OBLDAT
+7 ; **End fix for PRC*5.1*58
+8 ;
+9 QUIT
POFAIL ; Display error message for P.O if failure
+1 WRITE !!," This Purchase Order would overcommit the funds available for the"
+2 WRITE !," Fund Control Point. Please return the Purchase Order to the Service.",!
+3 QUIT
OVCOM1 ; Check overcommit for control point for 1358
+1 NEW PARAM,AMT
+2 SET PRCFA("OVCOM")=0
SET AMT=$PIECE(TRNODE(4),U,8)
+3 ;S PARAM=PRC("SITE")_U_+$P(TRNODE(3),U)_U_PRC("FY")_U_PRC("QTR")
+4 ;S PRCFA("OVCOM")=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
+5 ;S:PRCFA("OVCOM") PRCFA("OVCOM")=$$OVCOM^PRCS0A(PARAM,AMT,1)
+6 SET PRCFA("OVCOM")=$$OVCOM^PRCS0A(PRC("SITE")_"^"_PRC("CP")_"^"_$PIECE($$DATE^PRC0C(PRC("RBDT"),"I"),"^",1,2),AMT,1)
+7 QUIT
REQFAIL ; Display error message for 1358 if failure
+1 WRITE !!," This 1358 request would overcommit the funds available for the"
+2 WRITE !," Fund Control Point. Please return the 1358 to the Service."
+3 QUIT
