150 lines
5.1 KiB
Mathematica
150 lines
5.1 KiB
Mathematica
PRCHLO1 ;WOIFO/RLL-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ; 12/19/05 10:56am
|
|
V ;;5.1;IFCAP;**83**;; Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
; Continuation of PRCHLO1. This program builds the extracts for
|
|
; the Master PO Table and the associated multiples
|
|
POMAST ; PoMaster Table
|
|
Q
|
|
PODISCW ; Write PO Discount table data
|
|
N GPOID,GPOND
|
|
S GPOID=0,GPOND=""
|
|
F S GPOID=$O(^TMP($J,"PODISC",GPOID)) Q:GPOID="" D
|
|
. F S GPOND=$O(^TMP($J,"PODISC",GPOID,GPOND)) Q:GPOND="" D
|
|
. . W $G(^TMP($J,"PODISC",GPOID,GPOND))
|
|
. . W !
|
|
. . Q
|
|
. Q
|
|
Q
|
|
GPOMAST ; get PO Master record
|
|
S U="^"
|
|
N N0,N1,N7,N12,N16,N23,PONUMB,STNUMB,PODAT,PPOKEY
|
|
N PAPAB,PAPAB1,AGAPO,AGAPO1,PCHDR,PCHDR1,PCUSR,PCUSR1
|
|
N VL6,VL7,VL8,VL9,VL10,VL11,VL12,VL13,VL14,VL15,VL16,VL17,VL18
|
|
N VL19,VL20,VL21,VL22,VL23,VL24,VL25,VL26,VL27,VL28,VL29,VL30,VL31
|
|
N VL32,VL33,VL34,VL35,VL36,VL37,VL38,VL39,VL40,VL41
|
|
N GN0,GN0A,GN0B,GN1,GN1A,GN2,VN,VN1,VN2
|
|
N VL6E,VL6E1,VL6E2,VL7E,VL7E1,VL7E2,VL8E,VL8E1,VL8E2,VL10E,VL10E1
|
|
N VL10E2,VL21E,VL21E1,VL21E2,VL25E,VL25E1,VL25E2,VL35E,VL35E1,VL35E2
|
|
N VL16E,VL16E1,VL16E2,VL18E,VL18E1,VL18E2,VL33E,VL33E1,VL33E2
|
|
N VL34E,VL34E1,VL34E2,PC2237V,PC2237V1,EXDT,EXDT1,EXDT2
|
|
S N0=$G(^PRC(442,POID,0))
|
|
S N1=$G(^PRC(442,POID,1))
|
|
S N7=$G(^PRC(442,POID,7))
|
|
S N12=$G(^PRC(442,POID,12))
|
|
S N16=$G(^PRC(442,POID,16))
|
|
S N23=$G(^PRC(442,POID,23))
|
|
S PONUMB=$P(N0,U,1),STNUMB=$P(PONUMB,"-",1)
|
|
S EXDT=$P(N1,U,15)
|
|
I EXDT="" S EXDT=POCRDAT ; if PO Date "" use x-ref date value for PO
|
|
S EXDT1=$P(EXDT,".",1)
|
|
S EXDT2=$$FMTE^XLFDT(EXDT1)
|
|
S PODAT=EXDT2 ; needed for key
|
|
S PPOKEY=POID_U_PONUMB_U_PODAT_U_MNTHYR_U_STNUMB
|
|
;
|
|
; The 1st 5 values in PPOKEY above are included in each record
|
|
;
|
|
S VL6E=$P(N0,U,12),VL6E1=$G(^PRCS(410,+VL6E,0)),VL6E2=$P(VL6E1,U,1)
|
|
S VL6=VL6E2 ; Prim2237
|
|
S VL7E=$P(N0,U,2),VL7E1=$G(^PRCD(442.5,+VL7E,0)),VL7E2=$P(VL7E1,U,1)
|
|
S VL7=VL7E2 ; meth.of proc
|
|
S VL8E=$P(N1,U,19),VL8E1=$G(^PRC(443.8,+VL8E,0)),VL8E2=$P(VL8E1,U,2)
|
|
S VL8=VL8E2 ; locProcRsnCode
|
|
S VL9=$P(N1,U,18) ; exp/non-exp
|
|
S VL10E=$P(N7,U,1),VL10E1=$G(^PRCD(442.3,+VL10E,0))
|
|
S VL10E2=$P(VL10E1,U,1)
|
|
S VL10=VL10E2 ; Supply status
|
|
S VL11=$P(N7,U,2) ; Sup Stat Order
|
|
S VL12=$P(N7,U,4) ;Fis Stat Order
|
|
S VL13=$P(N0,U,3) ;FCP
|
|
S VL14=$P(N0,U,4) ;Appropriation
|
|
S VL15=$P(N0,U,5) ;CostCenter
|
|
S VL16E=$P(N0,U,6),VL16E1=$G(^PRCD(420.2,+VL16E,0))
|
|
S VL16E2=$P(VL16E1,U,1)
|
|
S VL16=VL16E2 ;SubAcct1
|
|
S VL17=$P(N0,U,7) ;SubAmt1
|
|
S VL18E=$P(N0,U,8),VL18E1=$G(^PRCD(420.2,+VL18E,0))
|
|
S VL18E2=$P(VL18E1,U,1)
|
|
S VL18=VL18E2 ;SubAcct2
|
|
S VL19=$P(N0,U,9) ;SubAmt2
|
|
; set Node 0 of ^TMP
|
|
S GN0=PPOKEY_U_VL6_U_VL7_U_VL8_U_VL9_U_VL10_U
|
|
S GN0A=GN0_VL11_U_VL12_U_VL13_U_VL14_U_VL15_U
|
|
S GN0B=GN0A_VL16_U_VL17_U_VL18_U_VL19_U
|
|
S ^TMP($J,"POMAST",POID,0)=GN0B ; build and set node 0
|
|
; begin Node 1
|
|
; look up Vendor
|
|
S VN=$P(N1,U,1),VN1=$G(^PRC(440,+VN,0)),VN2=$P(VN1,U,1)
|
|
S VL20=VN2
|
|
; S VL20=$P(N1,U,1) ; Vendor
|
|
S VL21E=$P(N1,U,2),VL21E1=$G(^DIC(49,+VL21E,0))
|
|
S VL21E2=$P(VL21E1,U,1)
|
|
S VL21=VL21E2 ; Req. Service
|
|
S VL22=$P(N1,U,6) ; Fob Point
|
|
; get ext. date
|
|
S EXDT=$P(N0,U,20),EXDT1=$P(EXDT,".",1)
|
|
S EXDT2=$$FMTE^XLFDT(EXDT1)
|
|
S VL23=EXDT2 ; Org. Del. Date
|
|
S VL24=$P(N0,U,11) ; Est. Cost
|
|
S VL25E=$P(N1,U,7),VL25E1=$G(^PRCD(420.8,+VL25E,0))
|
|
S VL25E2=$P(VL25E1,U,2)
|
|
S VL25=VL25E2 ; Source Code
|
|
S VL26=$P(N0,U,13) ; Est Shipping
|
|
S VL27=$P(N0,U,18) ; Shp Ln Itm #
|
|
S VL28=$P(N0,U,14) ; Ln Itm Cnt
|
|
S PAPAB=$P(N1,U,10),PAPAB1=$G(^VA(200,+PAPAB,0))
|
|
S VL29=$P(PAPAB1,U,1) ; PaPpmAuthBuyer
|
|
S AGAPO=$P(N12,U,4),AGAPO1=$G(^VA(200,+AGAPO,0))
|
|
S VL30=$P(AGAPO1,U,1) ; Agt Assgnd PO
|
|
; get external date
|
|
S EXDT=$P(N12,U,5),EXDT1=$P(EXDT,".",1)
|
|
S EXDT2=$$FMTE^XLFDT(EXDT1)
|
|
S VL31=EXDT2 ; DatePoAssigned
|
|
S VL32=$P(N16,U,0) ;remarks
|
|
S VL33E=$P(N23,U,3),VL33E1=$G(^PRC(442,+VL33E,0))
|
|
S VL33E2=$P(VL33E1,U,1)
|
|
S VL33=VL33E2 ; OldPoRec
|
|
S VL34E=$P(N23,U,4),VL34E1=$G(^PRC(442,+VL34E,0))
|
|
S VL34E2=$P(VL34E1,U,1)
|
|
S VL34=$P(N23,U,4) ; New PoRec
|
|
S GN1=VL20_U_VL21_U_VL22_U_VL23_U_VL24_U_VL25_U_VL26_U_VL27_U
|
|
S GN1A=GN1_VL28_U_VL29_U_VL30_U_VL31_U_VL32_U_VL33_U_VL34_U
|
|
S ^TMP($J,"POMAST",POID,1)=GN1A
|
|
;
|
|
; build node 2
|
|
S VL35E=$P(N23,U,14),VL35E1=$G(^PRC(440,+VL35E,0))
|
|
S VL35E2=$P(VL35E1,U,1)
|
|
S VL35=VL35E2 ; PcDo Vendor
|
|
S PCUSR=$P(N23,U,17),PCUSR1=$G(^VA(200,+PCUSR,0))
|
|
S VL36=$P(PCUSR1,U,1) ; Pur Crd User
|
|
S VL37=$P(N23,U,21) ; Pur Cost
|
|
S PCHDR=$P(N23,U,22),PCHDR1=$G(^VA(200,+PCHDR,0))
|
|
S VL38=$P(PCHDR1,U,1) ; Pur Card Hldr
|
|
; get ext. value for 2237
|
|
S PC2237V=$P(N23,U,23),PC2237V1=$G(^PRCS(410,+PC2237V,0))
|
|
S VL39=$P(PC2237V1,U,1) ; Pcdo2237
|
|
S VL40=$P(N0,U,15) ; Total Amount
|
|
S VL41=$P(N0,U,16) ; Net amount
|
|
;
|
|
S GN2=VL35_U_VL36_U_VL37_U_VL38_U_VL39_U_VL40_U_VL41
|
|
S ^TMP($J,"POMAST",POID,2)=GN2
|
|
;
|
|
D PODISC^PRCHLO1A
|
|
D POBOC^PRCHLO1A
|
|
D POCMTS^PRCHLO1A
|
|
D PORMKS^PRCHLO1A
|
|
D PO2237^PRCHLO1A
|
|
D POAMT^PRCHLO1A
|
|
D POAMMD^PRCHLO1A
|
|
D POPPTER^PRCHLO2A
|
|
D POPART^PRCHLO2A
|
|
D POOBL^PRCHLO2A
|
|
D POPMET^PRCHLO2A
|
|
D GPOITEM^PRCHLO2
|
|
Q
|
|
PODISCH ; PO Discount Header File
|
|
; Header file for PO Discount Multiple
|
|
W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^"
|
|
W "DiscountIdNum^DiscountItem^PercentDollarAmount^"
|
|
W "DiscountAmount^ItemCount^Contract^LineItem",!
|
|
Q
|