PRCFFU9.m

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 ---PRCFFU9   3330     printed  Mar 13, 2025@21:08:42                                                                                                                                                                                                     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