source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU9.m@ 1093

PRCFFU9 ;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
 ;
 ; set PRCFA("MOMREQ")=1 if the edit needs to be sent to FMS or affects
 ; fiscal logs/files ('MOM')
 ;
 QUIT
 ;
TAG20 ; SHIP TO Edit - not needed by 'MOM'
 S PRCFA("SHIP")="SHIP TO Edit"
 Q
TAG21 ; LINE ITEM Add - change info from Node 22
 I PRCFA("DEL")]"" S PRCFA("MOMREQ")=1
 Q
TAG22 ; LINE ITEM Delete - change info from Node 22
 Q
TAG23 ; LINE ITEM Edit - change info from Node 22
 I PRCFA("DEL")]"" S PRCFA("MOMREQ")=1
 Q
TAG24 ; SOURCE CODE Edit - not needed by 'MOM'
 S PRCFA("SOURCE")="SOURCE CODE Edit"
 Q
TAG25 ; Edit MAIL INVOICE TO - not needed by 'MOM'
 S PRCFA("MAIL")="MAIL INVOICE TO Edit"
 Q
TAG26 ; Edit METHOD OF PAYMENT - not needed by 'MOM
 S PRCFA("MOP")="Edit METHOD OF PAYMENT"
 Q
TAG27 ; ADMINISTRATIVE CERTIFICATION Add - not needed by 'MOM'
 S PRCFA("ADMADD")="ADMINISTRATIVE CERTIFICATION Add"
 Q
TAG28 ; ADMINISTRATIVE CERTIFICATION Delete - not needed by 'MOM'
 S PRCFA("ADMDEL")="ADMINISTRATIVE CERTIFICATION Delete"
 Q
TAG29 ; EST. SHIPPING Edit
 S PRCFA("EST")=1,PRCFA("MOMREQ")=1
 Q
TAG30 ; F.C.P. Edit
 S PRCFA("FCP")="",PRCFA("MOMREQ")=1
 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
 S PRCFA("FCP")=1
 Q
TAG31 ; Change VENDOR"
 S PRCFA("MOMREQ")=1
 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
 S PRCFA("VEND")=1
 Q
TAG32 ; REPLACE P.O. NUMBER
 S PRCFA("MOMREQ")=1
 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
 D GENDIQ^PRCFFU7(442,POIEN,"27;28","IEN","")
 S PRCFA("PODA")=+$G(PRCTMP(442,POIEN,28,"I"))
 S PRCFA("REF")=$G(PRCTMP(442,POIEN,28,"E"))
 S PRCFA("NEWREF")=PRCFA("REF"),PRCFA("NEWPODA")=PRCFA("PODA")
 S PRCFA("PO")=1
 Q
TAG33 ; PROMPT PAYMENT Edit
 S PRCFA("PPT")=1,PRCFA("MOMREQ")=1
 Q
TAG34 ; AUTHORITY Edit - not needed by 'MOM'
 S PRCFA("AUTH")="AUTHORITY Edit"
 Q
TAG35 ; F.O.B. Point Edit
 S PRCFA("FOB")=1,PRCFA("MOMREQ")=1
 Q
TAG36 ; ITEM DISCOUNT Add
 Q
TAG37 ; ITEM DISCOUNT Delete
 Q
TAG38 ; ITEM DISCOUNT Edit
 Q
TAG98 ; DELIVERY DATE/DELIVERY SCHEDULE Change
 S PRCFA("DEL")=1,PRCFA("MOMREQ")=1
 Q
TAG99 ; 'NET AMOUNT' of P.O. before amendment
 Q
TAG0 ; BOC Edit
 S PRCFA("MOMREQ")=1
 D BOCSET,BOCDIQ
 F LOOP2=.01,1,2 S LOOP2=$O(NEW(SUB,ITEM,LOOP2)) D
 .S BOC=NEW(SUB,ITEM,.01,"I")
 .S NEWVAL=NEW(SUB,ITEM,1,"I")
 .S AMT=NEWVAL-OLDVAL D
 ..I AMT>0 S IDFLAG="I"
 ..I AMT<0 S IDFLAG="D"
 .S LIN=NEW(SUB,ITEM,2,"I")
 .Q:(BOC=0)&(LIN=991)
 .S PRCFCHG("BOC",BOC,LIN)=BOC_U_AMT_U_LIN_U_IDFLAG
 S PRCFA("BOC")=1
 Q
TAGE ; Cancellation of PO by Authority 'E'
 S PRCFA("AUTHE")=1
 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
 Q
BOCSET ; Set data values for call to DIQ1 for BOCs
 S FLDS=$P(OLD(LOOP),U,3),ITEM=$P(OLD(LOOP),U,4)
 S TOP=$P(FLDS,":",2),BOT=$P($P(FLDS,":",1),";",1),SUB=$P($P(FLDS,":",1),";",2)
 Q
BOCDIQ ; Call DIQ1 for BOCs
 N DA S DIC=442,DR=TOP,DA=+POIEN,DIQ="NEW(",DIQ(0)="IEN"
 S DR(SUB)=".01;1;2",DA(SUB)=ITEM
 D EN^DIQ1
 Q
DELSCH ; Set data values for cal to DIQ1 for Delivery Schedule
 S FLDS=$P(OLD(LOOP),U,3),DELCHG=$P(OLD(LOOP),U,7)
 S FLD=$P(FLDS,";"),FILE=$P($P(FLDS,":"),";",2)
 Q:FILE'=442.8  Q:FLD'=2
 S PRCFA("DELSCH")=1,PRCFA("MOMREQ")=1
 Q