PRCFFU8 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;5/17/09 23:39
;;5.1;IFCAP;**130,196**;Oct 20, 2000;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
;PRC*5.1*196 Send order obligation date to GECS for creation
; of the SO document CTL segment with correct date for
; Cancel doc and Decrease Adj doc or when
; amending a vendor.
;
; No Top Level Entry
QUIT
MSG ;
W !!,"This Purchase Order Amendment will not require a Modification "
W:PRCFA("TT")="MO" !,"Miscellaneous Order (MO) "
W:PRCFA("TT")="SO" !,"Service Order (SO) "
W "Document for the following reason(s):"
W !!,"The Amendment consisted of: "
I $D(PRCFA("SHIP")),PRCFA("SHIP")]"" W ?30,PRCFA("SHIP"),!
I $D(PRCFA("SOURCE")),PRCFA("SOURCE")]"" W ?30,PRCFA("SOURCE"),!
I $D(PRCFA("MAIL")),PRCFA("MAIL")]"" W ?30,PRCFA("MAIL"),!
I $D(PRCFA("ADMADD")),PRCFA("ADMADD")]"" W ?30,PRCFA("ADMADD"),!
I $D(PRCFA("ADMDEL")),PRCFA("ADMDEL")]"" W ?30,PRCFA("ADMDEL"),!
I $D(PRCFA("AUTH")),PRCFA("AUTH")]"" W ?30,PRCFA("AUTH"),!
I $D(PRCFA("ZERO")),PRCFA("ZERO")]"" W ?30,PRCFA("ZERO"),! H 3
I $D(PRCFA("WASH")),PRCFA("WASH")]"" W ?30,PRCFA("WASH"),! H 3
W !!,"No Modification FMS Document has been transmitted!!" H 3
QUIT
;
CANCEL(REF,TYPE) ; Cancel FMS Obligation Documents
; REF - PAT Reference Number
; TYPE - FMS Transaction Type
; DATA - MO2 Segment
N DATA,FMSCOMDT ;PRC*5.1*196
S FMSCOMDT=PRCFA("OBLDATE") ;PRC*5.1*196
S (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry"
S FMSMOD=$P(PRCFA("MOD"),U)
I PRCFA("TT")="AR",$E(REF,11,12)'=12 S REF=$E(REF,1,10)_12
S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
I TYPE="AR" D CANC S TYPE="SO",REF=$E(REF,1,10)
D:$G(MTOPDA)="" DEC,CANC Q
DEC ;
Q:XRBLD=2 ; exit if rebuilding the 'E' (amended original) transaction
W !!,"...now generating the FMS Decrease "_TYPE_" Obligation Document..."
S FMSDES="Decrease Obligation Amount of "_TYPE_" Obligation Document"
I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES,FMSCOMDT) ;PRC*5.1*196
S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
D GECS
S PRCFA("PODA")=PRCFA("OLDPODA")
I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
Q
CANC ;
Q:XRBLD=2
W !!,"...now generating the FMS "_TYPE_" Cancellation Document..."
S FMSDES="Cancellation of "_TYPE_" Obligation Document"
I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES,FMSCOMDT) ;PRC*5.1*196
S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
D GECS
S PRCFA("PODA")=PRCFA("OLDPODA")
I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
Q
;
GECS ; Common GECS processing for 'X' documents
D SETCS^GECSSTAA(GECSFMS("DA"),DATA)
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
N P2 S P2=+PO_"/"_PRCFA("AMEND#"),$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
Q
SEG2(TYPE,IEN,SEG) ; Create MO2 segment for cancellation document
; IEN - Internal Entry Number of Purchase Order
; TYPE - FMS Document Type
; SEG - Return value for MO2 segment
D GENDIQ^PRCFFU7(442,IEN,.1,"I","")
S FMSPODAT=$G(PRCFA("OBLDATE"))
I FMSPODAT="" D NOW^%DTC S FMSPODAT=X
D DATE^PRCFFU2(FMSPODAT,.A,.B,.C)
S FMSPODAT=FMSYR_"^"_FMSMO_"^"_FMSDAY
I $P(TYPE,"^",2)="AR" S SEG="RC2",$P(SEG,U,7)=$P(TYPE,"^",1)_"^~"
E S SEG="MO2",$P(SEG,U,10)=$P(TYPE,"^",1)_"^~"
S $P(SEG,"^",2,4)=FMSPODAT
I $P(TYPE,"^",2)="SO",PRCFA("MP")=2 S $P(SEG,U,11)="C"
S:$P(SEG,U,$L(SEG,U))'="~" SEG=SEG_"^~"
K PRCTMP
QUIT SEG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFU8 3795 printed Apr 09, 2024@21:02:19 Page 2
PRCFFU8 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;5/17/09 23:39
+1 ;;5.1;IFCAP;**130,196**;Oct 20, 2000;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;PRC*5.1*196 Send order obligation date to GECS for creation
+5 ; of the SO document CTL segment with correct date for
+6 ; Cancel doc and Decrease Adj doc or when
+7 ; amending a vendor.
+8 ;
+9 ; No Top Level Entry
+10 QUIT
MSG ;
+1 WRITE !!,"This Purchase Order Amendment will not require a Modification "
+2 if PRCFA("TT")="MO"
WRITE !,"Miscellaneous Order (MO) "
+3 if PRCFA("TT")="SO"
WRITE !,"Service Order (SO) "
+4 WRITE "Document for the following reason(s):"
+5 WRITE !!,"The Amendment consisted of: "
+6 IF $DATA(PRCFA("SHIP"))
IF PRCFA("SHIP")]""
WRITE ?30,PRCFA("SHIP"),!
+7 IF $DATA(PRCFA("SOURCE"))
IF PRCFA("SOURCE")]""
WRITE ?30,PRCFA("SOURCE"),!
+8 IF $DATA(PRCFA("MAIL"))
IF PRCFA("MAIL")]""
WRITE ?30,PRCFA("MAIL"),!
+9 IF $DATA(PRCFA("ADMADD"))
IF PRCFA("ADMADD")]""
WRITE ?30,PRCFA("ADMADD"),!
+10 IF $DATA(PRCFA("ADMDEL"))
IF PRCFA("ADMDEL")]""
WRITE ?30,PRCFA("ADMDEL"),!
+11 IF $DATA(PRCFA("AUTH"))
IF PRCFA("AUTH")]""
WRITE ?30,PRCFA("AUTH"),!
+12 IF $DATA(PRCFA("ZERO"))
IF PRCFA("ZERO")]""
WRITE ?30,PRCFA("ZERO"),!
HANG 3
+13 IF $DATA(PRCFA("WASH"))
IF PRCFA("WASH")]""
WRITE ?30,PRCFA("WASH"),!
HANG 3
+14 WRITE !!,"No Modification FMS Document has been transmitted!!"
HANG 3
+15 QUIT
+16 ;
CANCEL(REF,TYPE) ; Cancel FMS Obligation Documents
+1 ; REF - PAT Reference Number
+2 ; TYPE - FMS Transaction Type
+3 ; DATA - MO2 Segment
+4 ;PRC*5.1*196
NEW DATA,FMSCOMDT
+5 ;PRC*5.1*196
SET FMSCOMDT=PRCFA("OBLDATE")
+6 SET (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry"
+7 SET FMSMOD=$PIECE(PRCFA("MOD"),U)
+8 IF PRCFA("TT")="AR"
IF $EXTRACT(REF,11,12)'=12
SET REF=$EXTRACT(REF,1,10)_12
+9 SET FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
+10 IF TYPE="AR"
DO CANC
SET TYPE="SO"
SET REF=$EXTRACT(REF,1,10)
+11 if $GET(MTOPDA)=""
DO DEC
DO CANC
QUIT
DEC ;
+1 ; exit if rebuilding the 'E' (amended original) transaction
if XRBLD=2
QUIT
+2 WRITE !!,"...now generating the FMS Decrease "_TYPE_" Obligation Document..."
+3 SET FMSDES="Decrease Obligation Amount of "_TYPE_" Obligation Document"
+4 ;PRC*5.1*196
IF XRBLD=0
DO CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES,FMSCOMDT)
+5 SET DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
+6 DO GECS
+7 SET PRCFA("PODA")=PRCFA("OLDPODA")
+8 IF '$DATA(POESIG)
IF $DATA(PRCFA("PODA"))
IF +PRCFA("PODA")>0
SET POESIG=1
+9 NEW FMSDOCT
SET FMSDOCT=$PIECE(PRCFA("REF"),"-",2)
+10 DO EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
+11 QUIT
CANC ;
+1 if XRBLD=2
QUIT
+2 WRITE !!,"...now generating the FMS "_TYPE_" Cancellation Document..."
+3 SET FMSDES="Cancellation of "_TYPE_" Obligation Document"
+4 ;PRC*5.1*196
IF XRBLD=0
DO CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES,FMSCOMDT)
+5 SET DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
+6 DO GECS
+7 SET PRCFA("PODA")=PRCFA("OLDPODA")
+8 IF '$DATA(POESIG)
IF $DATA(PRCFA("PODA"))
IF +PRCFA("PODA")>0
SET POESIG=1
+9 NEW FMSDOCT
SET FMSDOCT=$PIECE(PRCFA("REF"),"-",2)
+10 DO EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
+11 QUIT
+12 ;
GECS ; Common GECS processing for 'X' documents
+1 DO SETCS^GECSSTAA(GECSFMS("DA"),DATA)
+2 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
+3 NEW P2
SET P2=+PO_"/"_PRCFA("AMEND#")
SET $PIECE(P2,"/",5)=$PIECE($GET(PRCFA("ACCPD")),U)
SET $PIECE(P2,"/",6)=PRCFA("OBLDATE")
+4 DO SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
+5 QUIT
SEG2(TYPE,IEN,SEG) ; Create MO2 segment for cancellation document
+1 ; IEN - Internal Entry Number of Purchase Order
+2 ; TYPE - FMS Document Type
+3 ; SEG - Return value for MO2 segment
+4 DO GENDIQ^PRCFFU7(442,IEN,.1,"I","")
+5 SET FMSPODAT=$GET(PRCFA("OBLDATE"))
+6 IF FMSPODAT=""
DO NOW^%DTC
SET FMSPODAT=X
+7 DO DATE^PRCFFU2(FMSPODAT,.A,.B,.C)
+8 SET FMSPODAT=FMSYR_"^"_FMSMO_"^"_FMSDAY
+9 IF $PIECE(TYPE,"^",2)="AR"
SET SEG="RC2"
SET $PIECE(SEG,U,7)=$PIECE(TYPE,"^",1)_"^~"
+10 IF '$TEST
SET SEG="MO2"
SET $PIECE(SEG,U,10)=$PIECE(TYPE,"^",1)_"^~"
+11 SET $PIECE(SEG,"^",2,4)=FMSPODAT
+12 IF $PIECE(TYPE,"^",2)="SO"
IF PRCFA("MP")=2
SET $PIECE(SEG,U,11)="C"
+13 if $PIECE(SEG,U,$LENGTH(SEG,U))'="~"
SET SEG=SEG_"^~"
+14 KILL PRCTMP
+15 QUIT SEG
