PRCFFUB ;WISC/SJG-OBLIGATION ERROR PROCESSING REBUILD ;7/24/00 23:12
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Routine to handle special processing for the rebuild/transmit for
; MO/SO cancellation documents.
;
; Subroutine EN sets the value of XRBLD =
; 1 if the selected transaction to be rebuilt is an MO.X, SO.X or AR.X
; 2 if the selected transaction is an MO.E, SO.E, AR.E associated with
; an amendment that generated cancellation transactions
EN ;
N XFLAG
Q:MODDOC="" ; no batch number, this is not an amendment
S XFLAG=$$GETTXNS^PRCFFERT(PO,PRCFA("AMEND#"),PRCFA("MP"))
I $P(XFLAG,"^",5)'=1,$P(XFLAG,"^",1)="" QUIT ; this amendment has no cancels associated with it (if SO.E exists, it was created via an amendment)
S DESC=$G(GECSDATA(2100.1,GECSDATA,4,"E"))
Q:DESC=""
I DESC["Decrease"!(DESC["Cancellation") D
. S XRBLD=1
. K MSG W !
. S MSG(1)="You are attempting to retransmit an FMS Document with a document action of 'X'."
. S MSG(2)="An FMS document with a document action of 'X' will decrease this obligation"
. S MSG(3)="to $0.00 or cancel this obligation from FMS.",MSG(3.5)=" "
. S MSG(4)="Please use extreme caution with these documents!"
. D EN^DDIOL(.MSG) W ! K MSG
I DESC["Amendment" D
. S XRBLD=2
. I $P(XFLAG,"^",5)'=1 D Q
. . K MSG W !
. . S MSG(1)="This document was created from a 'Replace PO Number' amendment. Please"
. . S MSG(2)="verify the 'X' action documents for "_$P(^PRC(442,$P(^PRC(442,+PO,23),"^",3),0),"^",1)_" have been accepted."
. . I $P(PRCFA("GECS"),"^")="AR" S MSG(3)="If the SO original was not accepted, this AR will reject."
. . D EN^DDIOL(.MSG) W ! K MSG
. K MSG W !
. S MSG(1)="Before proceeding with this rebuild, please ensure that the previous"
. S MSG(2)="'X' action documents have been accepted in FMS. Otherwise, this document"
. S MSG(3)="will reject because an obligation already exists under this PAT number."
. I $P(PRCFA("GECS"),"^")="AR" D
. . S MSG(2)="'X' actions and SO original were accepted in FMS. Otherwise, this AR"
. . S MSG(3)="may reject or not accrue the correct version of the intended document."
. D EN^DDIOL(.MSG) W ! K MSG
QUIT
;
GO ; rebuild the selected transaction now
S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
S TYPE=PRCFA("TT")
;
GO0 I XRBLD=1 D
. S (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry"
. S FMSMOD=$P(PRCFA("MOD"),U)
. S TAG=$E(DESC,1)
. I TAG="D" S DESC="Decrease Obligation Amount of "_TYPE
. I TAG="C" S DESC="Cancellation of "_TYPE
. S DESC=DESC_" Obligation Document Rebuild/Transmit"
;
I XRBLD=2 D
. S PRCFA("MOD")="E^0^Original Entry (Amended)"
. S PRCFA("CANCEL")="X^2^Cancellation Entry"
. S TAG="A"
. S DESC="Purchase Order Amendment Rebuild/Transmit"
;
D REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
S GECSFMS("DA")=GECSDATA
I TAG="D" D DEC^PRCFFU8 ; (decrease)
I TAG="C" D CANC^PRCFFU8 ; (cancel)
I TAG="A" D ^PRCFFM1M ; (original - amended)
;
GOUT KILL DESC,FMSSEC
QUIT
;
LOOP ; Check for any 'X' docs -- this subroutine deleted by patch PRC*5*179
; routine could incorrectly label future amendments as cancel associated
;N LOOP,N0,FMSDOC S LOOP=0
;F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0 D
;.S N0=^PRC(442,+PO,10,LOOP,0),FMSDOC=$P(N0,".",1,2)
;.I FMSDOC["X" S XFLAG=1
;.Q
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFUB 3413 printed Oct 16, 2024@18:04:45 Page 2
PRCFFUB ;WISC/SJG-OBLIGATION ERROR PROCESSING REBUILD ;7/24/00 23:12
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ; Routine to handle special processing for the rebuild/transmit for
+4 ; MO/SO cancellation documents.
+5 ;
+6 ; Subroutine EN sets the value of XRBLD =
+7 ; 1 if the selected transaction to be rebuilt is an MO.X, SO.X or AR.X
+8 ; 2 if the selected transaction is an MO.E, SO.E, AR.E associated with
+9 ; an amendment that generated cancellation transactions
EN ;
+1 NEW XFLAG
+2 ; no batch number, this is not an amendment
if MODDOC=""
QUIT
+3 SET XFLAG=$$GETTXNS^PRCFFERT(PO,PRCFA("AMEND#"),PRCFA("MP"))
+4 ; this amendment has no cancels associated with it (if SO.E exists, it was created via an amendment)
IF $PIECE(XFLAG,"^",5)'=1
IF $PIECE(XFLAG,"^",1)=""
QUIT
+5 SET DESC=$GET(GECSDATA(2100.1,GECSDATA,4,"E"))
+6 if DESC=""
QUIT
+7 IF DESC["Decrease"!(DESC["Cancellation")
Begin DoDot:1
+8 SET XRBLD=1
+9 KILL MSG
WRITE !
+10 SET MSG(1)="You are attempting to retransmit an FMS Document with a document action of 'X'."
+11 SET MSG(2)="An FMS document with a document action of 'X' will decrease this obligation"
+12 SET MSG(3)="to $0.00 or cancel this obligation from FMS."
SET MSG(3.5)=" "
+13 SET MSG(4)="Please use extreme caution with these documents!"
+14 DO EN^DDIOL(.MSG)
WRITE !
KILL MSG
End DoDot:1
+15 IF DESC["Amendment"
Begin DoDot:1
+16 SET XRBLD=2
+17 IF $PIECE(XFLAG,"^",5)'=1
Begin DoDot:2
+18 KILL MSG
WRITE !
+19 SET MSG(1)="This document was created from a 'Replace PO Number' amendment. Please"
+20 SET MSG(2)="verify the 'X' action documents for "_$PIECE(^PRC(442,$PIECE(^PRC(442,+PO,23),"^",3),0),"^",1)_" have been accepted."
+21 IF $PIECE(PRCFA("GECS"),"^")="AR"
SET MSG(3)="If the SO original was not accepted, this AR will reject."
+22 DO EN^DDIOL(.MSG)
WRITE !
KILL MSG
End DoDot:2
QUIT
+23 KILL MSG
WRITE !
+24 SET MSG(1)="Before proceeding with this rebuild, please ensure that the previous"
+25 SET MSG(2)="'X' action documents have been accepted in FMS. Otherwise, this document"
+26 SET MSG(3)="will reject because an obligation already exists under this PAT number."
+27 IF $PIECE(PRCFA("GECS"),"^")="AR"
Begin DoDot:2
+28 SET MSG(2)="'X' actions and SO original were accepted in FMS. Otherwise, this AR"
+29 SET MSG(3)="may reject or not accrue the correct version of the intended document."
End DoDot:2
+30 DO EN^DDIOL(.MSG)
WRITE !
KILL MSG
End DoDot:1
+31 QUIT
+32 ;
GO ; rebuild the selected transaction now
+1 SET FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
+2 SET TYPE=PRCFA("TT")
+3 ;
GO0 IF XRBLD=1
Begin DoDot:1
+1 SET (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry"
+2 SET FMSMOD=$PIECE(PRCFA("MOD"),U)
+3 SET TAG=$EXTRACT(DESC,1)
+4 IF TAG="D"
SET DESC="Decrease Obligation Amount of "_TYPE
+5 IF TAG="C"
SET DESC="Cancellation of "_TYPE
+6 SET DESC=DESC_" Obligation Document Rebuild/Transmit"
End DoDot:1
+7 ;
+8 IF XRBLD=2
Begin DoDot:1
+9 SET PRCFA("MOD")="E^0^Original Entry (Amended)"
+10 SET PRCFA("CANCEL")="X^2^Cancellation Entry"
+11 SET TAG="A"
+12 SET DESC="Purchase Order Amendment Rebuild/Transmit"
End DoDot:1
+13 ;
+14 DO REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
+15 SET GECSFMS("DA")=GECSDATA
+16 ; (decrease)
IF TAG="D"
DO DEC^PRCFFU8
+17 ; (cancel)
IF TAG="C"
DO CANC^PRCFFU8
+18 ; (original - amended)
IF TAG="A"
DO ^PRCFFM1M
+19 ;
GOUT KILL DESC,FMSSEC
+1 QUIT
+2 ;
LOOP ; Check for any 'X' docs -- this subroutine deleted by patch PRC*5*179
+1 ; routine could incorrectly label future amendments as cancel associated
+2 ;N LOOP,N0,FMSDOC S LOOP=0
+3 ;F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0 D
+4 ;.S N0=^PRC(442,+PO,10,LOOP,0),FMSDOC=$P(N0,".",1,2)
+5 ;.I FMSDOC["X" S XFLAG=1
+6 ;.Q
+7 ;Q
