113 lines
3.1 KiB
Mathematica
113 lines
3.1 KiB
Mathematica
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
|