| 1 | PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 12/19/05 10:25am | 
|---|
| 2 | V ;;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 | 
|---|
| 12 | POMASTH ; 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 | 
|---|
| 24 | POMASTW ; 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 | ; | 
|---|
| 36 | POOBHD ; PO Obligation Header | 
|---|
| 37 | ; | 
|---|
| 38 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 39 | W "ObDataIdNum^Tdateref^ObligatedBy^TransactionAmount^" | 
|---|
| 40 | W "AmendmentNumber^Z1358Adjustment",! | 
|---|
| 41 | Q | 
|---|
| 42 | ; | 
|---|
| 43 | POOBW ; 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 | 
|---|
| 52 | POPMEH ; Purchase Order Purchase Method Header | 
|---|
| 53 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 54 | W "PurchaseMethodIdNum^PurchaseMethod",! | 
|---|
| 55 | Q | 
|---|
| 56 | POPMEW ; 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 | ; | 
|---|
| 66 | POPART ; 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 | 
|---|
| 73 | POPARTW ; 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 | ; | 
|---|
| 83 | PO2237H ; 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 | ; | 
|---|
| 89 | PO2237W ; 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 | 
|---|
| 98 | POBOCH ; PO BOC Header | 
|---|
| 99 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 100 | W "BocIdNum^Subaccount^SubAmount",! | 
|---|
| 101 | Q | 
|---|
| 102 | POBOCW ; 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 | 
|---|
| 111 | POCMTSH ;PO Comments Header | 
|---|
| 112 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 113 | W "CommentsIdNum^Comments",! | 
|---|
| 114 | Q | 
|---|
| 115 | POCMTSW ; 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 | 
|---|
| 122 | PORMKH ; PO Remarks Header | 
|---|
| 123 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 124 | W "RemarksIdNum^Remarks",! | 
|---|
| 125 | Q | 
|---|
| 126 | PORMKW ; 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 | 
|---|
| 133 | POPPTH ; Prompt Payment Terms Header | 
|---|
| 134 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 135 | W "PaymentTermsIdNum^PromptPaymentPercent^DaysTerm^Contract^Astr",! | 
|---|
| 136 | Q | 
|---|
| 137 | POPPTW ; 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 | 
|---|
| 146 | POAMTH ; PO Amount Header | 
|---|
| 147 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 148 | W "AmountIdNum^Amount^TypeCode^CompStatusBusiness^PrefProgram^" | 
|---|
| 149 | W "Contract",! | 
|---|
| 150 | Q | 
|---|
| 151 | POAMTW ; 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 | 
|---|
| 160 | PAMTBKH ; PO Amount Breakout Code Header | 
|---|
| 161 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 162 | W "AmountIdNum^AmountBrkCodeIdNum^BreakoutCode",! | 
|---|
| 163 | Q | 
|---|
| 164 | POAMDH ; PO Amendment Header | 
|---|
| 165 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 166 | W "AmendmentIdNum^Amendment^EffectiveChange^AmountChanged^" | 
|---|
| 167 | W "PappmAuthBuyer^AmendmentAdjStatus",! | 
|---|
| 168 | Q | 
|---|
| 169 | POAMDW ; 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 | ; | 
|---|
| 179 | POAMDCH ; PO Amendment Changes Header | 
|---|
| 180 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 181 | W "AmendmentIdNum^AmendmentChangeIdNum^Changes^AmendmentType",! | 
|---|
| 182 | Q | 
|---|
| 183 | POAMDCW ; 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 | 
|---|
| 194 | PAMDDH ; PO Amendment Description Header | 
|---|
| 195 | W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" | 
|---|
| 196 | W "AmendmentIdNum^AmendmentDescIdNum^Description",! | 
|---|
| 197 | Q | 
|---|
| 198 | ; | 
|---|
| 199 | PAMDDW ; 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 | 
|---|
| 210 | PAMTBKW ; 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 | 
|---|