PRCFFUD ;WISC/SJG-UTILITY FOR CARRY FORWARD ;7/24/00 23:14
V ;;5.1;IFCAP;**181**;Oct 20, 2000;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
;
;PRC*5.1*181 Added calc for regular POs to calc the correct amount
; between original PO and amended PO
;
QUIT
; No top level entry
;
OBDT() ; Check if obligation processing date is valid for the open quarter
N GOFLAG,MOP,STNQTR,PODATE,PRIMARY,SDATE1,SDATE2,SDATE3,SDATE4,SPIECE1,SPIECE2,SPIECE3,SPIECE4,RBQTR,AMDDATE
S GOFLAG=0
S MOP=$$NP^PRC0B("^PRC(442,"_+PO_",",0,2)
S PRIMARY=$$NP^PRC0B("^PRC(442,"_+PO_",",0,12)
S STNQTR=$$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,9)
; If obligation is an original entry, use PO date
; If obligation is an amendment, use amendment date
I '$D(PRCFA("AMEND#")) S PODATE=$$NP^PRC0B("^PRC(442,"_+PO_",",1,15)
I $D(PRCFA("AMEND#")),MOP'=21 D S PODATE=$G(AMDDATE)
.; If amendment is initial document, get info from file 443.6
.I PRCFA("RETRAN")=0 D Q
..N SUBINFO S SUBINFO="443.67^1^"_PRCFA("AMEND#")
..K PRCTMP(443.67,PRCFA("AMEND#"),1)
..D GENDIQ^PRCFFU7(443.6,PRCFA("PODA"),50,"IEN",SUBINFO)
..S AMDDATE=$G(PRCTMP(443.67,PRCFA("AMEND#"),1,"I"))
..K PRCTMP(443.67,PRCFA("AMEND#"),1)
..Q
.; If amendment is rebuild, get info from file 442
.I PRCFA("RETRAN")=1 D Q
..N SUBINFO S SUBINFO="442.07^1^"_PRCFA("AMEND#")
..K PRCTMP(442.07,PRCFA("AMEND#"),1)
..D GENDIQ^PRCFFU7(442,PRCFA("PODA"),50,"IEN",SUBINFO)
..S AMDDATE=$G(PRCTMP(442.07,PRCFA("AMEND#"),1,"I"))
..K PRCTMP(442.07,PRCFA("AMEND#"),1)
..Q
.Q
S SDATE1=$$DATE^PRC0C(PODATE,"I"),SDATE2=$$DATE^PRC0C(PRCFA("OBLDATE"),"I"),SDATE3=$$DATE^PRC0C(STNQTR,"I")
S SPIECE1=$P(SDATE1,U,1,2),SPIECE2=$P(SDATE2,U,1,2),SPIECE3=$P(SDATE3,U,1,2)
; Check if transaction is a 1358
I MOP=21 D G QUIT
.S RBQTR=$$NP^PRC0B("^PRCS(410,"_PRIMARY_",",0,11)
.S SDATE4=$$DATE^PRC0C(RBQTR,"I"),SPIECE4=$P(SDATE4,U,1,2)
.I SPIECE2=SPIECE4 S GOFLAG=1 Q
; Check if transaction has a 2237 request
I $G(PRIMARY)="" D G QUIT
.; allow PO/oblig date from current qtr
.I SPIECE1=SPIECE2,SPIECE2=SPIECE3 S GOFLAG=1 Q
.; allow PO/oblig date for fut qtr if PO date qtr same as oblig qtr
.I SPIECE3=SPIECE2,SPIECE2]SPIECE1 S GOFLAG=1 Q
.; allow PO/oblig date for fut qtr if oblig qtr later than stn open qtr
.I SPIECE2]SPIECE3 S GOFLAG=1 Q
I $G(PRIMARY)]"" D G QUIT
.; allow PO/oblig date from current qtr
.I SPIECE1=SPIECE2,SPIECE2=SPIECE3 S GOFLAG=1 Q
.; allow PO/oblig date from future qtr
.I SPIECE1=SPIECE2,SPIECE2]SPIECE3 S GOFLAG=1 Q
.; allow PO/oblig date from prior qtr if open qtr same as oblig qtr
.I SPIECE2=SPIECE3,SPIECE3]SPIECE1 S GOFLAG=1 Q
QUIT QUIT GOFLAG
;
NEW410 ; Create an entry in File 410 for any PO that does not have a request
Q:$G(PRCFA("RETRAN"))=1
W ! D EN^DDIOL("...now creating entry in File 410...")
N POAMT,P410,NEW410
S POAMT=+$S($P(PRCFMO,"^",12)="N":$P(PO(0),"^",16),1:$P(PO(0),"^",15))
S P410=+PRCFA("REF")_U_+$P(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_POAMT_U_$P(PRCFA("REF"),"-",2)_"WR"_U_"ST"_U_+PO
S $P(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
D A410^PRC0F(.NEW410,P410) S PRCFA("NEW410")=NEW410
QUIT
;
AMEND ; Create an entry in File 410 for each amendment to a purchase order
; Case 1 - amendment with no cancelled documents
Q:$G(PRCFA("RETRAN"))=1
N AMDEXT S AMDEXT="-"_$G(PRCFA("AMEND#"))
W ! D EN^DDIOL("...now creating entry in File 410 for the amendment...")
I '$D(PRCFA("CANCEL")) D Q
.N AMDAMT,P410,NEW410 S AMDAMT=$$AMDAMT()
.S P410=+PRCFA("REF")_U_+$P(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$P(PRCFA("REF"),"-",2)_AMDEXT_U_"ST"_U_+PO
.S $P(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
.I $G(PRCHAUTH)'=1,$P(^PRC(442,PRCHPO,0),U,2)'=25 D
..S $P(P410,U,6)=$P(^PRC(442,PRCFA("PODA"),0),U,16)-$P(PO(0),U,16) ;PRC*5.1*181 Fix for 410 adj between amend $$ and prior PO $$
.D A410^PRC0F(.NEW410,P410) S PRCFA("NEW410")=NEW410
.Q
; Case 2 - amendment types: vendor change, FCP change, PO number change
I $D(PRCFA("CANCEL")),'PRCFA("AUTHE") D Q
.; First update for the old record
.N AMDAMT,POREF,AMDNO,FCP,OLDFCP
.S AMDAMT=$$AMDAMT1()
.I $G(PRCFA("PO"))=1 S POREF=PRCFA("OLDPODA")_U_PRCFA("OLDREF")
.I $G(PRCFA("PO"))="" S POREF=PRCFA("PODA")_U_PRCFA("REF")
.I $G(PRCFA("FCP"))=1 D S FCP=+OLDFCP
..N LOOP ; "AC" cross ref sorts changes by field# (1=FCP) and amendment type (30=FCP edit)
..S LOOP=$O(^PRC(442,PRCFA("PODA"),6,PRCFA("AMEND#"),3,"AC",30,1,0))
..I LOOP]"" S OLDFCP=^PRC(442,PRCFA("PODA"),6,PRCFA("AMEND#"),3,LOOP,1,1,0)
..Q
.I $G(PRCFA("FCP"))="" S FCP=+$P(PO(0),U,3)
.S P410=+$P(POREF,U,2)_U_FCP_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$P($P(POREF,U,2),"-",2)_AMDEXT_U_"ST"_U_+POREF
.S $P(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
.D A410^PRC0F(.NEW410,P410)
.; Then update for new record
.S AMDAMT=-AMDAMT
.I $G(PRCFA("PO"))=1 S POREF=PRCFA("NEWPODA")_U_PRCFA("NEWREF"),AMDEXT=""
.I $G(PRCFA("PO"))="" S POREF=PRCFA("PODA")_U_PRCFA("REF")
.S P410=+$P(POREF,U,2)_U_+$P(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$P($P(POREF,U,2),"-",2)_AMDEXT_U_"ST"_U_+POREF
.S $P(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
.D A410^PRC0F(.NEW410,P410)
.Q
; Case 3 - amendments type - cancel by Authority E
I $D(PRCFA("CANCEL")),PRCFA("AUTHE") D Q
.N AMDAMT S AMDAMT=$$AMDAMT1(),AMDEXT=AMDEXT_"#"
.S P410=+PRCFA("REF")_U_+$P(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$P(PRCFA("REF"),"-",2)_AMDEXT_U_"ST"_U_+PO
.S $P(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
.D A410^PRC0F(.NEW410,P410) S PRCFA("NEW410")=NEW410
.Q
QUIT
PO ; Updating Running Balance Status Field (#449) in File 410 for
; purchase order
Q:$G(PRCFA("RETRAN"))=1
Q:$G(PRCTMP(442,+PO,.07,"I"))=""
I $G(PRCTMP(442,+PO,.07,"I"))]"" D Q
.W !!,"...updating running balance status fields in 410...WITH 2237"
.N LOOP S LOOP=0
.F S LOOP=$O(^PRC(442,+PO,13,LOOP)) Q:LOOP=""!(LOOP'>0) I LOOP>0 D EDIT410(LOOP,"O")
.Q
QUIT
AMD ; Updating Running Balance Status Field (#449) in File 410 for
; purchase order amendment
Q:$G(PRCFA("RETRAN"))=1
W !!,"...updating running balance status fields in 410...FOR AMENDMENT"
D EDIT410(NEW410,"O")
QUIT
;
EDIT410(TRDAIEN,TRSTAT) ; Edit running balance status and running balance quarter fields in 410
D ERS410^PRC0G(TRDAIEN_"^"_TRSTAT)
QUIT
;
; Message processing
AMDAMT() ; Get dollar amount for AMENDMENT from amendment multiple
N SUBINFO,AMDAMT S SUBINFO="442.07^2^"_PRCFA("AMEND#")
D GENDIQ^PRCFFU7(442,PRCFA("PODA"),50,"IEN",SUBINFO)
S AMDAMT=$G(PRCTMP(442.07,PRCFA("AMEND#"),2,"E"))
Q AMDAMT
AMDAMT1() ; Get dollar amount for AMENDMENT from zero node
N AMDAMT
S AMDAMT=-$S($P(PRCFMO,"^",12)="N":$P(PO(0),"^",16),1:$P(PO(0),"^",15))
Q AMDAMT
MSG1 ;
K MSG W !
S MSG(1)="The Obligation Processing Date is not a valid date for this transaction."
S MSG(2)="Please enter a date which matches the requests or p.o. quarter."
D EN^DDIOL(.MSG) K MSG W !
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFUD 7050 printed Apr 09, 2024@21:09:05 Page 2
PRCFFUD ;WISC/SJG-UTILITY FOR CARRY FORWARD ;7/24/00 23:14
V ;;5.1;IFCAP;**181**;Oct 20, 2000;Build 6
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;
+3 ;PRC*5.1*181 Added calc for regular POs to calc the correct amount
+4 ; between original PO and amended PO
+5 ;
+6 QUIT
+7 ; No top level entry
+8 ;
OBDT() ; Check if obligation processing date is valid for the open quarter
+1 NEW GOFLAG,MOP,STNQTR,PODATE,PRIMARY,SDATE1,SDATE2,SDATE3,SDATE4,SPIECE1,SPIECE2,SPIECE3,SPIECE4,RBQTR,AMDDATE
+2 SET GOFLAG=0
+3 SET MOP=$$NP^PRC0B("^PRC(442,"_+PO_",",0,2)
+4 SET PRIMARY=$$NP^PRC0B("^PRC(442,"_+PO_",",0,12)
+5 SET STNQTR=$$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,9)
+6 ; If obligation is an original entry, use PO date
+7 ; If obligation is an amendment, use amendment date
+8 IF '$DATA(PRCFA("AMEND#"))
SET PODATE=$$NP^PRC0B("^PRC(442,"_+PO_",",1,15)
+9 IF $DATA(PRCFA("AMEND#"))
IF MOP'=21
Begin DoDot:1
+10 ; If amendment is initial document, get info from file 443.6
+11 IF PRCFA("RETRAN")=0
Begin DoDot:2
+12 NEW SUBINFO
SET SUBINFO="443.67^1^"_PRCFA("AMEND#")
+13 KILL PRCTMP(443.67,PRCFA("AMEND#"),1)
+14 DO GENDIQ^PRCFFU7(443.6,PRCFA("PODA"),50,"IEN",SUBINFO)
+15 SET AMDDATE=$GET(PRCTMP(443.67,PRCFA("AMEND#"),1,"I"))
+16 KILL PRCTMP(443.67,PRCFA("AMEND#"),1)
+17 QUIT
End DoDot:2
QUIT
+18 ; If amendment is rebuild, get info from file 442
+19 IF PRCFA("RETRAN")=1
Begin DoDot:2
+20 NEW SUBINFO
SET SUBINFO="442.07^1^"_PRCFA("AMEND#")
+21 KILL PRCTMP(442.07,PRCFA("AMEND#"),1)
+22 DO GENDIQ^PRCFFU7(442,PRCFA("PODA"),50,"IEN",SUBINFO)
+23 SET AMDDATE=$GET(PRCTMP(442.07,PRCFA("AMEND#"),1,"I"))
+24 KILL PRCTMP(442.07,PRCFA("AMEND#"),1)
+25 QUIT
End DoDot:2
QUIT
+26 QUIT
End DoDot:1
SET PODATE=$GET(AMDDATE)
+27 SET SDATE1=$$DATE^PRC0C(PODATE,"I")
SET SDATE2=$$DATE^PRC0C(PRCFA("OBLDATE"),"I")
SET SDATE3=$$DATE^PRC0C(STNQTR,"I")
+28 SET SPIECE1=$PIECE(SDATE1,U,1,2)
SET SPIECE2=$PIECE(SDATE2,U,1,2)
SET SPIECE3=$PIECE(SDATE3,U,1,2)
+29 ; Check if transaction is a 1358
+30 IF MOP=21
Begin DoDot:1
+31 SET RBQTR=$$NP^PRC0B("^PRCS(410,"_PRIMARY_",",0,11)
+32 SET SDATE4=$$DATE^PRC0C(RBQTR,"I")
SET SPIECE4=$PIECE(SDATE4,U,1,2)
+33 IF SPIECE2=SPIECE4
SET GOFLAG=1
QUIT
End DoDot:1
GOTO QUIT
+34 ; Check if transaction has a 2237 request
+35 IF $GET(PRIMARY)=""
Begin DoDot:1
+36 ; allow PO/oblig date from current qtr
+37 IF SPIECE1=SPIECE2
IF SPIECE2=SPIECE3
SET GOFLAG=1
QUIT
+38 ; allow PO/oblig date for fut qtr if PO date qtr same as oblig qtr
+39 IF SPIECE3=SPIECE2
IF SPIECE2]SPIECE1
SET GOFLAG=1
QUIT
+40 ; allow PO/oblig date for fut qtr if oblig qtr later than stn open qtr
+41 IF SPIECE2]SPIECE3
SET GOFLAG=1
QUIT
End DoDot:1
GOTO QUIT
+42 IF $GET(PRIMARY)]""
Begin DoDot:1
+43 ; allow PO/oblig date from current qtr
+44 IF SPIECE1=SPIECE2
IF SPIECE2=SPIECE3
SET GOFLAG=1
QUIT
+45 ; allow PO/oblig date from future qtr
+46 IF SPIECE1=SPIECE2
IF SPIECE2]SPIECE3
SET GOFLAG=1
QUIT
+47 ; allow PO/oblig date from prior qtr if open qtr same as oblig qtr
+48 IF SPIECE2=SPIECE3
IF SPIECE3]SPIECE1
SET GOFLAG=1
QUIT
End DoDot:1
GOTO QUIT
QUIT QUIT GOFLAG
+1 ;
NEW410 ; Create an entry in File 410 for any PO that does not have a request
+1 if $GET(PRCFA("RETRAN"))=1
QUIT
+2 WRITE !
DO EN^DDIOL("...now creating entry in File 410...")
+3 NEW POAMT,P410,NEW410
+4 SET POAMT=+$SELECT($PIECE(PRCFMO,"^",12)="N":$PIECE(PO(0),"^",16),1:$PIECE(PO(0),"^",15))
+5 SET P410=+PRCFA("REF")_U_+$PIECE(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_POAMT_U_$PIECE(PRCFA("REF"),"-",2)_"WR"_U_"ST"_U_+PO
+6 SET $PIECE(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
+7 DO A410^PRC0F(.NEW410,P410)
SET PRCFA("NEW410")=NEW410
+8 QUIT
+9 ;
AMEND ; Create an entry in File 410 for each amendment to a purchase order
+1 ; Case 1 - amendment with no cancelled documents
+2 if $GET(PRCFA("RETRAN"))=1
QUIT
+3 NEW AMDEXT
SET AMDEXT="-"_$GET(PRCFA("AMEND#"))
+4 WRITE !
DO EN^DDIOL("...now creating entry in File 410 for the amendment...")
+5 IF '$DATA(PRCFA("CANCEL"))
Begin DoDot:1
+6 NEW AMDAMT,P410,NEW410
SET AMDAMT=$$AMDAMT()
+7 SET P410=+PRCFA("REF")_U_+$PIECE(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$PIECE(PRCFA("REF"),"-",2)_AMDEXT_U_"ST"_U_+PO
+8 SET $PIECE(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
+9 IF $GET(PRCHAUTH)'=1
IF $PIECE(^PRC(442,PRCHPO,0),U,2)'=25
Begin DoDot:2
+10 ;PRC*5.1*181 Fix for 410 adj between amend $$ and prior PO $$
SET $PIECE(P410,U,6)=$PIECE(^PRC(442,PRCFA("PODA"),0),U,16)-$PIECE(PO(0),U,16)
End DoDot:2
+11 DO A410^PRC0F(.NEW410,P410)
SET PRCFA("NEW410")=NEW410
+12 QUIT
End DoDot:1
QUIT
+13 ; Case 2 - amendment types: vendor change, FCP change, PO number change
+14 IF $DATA(PRCFA("CANCEL"))
IF 'PRCFA("AUTHE")
Begin DoDot:1
+15 ; First update for the old record
+16 NEW AMDAMT,POREF,AMDNO,FCP,OLDFCP
+17 SET AMDAMT=$$AMDAMT1()
+18 IF $GET(PRCFA("PO"))=1
SET POREF=PRCFA("OLDPODA")_U_PRCFA("OLDREF")
+19 IF $GET(PRCFA("PO"))=""
SET POREF=PRCFA("PODA")_U_PRCFA("REF")
+20 IF $GET(PRCFA("FCP"))=1
Begin DoDot:2
+21 ; "AC" cross ref sorts changes by field# (1=FCP) and amendment type (30=FCP edit)
NEW LOOP
+22 SET LOOP=$ORDER(^PRC(442,PRCFA("PODA"),6,PRCFA("AMEND#"),3,"AC",30,1,0))
+23 IF LOOP]""
SET OLDFCP=^PRC(442,PRCFA("PODA"),6,PRCFA("AMEND#"),3,LOOP,1,1,0)
+24 QUIT
End DoDot:2
SET FCP=+OLDFCP
+25 IF $GET(PRCFA("FCP"))=""
SET FCP=+$PIECE(PO(0),U,3)
+26 SET P410=+$PIECE(POREF,U,2)_U_FCP_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$PIECE($PIECE(POREF,U,2),"-",2)_AMDEXT_U_"ST"_U_+POREF
+27 SET $PIECE(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
+28 DO A410^PRC0F(.NEW410,P410)
+29 ; Then update for new record
+30 SET AMDAMT=-AMDAMT
+31 IF $GET(PRCFA("PO"))=1
SET POREF=PRCFA("NEWPODA")_U_PRCFA("NEWREF")
SET AMDEXT=""
+32 IF $GET(PRCFA("PO"))=""
SET POREF=PRCFA("PODA")_U_PRCFA("REF")
+33 SET P410=+$PIECE(POREF,U,2)_U_+$PIECE(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$PIECE($PIECE(POREF,U,2),"-",2)_AMDEXT_U_"ST"_U_+POREF
+34 SET $PIECE(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
+35 DO A410^PRC0F(.NEW410,P410)
+36 QUIT
End DoDot:1
QUIT
+37 ; Case 3 - amendments type - cancel by Authority E
+38 IF $DATA(PRCFA("CANCEL"))
IF PRCFA("AUTHE")
Begin DoDot:1
+39 NEW AMDAMT
SET AMDAMT=$$AMDAMT1()
SET AMDEXT=AMDEXT_"#"
+40 SET P410=+PRCFA("REF")_U_+$PIECE(PO(0),U,3)_U_"A"_U_2_U_PRCFA("OBLDATE")_U_AMDAMT_U_$PIECE(PRCFA("REF"),"-",2)_AMDEXT_U_"ST"_U_+PO
+41 SET $PIECE(P410,U,10,11)=PRC("FYQDT")_U_PRC("BBFY")
+42 DO A410^PRC0F(.NEW410,P410)
SET PRCFA("NEW410")=NEW410
+43 QUIT
End DoDot:1
QUIT
+44 QUIT
PO ; Updating Running Balance Status Field (#449) in File 410 for
+1 ; purchase order
+2 if $GET(PRCFA("RETRAN"))=1
QUIT
+3 if $GET(PRCTMP(442,+PO,.07,"I"))=""
QUIT
+4 IF $GET(PRCTMP(442,+PO,.07,"I"))]""
Begin DoDot:1
+5 WRITE !!,"...updating running balance status fields in 410...WITH 2237"
+6 NEW LOOP
SET LOOP=0
+7 FOR
SET LOOP=$ORDER(^PRC(442,+PO,13,LOOP))
if LOOP=""!(LOOP'>0)
QUIT
IF LOOP>0
DO EDIT410(LOOP,"O")
+8 QUIT
End DoDot:1
QUIT
+9 QUIT
AMD ; Updating Running Balance Status Field (#449) in File 410 for
+1 ; purchase order amendment
+2 if $GET(PRCFA("RETRAN"))=1
QUIT
+3 WRITE !!,"...updating running balance status fields in 410...FOR AMENDMENT"
+4 DO EDIT410(NEW410,"O")
+5 QUIT
+6 ;
EDIT410(TRDAIEN,TRSTAT) ; Edit running balance status and running balance quarter fields in 410
+1 DO ERS410^PRC0G(TRDAIEN_"^"_TRSTAT)
+2 QUIT
+3 ;
+4 ; Message processing
AMDAMT() ; Get dollar amount for AMENDMENT from amendment multiple
+1 NEW SUBINFO,AMDAMT
SET SUBINFO="442.07^2^"_PRCFA("AMEND#")
+2 DO GENDIQ^PRCFFU7(442,PRCFA("PODA"),50,"IEN",SUBINFO)
+3 SET AMDAMT=$GET(PRCTMP(442.07,PRCFA("AMEND#"),2,"E"))
+4 QUIT AMDAMT
AMDAMT1() ; Get dollar amount for AMENDMENT from zero node
+1 NEW AMDAMT
+2 SET AMDAMT=-$SELECT($PIECE(PRCFMO,"^",12)="N":$PIECE(PO(0),"^",16),1:$PIECE(PO(0),"^",15))
+3 QUIT AMDAMT
MSG1 ;
+1 KILL MSG
WRITE !
+2 SET MSG(1)="The Obligation Processing Date is not a valid date for this transaction."
+3 SET MSG(2)="Please enter a date which matches the requests or p.o. quarter."
+4 DO EN^DDIOL(.MSG)
KILL MSG
WRITE !
+5 QUIT
