| 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
 | 
|---|