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

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRCFFU9 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:11
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; No Top Level Entry
6 ;
7 ; set PRCFA("MOMREQ")=1 if the edit needs to be sent to FMS or affects
8 ; fiscal logs/files ('MOM')
9 ;
10 QUIT
11 ;
12TAG20 ; SHIP TO Edit - not needed by 'MOM'
13 S PRCFA("SHIP")="SHIP TO Edit"
14 Q
15TAG21 ; LINE ITEM Add - change info from Node 22
16 I PRCFA("DEL")]"" S PRCFA("MOMREQ")=1
17 Q
18TAG22 ; LINE ITEM Delete - change info from Node 22
19 Q
20TAG23 ; LINE ITEM Edit - change info from Node 22
21 I PRCFA("DEL")]"" S PRCFA("MOMREQ")=1
22 Q
23TAG24 ; SOURCE CODE Edit - not needed by 'MOM'
24 S PRCFA("SOURCE")="SOURCE CODE Edit"
25 Q
26TAG25 ; Edit MAIL INVOICE TO - not needed by 'MOM'
27 S PRCFA("MAIL")="MAIL INVOICE TO Edit"
28 Q
29TAG26 ; Edit METHOD OF PAYMENT - not needed by 'MOM
30 S PRCFA("MOP")="Edit METHOD OF PAYMENT"
31 Q
32TAG27 ; ADMINISTRATIVE CERTIFICATION Add - not needed by 'MOM'
33 S PRCFA("ADMADD")="ADMINISTRATIVE CERTIFICATION Add"
34 Q
35TAG28 ; ADMINISTRATIVE CERTIFICATION Delete - not needed by 'MOM'
36 S PRCFA("ADMDEL")="ADMINISTRATIVE CERTIFICATION Delete"
37 Q
38TAG29 ; EST. SHIPPING Edit
39 S PRCFA("EST")=1,PRCFA("MOMREQ")=1
40 Q
41TAG30 ; F.C.P. Edit
42 S PRCFA("FCP")="",PRCFA("MOMREQ")=1
43 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
44 S PRCFA("FCP")=1
45 Q
46TAG31 ; Change VENDOR"
47 S PRCFA("MOMREQ")=1
48 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
49 S PRCFA("VEND")=1
50 Q
51TAG32 ; REPLACE P.O. NUMBER
52 S PRCFA("MOMREQ")=1
53 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
54 D GENDIQ^PRCFFU7(442,POIEN,"27;28","IEN","")
55 S PRCFA("PODA")=+$G(PRCTMP(442,POIEN,28,"I"))
56 S PRCFA("REF")=$G(PRCTMP(442,POIEN,28,"E"))
57 S PRCFA("NEWREF")=PRCFA("REF"),PRCFA("NEWPODA")=PRCFA("PODA")
58 S PRCFA("PO")=1
59 Q
60TAG33 ; PROMPT PAYMENT Edit
61 S PRCFA("PPT")=1,PRCFA("MOMREQ")=1
62 Q
63TAG34 ; AUTHORITY Edit - not needed by 'MOM'
64 S PRCFA("AUTH")="AUTHORITY Edit"
65 Q
66TAG35 ; F.O.B. Point Edit
67 S PRCFA("FOB")=1,PRCFA("MOMREQ")=1
68 Q
69TAG36 ; ITEM DISCOUNT Add
70 Q
71TAG37 ; ITEM DISCOUNT Delete
72 Q
73TAG38 ; ITEM DISCOUNT Edit
74 Q
75TAG98 ; DELIVERY DATE/DELIVERY SCHEDULE Change
76 S PRCFA("DEL")=1,PRCFA("MOMREQ")=1
77 Q
78TAG99 ; 'NET AMOUNT' of P.O. before amendment
79 Q
80TAG0 ; BOC Edit
81 S PRCFA("MOMREQ")=1
82 D BOCSET,BOCDIQ
83 F LOOP2=.01,1,2 S LOOP2=$O(NEW(SUB,ITEM,LOOP2)) D
84 .S BOC=NEW(SUB,ITEM,.01,"I")
85 .S NEWVAL=NEW(SUB,ITEM,1,"I")
86 .S AMT=NEWVAL-OLDVAL D
87 ..I AMT>0 S IDFLAG="I"
88 ..I AMT<0 S IDFLAG="D"
89 .S LIN=NEW(SUB,ITEM,2,"I")
90 .Q:(BOC=0)&(LIN=991)
91 .S PRCFCHG("BOC",BOC,LIN)=BOC_U_AMT_U_LIN_U_IDFLAG
92 S PRCFA("BOC")=1
93 Q
94TAGE ; Cancellation of PO by Authority 'E'
95 S PRCFA("AUTHE")=1
96 D CANCEL^PRCFFU8(PRCFA("REF"),PRCFA("TT"))
97 Q
98BOCSET ; Set data values for call to DIQ1 for BOCs
99 S FLDS=$P(OLD(LOOP),U,3),ITEM=$P(OLD(LOOP),U,4)
100 S TOP=$P(FLDS,":",2),BOT=$P($P(FLDS,":",1),";",1),SUB=$P($P(FLDS,":",1),";",2)
101 Q
102BOCDIQ ; Call DIQ1 for BOCs
103 N DA S DIC=442,DR=TOP,DA=+POIEN,DIQ="NEW(",DIQ(0)="IEN"
104 S DR(SUB)=".01;1;2",DA(SUB)=ITEM
105 D EN^DIQ1
106 Q
107DELSCH ; Set data values for cal to DIQ1 for Delivery Schedule
108 S FLDS=$P(OLD(LOOP),U,3),DELCHG=$P(OLD(LOOP),U,7)
109 S FLD=$P(FLDS,";"),FILE=$P($P(FLDS,":"),";",2)
110 Q:FILE'=442.8 Q:FLD'=2
111 S PRCFA("DELSCH")=1,PRCFA("MOMREQ")=1
112 Q
Note: See TracBrowser for help on using the repository browser.