VistA-WorldVistAEHR/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHLO3.m

221 lines
6.9 KiB
Mathematica

PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 12/19/05 10:25am
V ;;5.1;IFCAP;**83**;; Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
; Continuation of PRCHLO2
;
; PRCHLO3 routines are used to Write out the Header and data
; associated with each of the 19 tables created for the Clinical
; logistics Report Server. The files are built from the extracts
; located in the ^TMP($J) global.
;
Q
POMASTH ; Po Master Table Header file
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^Primary2237"
W "^MethodOfProcessing^LocalProcReasonCode^ExpendableNonExpendable"
W "^SupplyStatus^SupplyStatusOrder^FiscalStatusOrder^FCP"
W "^Appropriation^CostCenter^SubAccount1^SubAmount1^SubAccount2"
W "^SubAmount2^Vendor^RequestingService^FobPoint"
W "^OriginalDeliveryDate^EstCost^SourceCode^EstShipping"
W "^ShippingLineItemNum^LineItemCount^PaPpmAuthBuyer"
W "^AgentAssignedPo^DatePoAssigned^Remarks^OldPoRecord^NewPoRecord"
W "^PcdoVendor^PurchaseCardUser^PurchaseCost^PurchaseCardHolder"
W "^Pcdo2237^TotalAmount^NetAmount",!
Q
POMASTW ; Write PO Master table data
N GPOID,GPOND
S GPOID=0,GPOND=""
F S GPOID=$O(^TMP($J,"POMAST",GPOID)) Q:GPOID="" D
. ; W ! ; new line for each PO
. F S GPOND=$O(^TMP($J,"POMAST",GPOID,GPOND)) Q:GPOND="" D
. . W $G(^TMP($J,"POMAST",GPOID,GPOND))
. . Q
. W ! ; new line for each PO
. Q
Q
;
POOBHD ; PO Obligation Header
;
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "ObDataIdNum^Tdateref^ObligatedBy^TransactionAmount^"
W "AmendmentNumber^Z1358Adjustment",!
Q
;
POOBW ; Write PO Obligation data
N POOBID,POOBID1
S POOBID=0,POOBID1=0
F S POOBID=$O(^TMP($J,"POOBLG",POOBID)) Q:POOBID="" D
. F S POOBID1=$O(^TMP($J,"POOBLG",POOBID,POOBID1)) Q:POOBID1="" D
. . W $G(^TMP($J,"POOBLG",POOBID,POOBID1)),!
. . Q
. Q
Q
POPMEH ; Purchase Order Purchase Method Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "PurchaseMethodIdNum^PurchaseMethod",!
Q
POPMEW ; Write Purchase Order Purchase Method Data
N POMT1,POMT2
S POMT1=0,POMT2=0
F S POMT1=$O(^TMP($J,"POPMETH",POMT1)) Q:POMT1="" D
. F S POMT2=$O(^TMP($J,"POPMETH",POMT1,POMT2)) Q:POMT2="" D
. . W $G(^TMP($J,"POPMETH",POMT1,POMT2)),!
. .Q
. Q
Q
;
POPART ; PO Partial Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "PartialIdNum^Date^ScheduledDeliveryDate^SubAccount1^Subamount1^"
W "SubAccount2^SubAmount2^Final^Overage^TotalAmount^"
W "DiscountPercentDays^Linecount^OriginalPartial^"
W "AdjustmentAmendmentNumber",!
Q
POPARTW ; PO Partial Data Write
N POPR1,POPR2
S POPR1=0,POPR2=0
F S POPR1=$O(^TMP($J,"POPART",POPR1)) Q:POPR1="" D
. F S POPR2=$O(^TMP($J,"POPART",POPR1,POPR2)) Q:POPR2="" D
. . W $G(^TMP($J,"POPART",POPR1,POPR2)),!
. . Q
. Q
Q
;
PO2237H ; Po 2237 Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "Z2237IdNum^Z2237RefNum^AccountableOfficer^DateSigned^"
W "PurchasingAgent^TypeOfRequest^SourceOfRequest^InvDistPoint",!
Q
;
PO2237W ; PO 2237 Write Data
N PO37A,PO37B
S PO37A=0,PO37B=0
F S PO37A=$O(^TMP($J,"PO2237",PO37A)) Q:PO37A="" D
. F S PO37B=$O(^TMP($J,"PO2237",PO37A,PO37B)) Q:PO37B="" D
. . W $G(^TMP($J,"PO2237",PO37A,PO37B)),!
. . Q
. Q
Q
POBOCH ; PO BOC Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "BocIdNum^Subaccount^SubAmount",!
Q
POBOCW ; PO BOC Write Data
N POBOC,POBOC1
S POBOC=0,POBOC1=0
F S POBOC=$O(^TMP($J,"POBOC",POBOC)) Q:POBOC="" D
. F S POBOC1=$O(^TMP($J,"POBOC",POBOC,POBOC1)) Q:POBOC1="" D
. . W $G(^TMP($J,"POBOC",POBOC,POBOC1)),!
. . Q
. Q
Q
POCMTSH ;PO Comments Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "CommentsIdNum^Comments",!
Q
POCMTSW ; PO Comments Write Data
N POCMT,POCMT1
S POCMT=0,POCMT1=0
F S POCMT=$O(^TMP($J,"POCOMMENTS",POCMT)) Q:POCMT="" D
. W $G(^TMP($J,"POCOMMENTS",POCMT)),!
. Q
Q
PORMKH ; PO Remarks Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "RemarksIdNum^Remarks",!
Q
PORMKW ; PO Remarks Write Data
N PORMK
S PORMK=0
F S PORMK=$O(^TMP($J,"POREMARKS",PORMK)) Q:PORMK="" D
. W $G(^TMP($J,"POREMARKS",PORMK)),!
. Q
Q
POPPTH ; Prompt Payment Terms Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "PaymentTermsIdNum^PromptPaymentPercent^DaysTerm^Contract^Astr",!
Q
POPPTW ; Prompt Payment Terms Write Data
N POPPT,POPPT1
S POPPT=0,POPPT1=0
F S POPPT=$O(^TMP($J,"POPROMPT",POPPT)) Q:POPPT="" D
. F S POPPT1=$O(^TMP($J,"POPROMPT",POPPT,POPPT1)) Q:POPPT1="" D
. . W $G(^TMP($J,"POPROMPT",POPPT,POPPT1,0)),!
. . Q
. Q
Q
POAMTH ; PO Amount Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "AmountIdNum^Amount^TypeCode^CompStatusBusiness^PrefProgram^"
W "Contract",!
Q
POAMTW ; PO Amount Write Data
N POAMT,POAMT1,POAMT2
S POAMT=0,POAMT1=0
F S POAMT=$O(^TMP($J,"POAMT",POAMT)) Q:POAMT="" D
. F S POAMT1=$O(^TMP($J,"POAMT",POAMT,POAMT1)) Q:POAMT1="" D
. . W $G(^TMP($J,"POAMT",POAMT,POAMT1,0)),!
. . Q
. Q
Q
PAMTBKH ; PO Amount Breakout Code Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "AmountIdNum^AmountBrkCodeIdNum^BreakoutCode",!
Q
POAMDH ; PO Amendment Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "AmendmentIdNum^Amendment^EffectiveChange^AmountChanged^"
W "PappmAuthBuyer^AmendmentAdjStatus",!
Q
POAMDW ; PO Amendment Write Data
N POAMD,POAMD1,POAMD2
S POAMD=0,POAMD1=0
F S POAMD=$O(^TMP($J,"POAMMD",POAMD)) Q:POAMD="" D
. F S POAMD1=$O(^TMP($J,"POAMMD",POAMD,POAMD1)) Q:POAMD1="" D
. . W $G(^TMP($J,"POAMMD",POAMD,POAMD1,0)),!
. . Q
. Q
Q
;
POAMDCH ; PO Amendment Changes Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "AmendmentIdNum^AmendmentChangeIdNum^Changes^AmendmentType",!
Q
POAMDCW ; PO Amendment Changes Write Data
N PAMDC,PAMDC1,PAMDC2,PAMDC3,PAMDC4
S PAMDC=0,PAMDC1=0,PAMDC2=0,PAMDC3=0
F S PAMDC=$O(^TMP($J,"POAMMDCH",PAMDC)) Q:PAMDC="" D
. F S PAMDC1=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1)) Q:PAMDC1="" D
. . F S PAMDC2=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2)) Q:PAMDC2="" D
. . . W $G(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2,0)),!
. . . Q
. . Q
. Q
Q
PAMDDH ; PO Amendment Description Header
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
W "AmendmentIdNum^AmendmentDescIdNum^Description",!
Q
;
PAMDDW ; PO Amendment Description Write Data
N PAMD,PAMD1,PAMD2,PAMD3
S PAMD=0,PAMD1=0,PAMD2=0
F S PAMD=$O(^TMP($J,"POAMMDDES",PAMD)) Q:PAMD="" D
. F S PAMD1=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1)) Q:PAMD1="" D
. . F S PAMD2=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2)) Q:PAMD2="" D
. . . W $G(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2,0)),!
. . . Q
. . Q
. Q
Q
PAMTBKW ; Write Breakout Code data
N BCD,BCD1,BCD2,BCD3
S BCD=0,BCD1=0,BCD2=0
F S BCD=$O(^TMP($J,"POBKCOD",BCD)) Q:BCD="" D
. F S BCD1=$O(^TMP($J,"POBKCOD",BCD,BCD1)) Q:BCD1="" D
. . F S BCD2=$O(^TMP($J,"POBKCOD",BCD,BCD1,BCD2)) Q:BCD2="" D
. . . ;
. . . W $G(^TMP($J,"POBKCOD",BCD,BCD1,BCD2,0)),!
. . Q
. Q
Q