| [613] | 1 | PRCFFM2M ;WOIFO/SJG/AS-ROUTINE TO PROCESS OBLIGATIONS ;3/8/05
|
|---|
| 2 | V ;;5.1;IFCAP;**81**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | SUPP ; Entry point for FMS Documents for Supply Fund Special Control Point
|
|---|
| 6 | ; Amendments
|
|---|
| 7 | ; Called from PRCHMA
|
|---|
| 8 | S DIC("S")="I +^(0)=PRC(""SITE"")",DIC=442,DIC(0)="NZ",X=PRCHPO
|
|---|
| 9 | D ^DIC K DIC G:+Y<0 EXIT
|
|---|
| 10 | S (XRBLD,FLG)=0,PO(0)=Y(0),PO=Y,PRCFA("PODA")=+Y,PCP=+$P(PO(0),"^",3),$P(PCP,"^",2)=$S($D(^PRC(420,PRC("SITE"),1,+PCP,0)):$P(^(0),"^",12),1:"")
|
|---|
| 11 | S MTOP=$P(^PRC(442,PRCFA("PODA"),0),"^",2)
|
|---|
| 12 | I $P($G(^PRC(443.6,PRCHPO,6,PRCHAM,1)),U,2)="" W !!,"PURCHASE ORDER HAS NOT BEEN PROPERLY SIGNED BY THE PURCHASING AGENT" Q
|
|---|
| 13 | D DT442^PRCFFUD1(PRCHPO,PO(0),443.6,PRCHAM)
|
|---|
| 14 | ;S PRCFA("OBLDATE")=$$EN^PRCFFUD1() D ENSFM^PRCFFMO2
|
|---|
| 15 | S PRCFA("OBLDATE")=$$DTOBL^PRCFFUD1(PRC("RBDT"),PRC("PODT"))
|
|---|
| 16 | S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO) ;D BBFYCHK^PRCFFU19(+PO)
|
|---|
| 17 | D GENDIQ^PRCFFU7(442,+PO,".1;.07;.03;17","IEN","")
|
|---|
| 18 | S IDFLAG="I",PRCFA("AMEND#")=PRCHAM
|
|---|
| 19 | N PARAM S PARAM=+PCP_"^"_PRC("FY")_"^"_PRCFA("BBFY")
|
|---|
| 20 | S PRCFMO=$$ACC^PRC0C(PRC("SITE"),PARAM)
|
|---|
| 21 | S PRCFA("MOD")="M^1^Modification Entry"
|
|---|
| 22 | S PRCFA("DLVDATE")=+$P(^PRC(442,PRCFA("PODA"),0),"^",10)
|
|---|
| 23 | S PRCFA("IDES")="Purchase Order Amendment Obligation"
|
|---|
| 24 | S PRCFA("REF")=$P(PO(0),U),PRCFA("SYS")="FMS"
|
|---|
| 25 | S PRCFA("SFC")=$P(PO(0),U,19),PRCFA("MP")=$P(PO(0),U,2)
|
|---|
| 26 | S PRCFA("TT")=$S(PRCFA("MP")=2:"SO",PRCFA("MP")=1:"MO",PRCFA("MP")=8:"MO",1:"MO")
|
|---|
| 27 | TRANS ; Transfer amendment entry from work file to Purchase Order file
|
|---|
| 28 | W !!,"...copying amendment information back to Purchase Order file...",! D WAIT^DICD
|
|---|
| 29 | D DT442^PRCFFUD1(PRCFA("PODA"),PO(0),442,"")
|
|---|
| 30 | S PRCOAMT=+^PRC(442,PRCFA("PODA"),0),$P(PRCOAMT,"^",2)=+$P(^(0),"^",3),$P(PRCOAMT,"^",3)=PRC("FYQDT"),$P(PRCOAMT,"^",5)=-$P(^(0),"^",$P(PRCFMO,"^",12)="N"+15)
|
|---|
| 31 | S ERFLAG=""
|
|---|
| 32 | D CHECK^PRCHAMYA(PRCFA("PODA"),PRCFA("AMEND#"),.ERFLAG)
|
|---|
| 33 | I ERFLAG W !!,"...ERROR IN COPYING AMENDMENT INFORMATION BACK TO PURCHASE ORDER FILE..." D MSG G EXIT
|
|---|
| 34 | D DT442^PRCFFUD1(PRCFA("PODA"),PO(0),442,PRCFA("AMEND#"))
|
|---|
| 35 | ; transmit amendment from IFCAP to DynaMed **81**
|
|---|
| 36 | D:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1 ENT^PRCVPOU(PRCFA("PODA"),PRCFA("AMEND#"))
|
|---|
| 37 | S PRCFA("OLDPODA")=PRCFA("PODA"),PRCFA("OLDREF")=PRCFA("REF")
|
|---|
| 38 | N PARAM S PARAM="^"_PRC("SITE")_"^"_+PCP_"^"_PRC("FY")_"^"_PRCFA("BBFY")
|
|---|
| 39 | D DOCREQ^PRC0C(PARAM,"SPE","PRCFMO")
|
|---|
| 40 | S (PRCFA("G/N"),PRCFMO("G/N"))=$P(PRCFMO,U,12)
|
|---|
| 41 | D LIST^PRCFFU7(PRCFA("PODA"),PRCFA("AMEND#"))
|
|---|
| 42 | I MTOP'=25,$P($G(^PRC(442,PRCFA("PODA"),0)),U,19)=2,$G(PRCFA("AUTHE"))=1 D AMEND^PRCFFUD,FCP^PRCFFU11 G EXIT
|
|---|
| 43 | I MTOP'=25,'PRCFA("MOMREQ") D MSG^PRCFFU8 G EXIT
|
|---|
| 44 | D AMEND^PRCFFUD
|
|---|
| 45 | I MTOP'=25 D STACK^PRCFFM1M
|
|---|
| 46 | D EXIT QUIT
|
|---|
| 47 | MSG W ! S X="No further processing is being taken on this obligation.*" D MSG^PRCFQ
|
|---|
| 48 | Q
|
|---|
| 49 | EXIT K %,AMT,C1,C,D0,DA,DI,DIC,DEL,E,I,J,N1,N2,POP,PO,PODA,PRCFA,PRCFQ,MTOP
|
|---|
| 50 | K PTYPE,T,T1,TIME,TRDA,Y,Z,Z5,ZX
|
|---|
| 51 | K PODATE,P,MO,GECSFMS
|
|---|
| 52 | Q
|
|---|
