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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFU9 3330 printed Dec 13, 2024@02:03:54 Page 2
PRCFFU9 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:11
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ; No Top Level Entry
+4 ;
+5 ; set PRCFA("MOMREQ")=1 if the edit needs to be sent to FMS or affects
+6 ; fiscal logs/files ('MOM')
+7 ;
+8 QUIT
+9 ;
TAG20 ; SHIP TO Edit - not needed by 'MOM'
+1 SET PRCFA("SHIP")="SHIP TO Edit"
+2 QUIT
TAG21 ; LINE ITEM Add - change info from Node 22
+1 IF PRCFA("DEL")]""
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG22 ; LINE ITEM Delete - change info from Node 22
+1 QUIT
TAG23 ; LINE ITEM Edit - change info from Node 22
+1 IF PRCFA("DEL")]""
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG24 ; SOURCE CODE Edit - not needed by 'MOM'
+1 SET PRCFA("SOURCE")="SOURCE CODE Edit"
+2 QUIT
TAG25 ; Edit MAIL INVOICE TO - not needed by 'MOM'
+1 SET PRCFA("MAIL")="MAIL INVOICE TO Edit"
+2 QUIT
TAG26 ; Edit METHOD OF PAYMENT - not needed by 'MOM
+1 SET PRCFA("MOP")="Edit METHOD OF PAYMENT"
+2 QUIT
TAG27 ; ADMINISTRATIVE CERTIFICATION Add - not needed by 'MOM'
+1 SET PRCFA("ADMADD")="ADMINISTRATIVE CERTIFICATION Add"
+2 QUIT
TAG28 ; ADMINISTRATIVE CERTIFICATION Delete - not needed by 'MOM'
+1 SET PRCFA("ADMDEL")="ADMINISTRATIVE CERTIFICATION Delete"
+2 QUIT
TAG29 ; EST. SHIPPING Edit
+1 SET PRCFA("EST")=1
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG30 ; F.C.P. Edit
+1 SET PRCFA("FCP")=""
SET PRCFA("MOMREQ")=1
+2 DO CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
+3 SET PRCFA("FCP")=1
+4 QUIT
TAG31 ; Change VENDOR"
+1 SET PRCFA("MOMREQ")=1
+2 DO CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
+3 SET PRCFA("VEND")=1
+4 QUIT
TAG32 ; REPLACE P.O. NUMBER
+1 SET PRCFA("MOMREQ")=1
+2 DO CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
+3 DO GENDIQ^PRCFFU7(442,POIEN,"27;28","IEN","")
+4 SET PRCFA("PODA")=+$GET(PRCTMP(442,POIEN,28,"I"))
+5 SET PRCFA("REF")=$GET(PRCTMP(442,POIEN,28,"E"))
+6 SET PRCFA("NEWREF")=PRCFA("REF")
SET PRCFA("NEWPODA")=PRCFA("PODA")
+7 SET PRCFA("PO")=1
+8 QUIT
TAG33 ; PROMPT PAYMENT Edit
+1 SET PRCFA("PPT")=1
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG34 ; AUTHORITY Edit - not needed by 'MOM'
+1 SET PRCFA("AUTH")="AUTHORITY Edit"
+2 QUIT
TAG35 ; F.O.B. Point Edit
+1 SET PRCFA("FOB")=1
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG36 ; ITEM DISCOUNT Add
+1 QUIT
TAG37 ; ITEM DISCOUNT Delete
+1 QUIT
TAG38 ; ITEM DISCOUNT Edit
+1 QUIT
TAG98 ; DELIVERY DATE/DELIVERY SCHEDULE Change
+1 SET PRCFA("DEL")=1
SET PRCFA("MOMREQ")=1
+2 QUIT
TAG99 ; 'NET AMOUNT' of P.O. before amendment
+1 QUIT
TAG0 ; BOC Edit
+1 SET PRCFA("MOMREQ")=1
+2 DO BOCSET
DO BOCDIQ
+3 FOR LOOP2=.01,1,2
SET LOOP2=$ORDER(NEW(SUB,ITEM,LOOP2))
Begin DoDot:1
+4 SET BOC=NEW(SUB,ITEM,.01,"I")
+5 SET NEWVAL=NEW(SUB,ITEM,1,"I")
+6 SET AMT=NEWVAL-OLDVAL
Begin DoDot:2
+7 IF AMT>0
SET IDFLAG="I"
+8 IF AMT<0
SET IDFLAG="D"
End DoDot:2
+9 SET LIN=NEW(SUB,ITEM,2,"I")
+10 if (BOC=0)&(LIN=991)
QUIT
+11 SET PRCFCHG("BOC",BOC,LIN)=BOC_U_AMT_U_LIN_U_IDFLAG
End DoDot:1
+12 SET PRCFA("BOC")=1
+13 QUIT
TAGE ; Cancellation of PO by Authority 'E'
+1 SET PRCFA("AUTHE")=1
+2 DO CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
+3 QUIT
BOCSET ; Set data values for call to DIQ1 for BOCs
+1 SET FLDS=$PIECE(OLD(LOOP),U,3)
SET ITEM=$PIECE(OLD(LOOP),U,4)
+2 SET TOP=$PIECE(FLDS,":",2)
SET BOT=$PIECE($PIECE(FLDS,":",1),";",1)
SET SUB=$PIECE($PIECE(FLDS,":",1),";",2)
+3 QUIT
BOCDIQ ; Call DIQ1 for BOCs
+1 NEW DA
SET DIC=442
SET DR=TOP
SET DA=+POIEN
SET DIQ="NEW("
SET DIQ(0)="IEN"
+2 SET DR(SUB)=".01;1;2"
SET DA(SUB)=ITEM
+3 DO EN^DIQ1
+4 QUIT
DELSCH ; Set data values for cal to DIQ1 for Delivery Schedule
+1 SET FLDS=$PIECE(OLD(LOOP),U,3)
SET DELCHG=$PIECE(OLD(LOOP),U,7)
+2 SET FLD=$PIECE(FLDS,";")
SET FILE=$PIECE($PIECE(FLDS,":"),";",2)
+3 if FILE'=442.8
QUIT
if FLD'=2
QUIT
+4 SET PRCFA("DELSCH")=1
SET PRCFA("MOMREQ")=1
+5 QUIT
