source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHLO3.m@ 1769

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

initial load of WorldVistAEHR
File size: 6.9 KB
Line 
1PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 12/19/05 10:25am
2V ;;5.1;IFCAP;**83**;; Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; Continuation of PRCHLO2
5 ;
6 ; PRCHLO3 routines are used to Write out the Header and data
7 ; associated with each of the 19 tables created for the Clinical
8 ; logistics Report Server. The files are built from the extracts
9 ; located in the ^TMP($J) global.
10 ;
11 Q
12POMASTH ; Po Master Table Header file
13 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^Primary2237"
14 W "^MethodOfProcessing^LocalProcReasonCode^ExpendableNonExpendable"
15 W "^SupplyStatus^SupplyStatusOrder^FiscalStatusOrder^FCP"
16 W "^Appropriation^CostCenter^SubAccount1^SubAmount1^SubAccount2"
17 W "^SubAmount2^Vendor^RequestingService^FobPoint"
18 W "^OriginalDeliveryDate^EstCost^SourceCode^EstShipping"
19 W "^ShippingLineItemNum^LineItemCount^PaPpmAuthBuyer"
20 W "^AgentAssignedPo^DatePoAssigned^Remarks^OldPoRecord^NewPoRecord"
21 W "^PcdoVendor^PurchaseCardUser^PurchaseCost^PurchaseCardHolder"
22 W "^Pcdo2237^TotalAmount^NetAmount",!
23 Q
24POMASTW ; Write PO Master table data
25 N GPOID,GPOND
26 S GPOID=0,GPOND=""
27 F S GPOID=$O(^TMP($J,"POMAST",GPOID)) Q:GPOID="" D
28 . ; W ! ; new line for each PO
29 . F S GPOND=$O(^TMP($J,"POMAST",GPOID,GPOND)) Q:GPOND="" D
30 . . W $G(^TMP($J,"POMAST",GPOID,GPOND))
31 . . Q
32 . W ! ; new line for each PO
33 . Q
34 Q
35 ;
36POOBHD ; PO Obligation Header
37 ;
38 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
39 W "ObDataIdNum^Tdateref^ObligatedBy^TransactionAmount^"
40 W "AmendmentNumber^Z1358Adjustment",!
41 Q
42 ;
43POOBW ; Write PO Obligation data
44 N POOBID,POOBID1
45 S POOBID=0,POOBID1=0
46 F S POOBID=$O(^TMP($J,"POOBLG",POOBID)) Q:POOBID="" D
47 . F S POOBID1=$O(^TMP($J,"POOBLG",POOBID,POOBID1)) Q:POOBID1="" D
48 . . W $G(^TMP($J,"POOBLG",POOBID,POOBID1)),!
49 . . Q
50 . Q
51 Q
52POPMEH ; Purchase Order Purchase Method Header
53 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
54 W "PurchaseMethodIdNum^PurchaseMethod",!
55 Q
56POPMEW ; Write Purchase Order Purchase Method Data
57 N POMT1,POMT2
58 S POMT1=0,POMT2=0
59 F S POMT1=$O(^TMP($J,"POPMETH",POMT1)) Q:POMT1="" D
60 . F S POMT2=$O(^TMP($J,"POPMETH",POMT1,POMT2)) Q:POMT2="" D
61 . . W $G(^TMP($J,"POPMETH",POMT1,POMT2)),!
62 . .Q
63 . Q
64 Q
65 ;
66POPART ; PO Partial Header
67 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
68 W "PartialIdNum^Date^ScheduledDeliveryDate^SubAccount1^Subamount1^"
69 W "SubAccount2^SubAmount2^Final^Overage^TotalAmount^"
70 W "DiscountPercentDays^Linecount^OriginalPartial^"
71 W "AdjustmentAmendmentNumber",!
72 Q
73POPARTW ; PO Partial Data Write
74 N POPR1,POPR2
75 S POPR1=0,POPR2=0
76 F S POPR1=$O(^TMP($J,"POPART",POPR1)) Q:POPR1="" D
77 . F S POPR2=$O(^TMP($J,"POPART",POPR1,POPR2)) Q:POPR2="" D
78 . . W $G(^TMP($J,"POPART",POPR1,POPR2)),!
79 . . Q
80 . Q
81 Q
82 ;
83PO2237H ; Po 2237 Header
84 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
85 W "Z2237IdNum^Z2237RefNum^AccountableOfficer^DateSigned^"
86 W "PurchasingAgent^TypeOfRequest^SourceOfRequest^InvDistPoint",!
87 Q
88 ;
89PO2237W ; PO 2237 Write Data
90 N PO37A,PO37B
91 S PO37A=0,PO37B=0
92 F S PO37A=$O(^TMP($J,"PO2237",PO37A)) Q:PO37A="" D
93 . F S PO37B=$O(^TMP($J,"PO2237",PO37A,PO37B)) Q:PO37B="" D
94 . . W $G(^TMP($J,"PO2237",PO37A,PO37B)),!
95 . . Q
96 . Q
97 Q
98POBOCH ; PO BOC Header
99 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
100 W "BocIdNum^Subaccount^SubAmount",!
101 Q
102POBOCW ; PO BOC Write Data
103 N POBOC,POBOC1
104 S POBOC=0,POBOC1=0
105 F S POBOC=$O(^TMP($J,"POBOC",POBOC)) Q:POBOC="" D
106 . F S POBOC1=$O(^TMP($J,"POBOC",POBOC,POBOC1)) Q:POBOC1="" D
107 . . W $G(^TMP($J,"POBOC",POBOC,POBOC1)),!
108 . . Q
109 . Q
110 Q
111POCMTSH ;PO Comments Header
112 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
113 W "CommentsIdNum^Comments",!
114 Q
115POCMTSW ; PO Comments Write Data
116 N POCMT,POCMT1
117 S POCMT=0,POCMT1=0
118 F S POCMT=$O(^TMP($J,"POCOMMENTS",POCMT)) Q:POCMT="" D
119 . W $G(^TMP($J,"POCOMMENTS",POCMT)),!
120 . Q
121 Q
122PORMKH ; PO Remarks Header
123 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
124 W "RemarksIdNum^Remarks",!
125 Q
126PORMKW ; PO Remarks Write Data
127 N PORMK
128 S PORMK=0
129 F S PORMK=$O(^TMP($J,"POREMARKS",PORMK)) Q:PORMK="" D
130 . W $G(^TMP($J,"POREMARKS",PORMK)),!
131 . Q
132 Q
133POPPTH ; Prompt Payment Terms Header
134 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
135 W "PaymentTermsIdNum^PromptPaymentPercent^DaysTerm^Contract^Astr",!
136 Q
137POPPTW ; Prompt Payment Terms Write Data
138 N POPPT,POPPT1
139 S POPPT=0,POPPT1=0
140 F S POPPT=$O(^TMP($J,"POPROMPT",POPPT)) Q:POPPT="" D
141 . F S POPPT1=$O(^TMP($J,"POPROMPT",POPPT,POPPT1)) Q:POPPT1="" D
142 . . W $G(^TMP($J,"POPROMPT",POPPT,POPPT1,0)),!
143 . . Q
144 . Q
145 Q
146POAMTH ; PO Amount Header
147 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
148 W "AmountIdNum^Amount^TypeCode^CompStatusBusiness^PrefProgram^"
149 W "Contract",!
150 Q
151POAMTW ; PO Amount Write Data
152 N POAMT,POAMT1,POAMT2
153 S POAMT=0,POAMT1=0
154 F S POAMT=$O(^TMP($J,"POAMT",POAMT)) Q:POAMT="" D
155 . F S POAMT1=$O(^TMP($J,"POAMT",POAMT,POAMT1)) Q:POAMT1="" D
156 . . W $G(^TMP($J,"POAMT",POAMT,POAMT1,0)),!
157 . . Q
158 . Q
159 Q
160PAMTBKH ; PO Amount Breakout Code Header
161 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
162 W "AmountIdNum^AmountBrkCodeIdNum^BreakoutCode",!
163 Q
164POAMDH ; PO Amendment Header
165 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
166 W "AmendmentIdNum^Amendment^EffectiveChange^AmountChanged^"
167 W "PappmAuthBuyer^AmendmentAdjStatus",!
168 Q
169POAMDW ; PO Amendment Write Data
170 N POAMD,POAMD1,POAMD2
171 S POAMD=0,POAMD1=0
172 F S POAMD=$O(^TMP($J,"POAMMD",POAMD)) Q:POAMD="" D
173 . F S POAMD1=$O(^TMP($J,"POAMMD",POAMD,POAMD1)) Q:POAMD1="" D
174 . . W $G(^TMP($J,"POAMMD",POAMD,POAMD1,0)),!
175 . . Q
176 . Q
177 Q
178 ;
179POAMDCH ; PO Amendment Changes Header
180 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
181 W "AmendmentIdNum^AmendmentChangeIdNum^Changes^AmendmentType",!
182 Q
183POAMDCW ; PO Amendment Changes Write Data
184 N PAMDC,PAMDC1,PAMDC2,PAMDC3,PAMDC4
185 S PAMDC=0,PAMDC1=0,PAMDC2=0,PAMDC3=0
186 F S PAMDC=$O(^TMP($J,"POAMMDCH",PAMDC)) Q:PAMDC="" D
187 . F S PAMDC1=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1)) Q:PAMDC1="" D
188 . . F S PAMDC2=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2)) Q:PAMDC2="" D
189 . . . W $G(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2,0)),!
190 . . . Q
191 . . Q
192 . Q
193 Q
194PAMDDH ; PO Amendment Description Header
195 W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
196 W "AmendmentIdNum^AmendmentDescIdNum^Description",!
197 Q
198 ;
199PAMDDW ; PO Amendment Description Write Data
200 N PAMD,PAMD1,PAMD2,PAMD3
201 S PAMD=0,PAMD1=0,PAMD2=0
202 F S PAMD=$O(^TMP($J,"POAMMDDES",PAMD)) Q:PAMD="" D
203 . F S PAMD1=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1)) Q:PAMD1="" D
204 . . F S PAMD2=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2)) Q:PAMD2="" D
205 . . . W $G(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2,0)),!
206 . . . Q
207 . . Q
208 . Q
209 Q
210PAMTBKW ; Write Breakout Code data
211 N BCD,BCD1,BCD2,BCD3
212 S BCD=0,BCD1=0,BCD2=0
213 F S BCD=$O(^TMP($J,"POBKCOD",BCD)) Q:BCD="" D
214 . F S BCD1=$O(^TMP($J,"POBKCOD",BCD,BCD1)) Q:BCD1="" D
215 . . F S BCD2=$O(^TMP($J,"POBKCOD",BCD,BCD1,BCD2)) Q:BCD2="" D
216 . . . ;
217 . . . W $G(^TMP($J,"POBKCOD",BCD,BCD1,BCD2,0)),!
218 . . Q
219 . Q
220 Q
Note: See TracBrowser for help on using the repository browser.