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

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