80 lines
3.2 KiB
Mathematica
80 lines
3.2 KiB
Mathematica
PRCFFU8 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:11
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; 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
|
|
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)
|
|
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)
|
|
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
|
|
K PRCTMP
|
|
QUIT SEG
|