PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 10/8/10 9:08am
;;5.1;IFCAP;**83,130,151**;Oct 20, 2000;Build 4
;Per VHA Directive 2004-038, 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 23 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^IENprimary2237^IENmethodOfProcessing^IENsupplyStatus"
W "^IENsubaccount1^IENsubaccount2^Vendor^RequestingService^FobPoint"
W "^OriginalDeliveryDate^EstCost^SourceCode^EstShipping"
W "^ShippingLineItemNum^LineItemCount^PaPpmAuthBuyer"
W "^AgentAssignedPo^DatePoAssigned^Remarks^OldPoRecord^NewPoRecord"
W "^PaPpmAuthBuyerSVCint^PaPpmAuthBuyerSVCext"
W "^AgentAssignedDuz^AgentAssignedSVCint^AgentAssignedSVCext"
W "^PcdoVendor^PurchaseCardUser^PurchaseCost^PurchaseCardHolder"
W "^Pcdo2237^TotalAmount^NetAmount"
W "^PurchaseCardUserSVCint^PurchaseCardUserSVCext"
W "^PurchaseCardHolderSVCint^PurchaseCardHolderSVCext^BBFY"
W "^EndDateForServiceOrder^AutoAccrue^SubstationIEN^SubstationExternal"
W "^VendorIEN^VendorFMSCode^VendorAlt-Addr-Ind^VendorDandB"
W "^Month^Quarter^LastDigitFicalYear^Actual1358Balance"
W "^Fiscal1358Balance^Est1358Balance^BulletinSent^InterfacePkgPrefix"
W "^DocumentID/CommonNumber^DoYouWantToSendThisEDI"
W "^ReasonNotCompeted^NumberOfOffers^PreAwardSynopsis"
W "^AlternativeAdvertising^SolicitationProcedure^EvaluatedPreference"
W "^FundingAgencyCode^FundingAgencyOfficeCode^MultiYear"
W "^EPADesignatedProduct^ContractBundling^ExtentCompeted"
W "^Perf.BasedServiceContract^ClingerCohen^PlaceOfPerfThisStation"
W "^PlaceOfPerformance^SendtoFPDS^DuzPABuyer^DuzPCUser^DuzPCHolder"
W "^RegionalACQcenter",!
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^DUZObligatedBy^IEN1358Adjustment^"
W "DateSigned^ObligationProcessDate^"
W "AccountingPeriod^ObligatedBySVCint^ObligatedBySVCext",!
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^"
W "DuzPA^DuzAccountableOfficer^PASVCint^PASVCext^"
W "AccountableOfficeSVCint^AccountableOfficeSVCext",!
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^FMSline",!
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^EffectiveDate^AmountChanged^"
W "PappmAuthBuyer^AmendmentAdjStatus^"
W "DuzPappmAuthBuyer^DuzFiscalApprover^NameFiscalApprover^"
W "PappmAuthBuyerSVCint^PappmAuthBuyerSVCext^"
W "FiscalApproverSVCint^FiscalApproverSVCext",!
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
CONTRPH ; Write File 410 header (Control Point Activities)
W "TransactionNumber^TransactionIEN^StationNumber^MonthYrRun^TransactionType^FormType^"
W "SubStationIEN^SubStationEXT^RunningBalQuarterDate^RunningBalStatus^"
W "DateOfRequest^ClassOfRequestIEN^ClassOfRequestEXT^Vendor^"
W "VendorAddress1^VendorAddress2^VendorAddress3^VendorAddress4^"
W "VendorCity^VendorState^VendorZIPcode^VendorContact^VendorPhone^"
W "VendorIEN^VendorName^VendorFMSCode^VendorAlt-Addr-Ind^"
W "VendorDandB^VendorContractNumber^ControlPoint^CostCenter^"
W "BOC1^BOC1Amount^AccountingData^FcpPrj^BBFY^"
W "CommittedCost^DateCommitted^ObligatedActualCost^"
W "DateObligated^PurchaseOrderObligationNumber^AdjustmentAmount^"
W "DateOBLAjusted^TransactionAmount^"
W "ObligatedByDUZ^ObligatedByName^ObligatedBySVCint^"
W "ObligatedBySVCext^ObligationValCodeDateTime^"
W "RequestorDUZ^RequestorName^RequestorSVCint^RequestorSVCext^"
W "RequestorTitle^ApprovOfficialDUZ^ApprovOfficialName^"
W "ApprovOfficialSVCint^ApprovOfficialSVCext^ApprovOfficialTitle^"
W "DateSigned^ESCodeDateTime^"
W "Justification^SortGroup^StationPONoIEN^StationPONoEXT^PoDate^Status^"
W "Comments^ReasonForReturn^"
;added by patch 151 to support new fields
W "AuthIEN^AuthCode^AuthDesc^SubAuthIEN^SubAuthCode^SubAuthDesc^"
W "ServiceStartDate^ServiceEndDate",!
Q
CONTRPW ; Write File 410 data (Control Point Activities)
N GPOID,GPOND
S GPOID=0,GPOND=""
F S GPOID=$O(^TMP($J,"CONTRP",GPOID)) Q:GPOID="" D
. F S GPOND=$O(^TMP($J,"CONTRP",GPOID,GPOND)) Q:GPOND="" D
. . W $G(^TMP($J,"CONTRP",GPOID,GPOND))
. . Q
. W ! ; new line for each file #410 entry
. Q
Q
SUBCPH ; Write File 410.04 header (Sub Control Point)
W "TransactionNumber^TransactionIEN^StationNumber^StationPONoIEN^StationPONoEXT^PoDate^MonthYrRun^SubControlPoint^Amount^SCPAMT",!
Q
SUBCPW ; Write File 410.04 data (Sub Control Point)
N GPOID,GPOND
S GPOID=0,GPOND=""
F S GPOID=$O(^TMP($J,"SUBCP",GPOID)) Q:GPOID="" D
. F S GPOND=$O(^TMP($J,"SUBCP",GPOID,GPOND)) Q:GPOND="" D
. . W $G(^TMP($J,"SUBCP",GPOID,GPOND)),!
. . Q
. Q
Q
DR1358H ; Write File 424 header (1358 Daily Record)
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^AuthorizationNumber^TransactionType^"
W "LiquidationAmount^AuthBalance^ObligationAmount^DateTime^UserDUZ^"
W "UserName^UserSVCint^UserSVCext^CompletedFlag^Reference^"
W "LastSequenceUsed^AuthAmount^"
W "OriginalAuthAmount^LastEditByDUZ^LastEditByName^LastEditBySVCint^"
W "LastEditBySVCext^CPApointerIEN^CPApointerEXT^Comments^InterfaceID",!
Q
DR1358W ; Write File 424 data (1358 Daily Record)
N GPOID,GPOND
S GPOID=0,GPOND=""
F S GPOID=$O(^TMP($J,"DR1358",GPOID)) Q:GPOID="" D
. F S GPOND=$O(^TMP($J,"DR1358",GPOID,GPOND)) Q:GPOND="" D
. . W $G(^TMP($J,"DR1358",GPOID,GPOND)),!
. . Q
. Q
Q
AD1358H ; Write File 424.1 header (1358 Authorization Detail)
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^BillNumber^RecordType^AuthPointerIEN^AuthPointerEXT^AuthAmount^"
W "DateTime^UserDUZ^UserName^UserSVCint^UserSVCext^"
W "VendorInvoiceNumber^FinalBill^Reference^LastEditedByDUZ^"
W "LastEditedByName^LastEditedBySVCint^LastEditedBySVCext^Description",!
Q
AD1358W ; Write File 424.1 data (1358 Authorization Detail)
N GPOID,GPOND
S GPOID=0,GPOND=""
F S GPOID=$O(^TMP($J,"AD1358",GPOID)) Q:GPOID="" D
. F S GPOND=$O(^TMP($J,"AD1358",GPOID,GPOND)) Q:GPOND="" D
. . W $G(^TMP($J,"AD1358",GPOID,GPOND)),!
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHLO3 12290 printed Sep 23, 2025@19:44:35 Page 2
PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 10/8/10 9:08am
+1 ;;5.1;IFCAP;**83,130,151**;Oct 20, 2000;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; Continuation of PRCHLO2
+4 ;
+5 ; PRCHLO3 routines are used to Write out the Header and data
+6 ; associated with each of the 23 tables created for the Clinical
+7 ; logistics Report Server. The files are built from the extracts
+8 ; located in the ^TMP($J) global.
+9 ;
+10 QUIT
POMASTH ; Po Master Table Header file
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^Primary2237"
+2 WRITE "^MethodOfProcessing^LocalProcReasonCode^ExpendableNonExpendable"
+3 WRITE "^SupplyStatus^SupplyStatusOrder^FiscalStatusOrder^FCP"
+4 WRITE "^Appropriation^CostCenter^SubAccount1^SubAmount1^SubAccount2"
+5 WRITE "^SubAmount2^IENprimary2237^IENmethodOfProcessing^IENsupplyStatus"
+6 WRITE "^IENsubaccount1^IENsubaccount2^Vendor^RequestingService^FobPoint"
+7 WRITE "^OriginalDeliveryDate^EstCost^SourceCode^EstShipping"
+8 WRITE "^ShippingLineItemNum^LineItemCount^PaPpmAuthBuyer"
+9 WRITE "^AgentAssignedPo^DatePoAssigned^Remarks^OldPoRecord^NewPoRecord"
+10 WRITE "^PaPpmAuthBuyerSVCint^PaPpmAuthBuyerSVCext"
+11 WRITE "^AgentAssignedDuz^AgentAssignedSVCint^AgentAssignedSVCext"
+12 WRITE "^PcdoVendor^PurchaseCardUser^PurchaseCost^PurchaseCardHolder"
+13 WRITE "^Pcdo2237^TotalAmount^NetAmount"
+14 WRITE "^PurchaseCardUserSVCint^PurchaseCardUserSVCext"
+15 WRITE "^PurchaseCardHolderSVCint^PurchaseCardHolderSVCext^BBFY"
+16 WRITE "^EndDateForServiceOrder^AutoAccrue^SubstationIEN^SubstationExternal"
+17 WRITE "^VendorIEN^VendorFMSCode^VendorAlt-Addr-Ind^VendorDandB"
+18 WRITE "^Month^Quarter^LastDigitFicalYear^Actual1358Balance"
+19 WRITE "^Fiscal1358Balance^Est1358Balance^BulletinSent^InterfacePkgPrefix"
+20 WRITE "^DocumentID/CommonNumber^DoYouWantToSendThisEDI"
+21 WRITE "^ReasonNotCompeted^NumberOfOffers^PreAwardSynopsis"
+22 WRITE "^AlternativeAdvertising^SolicitationProcedure^EvaluatedPreference"
+23 WRITE "^FundingAgencyCode^FundingAgencyOfficeCode^MultiYear"
+24 WRITE "^EPADesignatedProduct^ContractBundling^ExtentCompeted"
+25 WRITE "^Perf.BasedServiceContract^ClingerCohen^PlaceOfPerfThisStation"
+26 WRITE "^PlaceOfPerformance^SendtoFPDS^DuzPABuyer^DuzPCUser^DuzPCHolder"
+27 WRITE "^RegionalACQcenter",!
+28 QUIT
POMASTW ; Write PO Master table data
+1 NEW GPOID,GPOND
+2 SET GPOID=0
SET GPOND=""
+3 FOR
SET GPOID=$ORDER(^TMP($JOB,"POMAST",GPOID))
if GPOID=""
QUIT
Begin DoDot:1
+4 ; W ! ; new line for each PO
+5 FOR
SET GPOND=$ORDER(^TMP($JOB,"POMAST",GPOID,GPOND))
if GPOND=""
QUIT
Begin DoDot:2
+6 WRITE $GET(^TMP($JOB,"POMAST",GPOID,GPOND))
+7 QUIT
End DoDot:2
+8 ; new line for each PO
WRITE !
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
POOBHD ; PO Obligation Header
+1 ;
+2 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+3 WRITE "ObDataIdNum^Tdateref^ObligatedBy^TransactionAmount^"
+4 WRITE "AmendmentNumber^Z1358Adjustment^DUZObligatedBy^IEN1358Adjustment^"
+5 WRITE "DateSigned^ObligationProcessDate^"
+6 WRITE "AccountingPeriod^ObligatedBySVCint^ObligatedBySVCext",!
+7 QUIT
+8 ;
POOBW ; Write PO Obligation data
+1 NEW POOBID,POOBID1
+2 SET POOBID=0
SET POOBID1=0
+3 FOR
SET POOBID=$ORDER(^TMP($JOB,"POOBLG",POOBID))
if POOBID=""
QUIT
Begin DoDot:1
+4 FOR
SET POOBID1=$ORDER(^TMP($JOB,"POOBLG",POOBID,POOBID1))
if POOBID1=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POOBLG",POOBID,POOBID1)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
POPMEH ; Purchase Order Purchase Method Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "PurchaseMethodIdNum^PurchaseMethod",!
+3 QUIT
POPMEW ; Write Purchase Order Purchase Method Data
+1 NEW POMT1,POMT2
+2 SET POMT1=0
SET POMT2=0
+3 FOR
SET POMT1=$ORDER(^TMP($JOB,"POPMETH",POMT1))
if POMT1=""
QUIT
Begin DoDot:1
+4 FOR
SET POMT2=$ORDER(^TMP($JOB,"POPMETH",POMT1,POMT2))
if POMT2=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POPMETH",POMT1,POMT2)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
POPART ; PO Partial Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "PartialIdNum^Date^ScheduledDeliveryDate^SubAccount1^Subamount1^"
+3 WRITE "SubAccount2^SubAmount2^Final^Overage^TotalAmount^"
+4 WRITE "DiscountPercentDays^Linecount^OriginalPartial^"
+5 WRITE "AdjustmentAmendmentNumber",!
+6 QUIT
POPARTW ; PO Partial Data Write
+1 NEW POPR1,POPR2
+2 SET POPR1=0
SET POPR2=0
+3 FOR
SET POPR1=$ORDER(^TMP($JOB,"POPART",POPR1))
if POPR1=""
QUIT
Begin DoDot:1
+4 FOR
SET POPR2=$ORDER(^TMP($JOB,"POPART",POPR1,POPR2))
if POPR2=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POPART",POPR1,POPR2)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
PO2237H ; Po 2237 Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "Z2237IdNum^Z2237RefNum^AccountableOfficer^DateSigned^"
+3 WRITE "PurchasingAgent^TypeOfRequest^SourceOfRequest^InvDistPoint^"
+4 WRITE "DuzPA^DuzAccountableOfficer^PASVCint^PASVCext^"
+5 WRITE "AccountableOfficeSVCint^AccountableOfficeSVCext",!
+6 QUIT
+7 ;
PO2237W ; PO 2237 Write Data
+1 NEW PO37A,PO37B
+2 SET PO37A=0
SET PO37B=0
+3 FOR
SET PO37A=$ORDER(^TMP($JOB,"PO2237",PO37A))
if PO37A=""
QUIT
Begin DoDot:1
+4 FOR
SET PO37B=$ORDER(^TMP($JOB,"PO2237",PO37A,PO37B))
if PO37B=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"PO2237",PO37A,PO37B)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
POBOCH ; PO BOC Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "BocIdNum^Subaccount^SubAmount^FMSline",!
+3 QUIT
POBOCW ; PO BOC Write Data
+1 NEW POBOC,POBOC1
+2 SET POBOC=0
SET POBOC1=0
+3 FOR
SET POBOC=$ORDER(^TMP($JOB,"POBOC",POBOC))
if POBOC=""
QUIT
Begin DoDot:1
+4 FOR
SET POBOC1=$ORDER(^TMP($JOB,"POBOC",POBOC,POBOC1))
if POBOC1=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POBOC",POBOC,POBOC1)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
POCMTSH ;PO Comments Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "CommentsIdNum^Comments",!
+3 QUIT
POCMTSW ; PO Comments Write Data
+1 NEW POCMT,POCMT1
+2 SET POCMT=0
SET POCMT1=0
+3 FOR
SET POCMT=$ORDER(^TMP($JOB,"POCOMMENTS",POCMT))
if POCMT=""
QUIT
Begin DoDot:1
+4 WRITE $GET(^TMP($JOB,"POCOMMENTS",POCMT)),!
+5 QUIT
End DoDot:1
+6 QUIT
PORMKH ; PO Remarks Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "RemarksIdNum^Remarks",!
+3 QUIT
PORMKW ; PO Remarks Write Data
+1 NEW PORMK
+2 SET PORMK=0
+3 FOR
SET PORMK=$ORDER(^TMP($JOB,"POREMARKS",PORMK))
if PORMK=""
QUIT
Begin DoDot:1
+4 WRITE $GET(^TMP($JOB,"POREMARKS",PORMK)),!
+5 QUIT
End DoDot:1
+6 QUIT
POPPTH ; Prompt Payment Terms Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "PaymentTermsIdNum^PromptPaymentPercent^DaysTerm^Contract^Astr",!
+3 QUIT
POPPTW ; Prompt Payment Terms Write Data
+1 NEW POPPT,POPPT1
+2 SET POPPT=0
SET POPPT1=0
+3 FOR
SET POPPT=$ORDER(^TMP($JOB,"POPROMPT",POPPT))
if POPPT=""
QUIT
Begin DoDot:1
+4 FOR
SET POPPT1=$ORDER(^TMP($JOB,"POPROMPT",POPPT,POPPT1))
if POPPT1=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POPROMPT",POPPT,POPPT1,0)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
POAMTH ; PO Amount Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "AmountIdNum^Amount^TypeCode^CompStatusBusiness^PrefProgram^"
+3 WRITE "Contract",!
+4 QUIT
POAMTW ; PO Amount Write Data
+1 NEW POAMT,POAMT1,POAMT2
+2 SET POAMT=0
SET POAMT1=0
+3 FOR
SET POAMT=$ORDER(^TMP($JOB,"POAMT",POAMT))
if POAMT=""
QUIT
Begin DoDot:1
+4 FOR
SET POAMT1=$ORDER(^TMP($JOB,"POAMT",POAMT,POAMT1))
if POAMT1=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POAMT",POAMT,POAMT1,0)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
PAMTBKH ; PO Amount Breakout Code Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "AmountIdNum^AmountBrkCodeIdNum^BreakoutCode",!
+3 QUIT
POAMDH ; PO Amendment Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "AmendmentIdNum^Amendment^EffectiveDate^AmountChanged^"
+3 WRITE "PappmAuthBuyer^AmendmentAdjStatus^"
+4 WRITE "DuzPappmAuthBuyer^DuzFiscalApprover^NameFiscalApprover^"
+5 WRITE "PappmAuthBuyerSVCint^PappmAuthBuyerSVCext^"
+6 WRITE "FiscalApproverSVCint^FiscalApproverSVCext",!
+7 QUIT
POAMDW ; PO Amendment Write Data
+1 NEW POAMD,POAMD1,POAMD2
+2 SET POAMD=0
SET POAMD1=0
+3 FOR
SET POAMD=$ORDER(^TMP($JOB,"POAMMD",POAMD))
if POAMD=""
QUIT
Begin DoDot:1
+4 FOR
SET POAMD1=$ORDER(^TMP($JOB,"POAMMD",POAMD,POAMD1))
if POAMD1=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"POAMMD",POAMD,POAMD1,0)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
POAMDCH ; PO Amendment Changes Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "AmendmentIdNum^AmendmentChangeIdNum^Changes^AmendmentType",!
+3 QUIT
POAMDCW ; PO Amendment Changes Write Data
+1 NEW PAMDC,PAMDC1,PAMDC2,PAMDC3,PAMDC4
+2 SET PAMDC=0
SET PAMDC1=0
SET PAMDC2=0
SET PAMDC3=0
+3 FOR
SET PAMDC=$ORDER(^TMP($JOB,"POAMMDCH",PAMDC))
if PAMDC=""
QUIT
Begin DoDot:1
+4 FOR
SET PAMDC1=$ORDER(^TMP($JOB,"POAMMDCH",PAMDC,PAMDC1))
if PAMDC1=""
QUIT
Begin DoDot:2
+5 FOR
SET PAMDC2=$ORDER(^TMP($JOB,"POAMMDCH",PAMDC,PAMDC1,PAMDC2))
if PAMDC2=""
QUIT
Begin DoDot:3
+6 WRITE $GET(^TMP($JOB,"POAMMDCH",PAMDC,PAMDC1,PAMDC2,0)),!
+7 QUIT
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
PAMDDH ; PO Amendment Description Header
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
+2 WRITE "AmendmentIdNum^AmendmentDescIdNum^Description",!
+3 QUIT
+4 ;
PAMDDW ; PO Amendment Description Write Data
+1 NEW PAMD,PAMD1,PAMD2,PAMD3
+2 SET PAMD=0
SET PAMD1=0
SET PAMD2=0
+3 FOR
SET PAMD=$ORDER(^TMP($JOB,"POAMMDDES",PAMD))
if PAMD=""
QUIT
Begin DoDot:1
+4 FOR
SET PAMD1=$ORDER(^TMP($JOB,"POAMMDDES",PAMD,PAMD1))
if PAMD1=""
QUIT
Begin DoDot:2
+5 FOR
SET PAMD2=$ORDER(^TMP($JOB,"POAMMDDES",PAMD,PAMD1,PAMD2))
if PAMD2=""
QUIT
Begin DoDot:3
+6 WRITE $GET(^TMP($JOB,"POAMMDDES",PAMD,PAMD1,PAMD2,0)),!
+7 QUIT
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
PAMTBKW ; Write Breakout Code data
+1 NEW BCD,BCD1,BCD2,BCD3
+2 SET BCD=0
SET BCD1=0
SET BCD2=0
+3 FOR
SET BCD=$ORDER(^TMP($JOB,"POBKCOD",BCD))
if BCD=""
QUIT
Begin DoDot:1
+4 FOR
SET BCD1=$ORDER(^TMP($JOB,"POBKCOD",BCD,BCD1))
if BCD1=""
QUIT
Begin DoDot:2
+5 FOR
SET BCD2=$ORDER(^TMP($JOB,"POBKCOD",BCD,BCD1,BCD2))
if BCD2=""
QUIT
Begin DoDot:3
+6 ;
+7 WRITE $GET(^TMP($JOB,"POBKCOD",BCD,BCD1,BCD2,0)),!
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
CONTRPH ; Write File 410 header (Control Point Activities)
+1 WRITE "TransactionNumber^TransactionIEN^StationNumber^MonthYrRun^TransactionType^FormType^"
+2 WRITE "SubStationIEN^SubStationEXT^RunningBalQuarterDate^RunningBalStatus^"
+3 WRITE "DateOfRequest^ClassOfRequestIEN^ClassOfRequestEXT^Vendor^"
+4 WRITE "VendorAddress1^VendorAddress2^VendorAddress3^VendorAddress4^"
+5 WRITE "VendorCity^VendorState^VendorZIPcode^VendorContact^VendorPhone^"
+6 WRITE "VendorIEN^VendorName^VendorFMSCode^VendorAlt-Addr-Ind^"
+7 WRITE "VendorDandB^VendorContractNumber^ControlPoint^CostCenter^"
+8 WRITE "BOC1^BOC1Amount^AccountingData^FcpPrj^BBFY^"
+9 WRITE "CommittedCost^DateCommitted^ObligatedActualCost^"
+10 WRITE "DateObligated^PurchaseOrderObligationNumber^AdjustmentAmount^"
+11 WRITE "DateOBLAjusted^TransactionAmount^"
+12 WRITE "ObligatedByDUZ^ObligatedByName^ObligatedBySVCint^"
+13 WRITE "ObligatedBySVCext^ObligationValCodeDateTime^"
+14 WRITE "RequestorDUZ^RequestorName^RequestorSVCint^RequestorSVCext^"
+15 WRITE "RequestorTitle^ApprovOfficialDUZ^ApprovOfficialName^"
+16 WRITE "ApprovOfficialSVCint^ApprovOfficialSVCext^ApprovOfficialTitle^"
+17 WRITE "DateSigned^ESCodeDateTime^"
+18 WRITE "Justification^SortGroup^StationPONoIEN^StationPONoEXT^PoDate^Status^"
+19 WRITE "Comments^ReasonForReturn^"
+20 ;added by patch 151 to support new fields
+21 WRITE "AuthIEN^AuthCode^AuthDesc^SubAuthIEN^SubAuthCode^SubAuthDesc^"
+22 WRITE "ServiceStartDate^ServiceEndDate",!
+23 QUIT
CONTRPW ; Write File 410 data (Control Point Activities)
+1 NEW GPOID,GPOND
+2 SET GPOID=0
SET GPOND=""
+3 FOR
SET GPOID=$ORDER(^TMP($JOB,"CONTRP",GPOID))
if GPOID=""
QUIT
Begin DoDot:1
+4 FOR
SET GPOND=$ORDER(^TMP($JOB,"CONTRP",GPOID,GPOND))
if GPOND=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"CONTRP",GPOID,GPOND))
+6 QUIT
End DoDot:2
+7 ; new line for each file #410 entry
WRITE !
+8 QUIT
End DoDot:1
+9 QUIT
SUBCPH ; Write File 410.04 header (Sub Control Point)
+1 WRITE "TransactionNumber^TransactionIEN^StationNumber^StationPONoIEN^StationPONoEXT^PoDate^MonthYrRun^SubControlPoint^Amount^SCPAMT",!
+2 QUIT
SUBCPW ; Write File 410.04 data (Sub Control Point)
+1 NEW GPOID,GPOND
+2 SET GPOID=0
SET GPOND=""
+3 FOR
SET GPOID=$ORDER(^TMP($JOB,"SUBCP",GPOID))
if GPOID=""
QUIT
Begin DoDot:1
+4 FOR
SET GPOND=$ORDER(^TMP($JOB,"SUBCP",GPOID,GPOND))
if GPOND=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"SUBCP",GPOID,GPOND)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
DR1358H ; Write File 424 header (1358 Daily Record)
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^AuthorizationNumber^TransactionType^"
+2 WRITE "LiquidationAmount^AuthBalance^ObligationAmount^DateTime^UserDUZ^"
+3 WRITE "UserName^UserSVCint^UserSVCext^CompletedFlag^Reference^"
+4 WRITE "LastSequenceUsed^AuthAmount^"
+5 WRITE "OriginalAuthAmount^LastEditByDUZ^LastEditByName^LastEditBySVCint^"
+6 WRITE "LastEditBySVCext^CPApointerIEN^CPApointerEXT^Comments^InterfaceID",!
+7 QUIT
DR1358W ; Write File 424 data (1358 Daily Record)
+1 NEW GPOID,GPOND
+2 SET GPOID=0
SET GPOND=""
+3 FOR
SET GPOID=$ORDER(^TMP($JOB,"DR1358",GPOID))
if GPOID=""
QUIT
Begin DoDot:1
+4 FOR
SET GPOND=$ORDER(^TMP($JOB,"DR1358",GPOID,GPOND))
if GPOND=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"DR1358",GPOID,GPOND)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
AD1358H ; Write File 424.1 header (1358 Authorization Detail)
+1 WRITE "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^BillNumber^RecordType^AuthPointerIEN^AuthPointerEXT^AuthAmount^"
+2 WRITE "DateTime^UserDUZ^UserName^UserSVCint^UserSVCext^"
+3 WRITE "VendorInvoiceNumber^FinalBill^Reference^LastEditedByDUZ^"
+4 WRITE "LastEditedByName^LastEditedBySVCint^LastEditedBySVCext^Description",!
+5 QUIT
AD1358W ; Write File 424.1 data (1358 Authorization Detail)
+1 NEW GPOID,GPOND
+2 SET GPOID=0
SET GPOND=""
+3 FOR
SET GPOID=$ORDER(^TMP($JOB,"AD1358",GPOID))
if GPOID=""
QUIT
Begin DoDot:1
+4 FOR
SET GPOND=$ORDER(^TMP($JOB,"AD1358",GPOID,GPOND))
if GPOND=""
QUIT
Begin DoDot:2
+5 WRITE $GET(^TMP($JOB,"AD1358",GPOID,GPOND)),!
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 QUIT
