229 lines
7.7 KiB
Mathematica
229 lines
7.7 KiB
Mathematica
PRCHLO1A ;WOIFO/RLL-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ; 12/19/05 11:17am
|
|
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
|
|
W !
|
|
Q
|
|
PODISC ;
|
|
;PoDiscount Table 442.03A (multiple)
|
|
; ^PRC(442,POID,3,0)=^442.03A
|
|
N CKDS,PPO,PPOVAL,CKDS1,V1,V2,V3,V4,V5,V6
|
|
S CKDS=$G(^PRC(442,POID,3,0)),PPO=0
|
|
S CKDS1=$P(CKDS,U,3)
|
|
I +CKDS1>0 D ; Contains at least one discount, create rec.
|
|
. D LPPODIS
|
|
. Q
|
|
Q
|
|
PO2237 ; 2237RefNum Table
|
|
N CK2237,PPO,PPOVAL,CK2237A,PPV4E1,PPV4E2
|
|
S CK2237=$G(^PRC(442,POID,13,0)),PPO=0
|
|
S CK2237A=$P(CK2237,U,3)
|
|
I +CK2237A>0 D ; Contains at least one 2237#, create rec
|
|
. D LP2237
|
|
Q
|
|
POBOC ; PoBoc Table
|
|
N CKBS,PPO,PPOVAL,PPOVAL1,CKBS1
|
|
S CKBS=$G(^PRC(442,POID,22,0)),PPO=0
|
|
S CKBS1=$P(CKBS,U,3)
|
|
I +CKBS1>0 D ; Contains at lease one BOC, create rec.
|
|
. D LPPOBC
|
|
Q
|
|
POAMT ; PO Amount table (multiple)
|
|
N POAMT,POAMT1,POAMT2,POAMT3,POAMT4,V1,V2,V3
|
|
N V1E,V1E1,V1E2,V2E,V2E1,V2E2,VE,VE1,VE2
|
|
S POAMT=$G(^PRC(442,POID,9,0))
|
|
S POAMT1=$P(POAMT,U,3)
|
|
I +POAMT1>0 D
|
|
. S POAMT2=0
|
|
. F S POAMT2=$O(^PRC(442,POID,9,POAMT2)) Q:POAMT2="" D
|
|
. . Q:+POAMT2<0
|
|
. . S POAMT3=$G(^PRC(442,POID,9,POAMT2,0))
|
|
. . Q:POAMT3=""
|
|
. . ; For V1-V3, Get the node, $P the data, pad with "^" delimiters
|
|
. . ; get external value for TypeCode
|
|
. . S VE=$P(POAMT3,U,2)
|
|
. . I VE'="" S VE1=$G(^PRCD(420.6,+VE,0)),VE2=$P(VE1,U,1)
|
|
. . I VE="" S VE2=""
|
|
. . ; get external value for CompStatus Business
|
|
. . S V1E=$P(POAMT3,U,4)
|
|
. . I V1E'="" S V1E1=$G(^PRCD(420.6,+V1E,0)),V1E2=$P(V1E1,U,1)
|
|
. . I V1E="" S V1E2=""
|
|
. . ;
|
|
. . S V1=$P(POAMT3,U,1)_U_VE2_U_V1E2_U
|
|
. . ; Get external value for PrefProgram
|
|
. . S V2E=$P(POAMT3,U,5)
|
|
. . I V2E'="" S V2E1=$G(^PRCD(420.6,+V2E,0)),V2E2=$P(V2E1,U,1)
|
|
. . I V2E="" S V2E2=""
|
|
. . S V2=V2E2_U_$P(POAMT3,U,3),V3=V1_V2
|
|
. . S POAMT4=PPOKEY_U_POAMT2_U_V3
|
|
. . I +POAMT2>0 S ^TMP($J,"POAMT",POID,POAMT2,0)=POAMT4
|
|
. . D PAMBCD ; Po Amount Breakout code
|
|
. . Q
|
|
. Q
|
|
Q
|
|
PAMBCD ; PO Amount Breakout code
|
|
N PAMBC,PAMBC1,PAMBC2,PAMBC3,PAMBC4,VBCE,VBCE1,VBCE2
|
|
S PAMBC=0,PAMBC1=0,PAMBC2=0,PAMBC3=0
|
|
S PAMBC=$G(^PRC(442,POID,9,POAMT2,1,0))
|
|
S PAMBC1=$P(PAMBC,U,3)
|
|
I +PAMBC1>0 D
|
|
. F S PAMBC2=$O(^PRC(442,POID,9,POAMT2,1,PAMBC2)) Q:PAMBC2="" D
|
|
. . Q:+PAMBC2<0
|
|
. . S PAMBC3=$G(^PRC(442,POID,9,POAMT2,1,PAMBC2,0))
|
|
. . ;
|
|
. . ; get external value for breakout code
|
|
. . S VBCE=$P(PAMBC3,U,1)
|
|
. . I VBCE'="" S VBCE1=$G(^PRCD(420.6,+VBCE,0)),VBCE2=$P(VBCE1,U,1)
|
|
. . I VBCE="" S VBCE2=""
|
|
. . S PAMBC4=PPOKEY_U_POAMT2_U_PAMBC2_U_VBCE2
|
|
. . I +PAMBC2>0 S ^TMP($J,"POBKCOD",POID,POAMT2,PAMBC2,0)=PAMBC4
|
|
. . Q
|
|
. Q
|
|
Q
|
|
POAMMD ; PO Amendment Table (multiple)
|
|
N POAMD,POAMD1,POAMD2,POAMD3,POAMD3A,POAMD4,V1,V2,V3,V2E,V2E1,V2E2
|
|
N V3E,V3E1,V3E2,V1E,V1E1,V1E2
|
|
S POAMD=$G(^PRC(442,POID,6,0))
|
|
S POAMD1=$P(POAMD,U,3)
|
|
I +POAMD1>1 D
|
|
. S POAMD2=0
|
|
. F S POAMD2=$O(^PRC(442,POID,6,POAMD2)) Q:POAMD2="" D
|
|
. . Q:+POAMD<0
|
|
. . S POAMD3=$G(^PRC(442,POID,6,POAMD2,0))
|
|
. . S POAMD3A=$G(^PRC(442,POID,6,POAMD2,1))
|
|
. . ; V1-V3, $Get the data, $P the values, pad with "^" delimiters
|
|
. . ; get external date for EffectiveDate
|
|
. . S V1E=$P(POAMD3,U,2),V1E1=$P(V1E,".",1)
|
|
. . I V1E'="" S V1E2=$$FMTE^XLFDT(V1E1)
|
|
. . I V1E="" S V1E2=""
|
|
. . S V1=$P(POAMD3,U,1)_U_V1E2_U_$P(POAMD3,U,3)_U
|
|
. . ; get external value for pAPPMaUthorizedBuyer
|
|
. . S V2E=$P(POAMD3A,U,1)
|
|
. . I V2E'="" S V2E1=$G(^VA(200,+V2E,0)),V2E2=$P(V2E1,U,1)
|
|
. . I V2E="" S V2E2=""
|
|
. . ; get external value for AmendmentAdjustment
|
|
. . S V3E=$P(POAMD3A,U,4)
|
|
. . I V3E'="" S V3E1=$G(^PRCD(442.3,+V3E,0)),V3E2=$P(V3E1,U,1)
|
|
. . I V3E="" S V3E2=""
|
|
. . S V2=V2E2_U_V3E2,V3=V1_V2
|
|
. . S POAMD4=PPOKEY_U_POAMD2_U_V3
|
|
. . I +POAMD2>0 S ^TMP($J,"POAMMD",POID,POAMD2,0)=POAMD4
|
|
. . D POAMCH ; Check for Amendment Changes
|
|
. . D POAMDS ; Check for Amendment Description
|
|
. . Q
|
|
. Q
|
|
Q
|
|
POAMCH ; PO Amendment Changes Table (mulitple)
|
|
N POAMC,POAMC1,POAMC2,POAMC3,POAMC4,POAMC5,POAMC6
|
|
S POAMC=$G(^PRC(442,POID,6,POAMD2,3,0))
|
|
S POAMC1=$P(POAMC,U,3)
|
|
I +POAMC1>1 D
|
|
. S POAMC2=0
|
|
. F S POAMC2=$O(^PRC(442,POID,6,POAMD2,3,POAMC2)) Q:POAMC2="" D
|
|
. . S POAMC3=$G(^PRC(442,POID,6,POAMD2,3,POAMC2,0))
|
|
. . S POAMC4=$P(POAMC3,U,1),POAMC5=$P(POAMC3,U,2)
|
|
. . S POAMC6=PPOKEY_U_POAMD2_U_POAMC2_U_POAMC4_U_POAMC5
|
|
. . I +POAMC2>0 S ^TMP($J,"POAMMDCH",POID,POAMD2,POAMC2,0)=POAMC6
|
|
. . Q
|
|
. Q
|
|
Q
|
|
POAMDS ; PO Amendment Description Table
|
|
N POADD,POADD1,POADD2,POADD3,POADD4
|
|
S POADD=$G(^PRC(442,POID,6,POAMD2,2,0))
|
|
I $D(POADD) D
|
|
. S POADD1=0
|
|
. F S POADD1=$O(^PRC(442,POID,6,POAMD2,2,POADD1)) Q:POADD1="" D
|
|
. . S POADD2=$G(^PRC(442,POID,6,POAMD2,2,POADD1,0)) ; mult
|
|
. . S POADD3=PPOKEY_U_POAMD2_U_POADD1_U_POADD2
|
|
. . Q:+POADD1>1 ; Get the 1st "1"
|
|
. . I +POAMD2>0 S ^TMP($J,"POAMMDDES",POID,POAMD2,POADD1,0)=POADD3
|
|
. . Q
|
|
. Q
|
|
Q
|
|
POCMTS ; PocommentsTable
|
|
N POCMTS,POCMTS1
|
|
S POCMTS=$G(^PRC(442,POID,4,1,0)) ; 1st line
|
|
S POCMTS1=$E(POCMTS,1,175) ; Get the 1st 175 Chars
|
|
; Get the 1st 175 Char of 1st comment only
|
|
I POCMTS'="" S ^TMP($J,"POCOMMENTS",POID)=PPOKEY_U_1_U_POCMTS1
|
|
Q
|
|
PORMKS ; PoRemarks Table
|
|
N PORMKS,PORMKS1
|
|
S PORMKS=$G(^PRC(442,POID,16,1,0)) ; 1st Line, 1st Comment
|
|
S PORMKS1=$E(PORMKS,1,175) ; Get the 1st 175 Chars
|
|
; gET 1st 175 Characters of 1st remark
|
|
I PORMKS'="" S ^TMP($J,"POREMARKS",POID)=PPOKEY_U_1_U_PORMKS1
|
|
Q
|
|
LPPODIS ; Loop on PO Discount
|
|
I CKDS1>0 D
|
|
. F S PPO=$O(^PRC(442,POID,3,PPO)) Q:PPO="" D
|
|
. . S PPOVAL=$G(^PRC(442,POID,3,PPO,0))
|
|
. . S V1=$P(PPOVAL,U,1)_U_$P(PPOVAL,U,2)_U ; disc itm & %$tot
|
|
. . S V2=$P(PPOVAL,U,3)_U_$P(PPOVAL,U,4)_U ; DiscAmt & ItmCt
|
|
. . S V3=$P(PPOVAL,U,5)_U_$P(PPOVAL,U,6) ; contract & lineItem
|
|
. . S V4=V1_V2_V3 ; all data
|
|
. . S PPOVAL1=PPOKEY_U_PPO_U_V4
|
|
. . S ^TMP($J,"PODISC",POID,PPO)=PPOVAL1
|
|
. . Q
|
|
. Q
|
|
Q
|
|
LPPOBC ; Loop PoBoc Table
|
|
F S PPO=$O(^PRC(442,POID,22,PPO)) Q:PPO="" D
|
|
. Q:PPO="B" ; don't want B index
|
|
. S PPOVAL=$G(^PRC(442,POID,22,PPO,0))
|
|
. S PPOVAL1=$P(PPOVAL,U,1)_U_$P(PPOVAL,U,2)
|
|
. S PPOVAL2=PPOKEY_U_PPO_U_PPOVAL1
|
|
. S ^TMP($J,"POBOC",POID,PPO)=PPOVAL2
|
|
. Q
|
|
Q
|
|
LP2237 ; Loop 2237
|
|
N PPOVAL,PPV1,PPV2,PPV3,PPV4,PPV5,PPV6,PPV7,PPVALL,POKEY,PPOVAL2
|
|
N PPV1E,PPV1E1,PPV2E,PPV2E1,PPV4E1,PPV4E2,PPV7E,PPV7E1,PPV7E2
|
|
N PPV3E,PPV3E1
|
|
F S PPO=$O(^PRC(442,POID,13,PPO)) Q:PPO="" D
|
|
. S PPOVAL=$G(^PRC(442,POID,13,PPO,0))
|
|
. S PPV1=$P(PPOVAL,U,1),PPV2=$P(PPOVAL,U,2),PPV3=$P(PPOVAL,U,4)
|
|
. ; external value for 2237 PPV1
|
|
. I PPV1'="" S PPV1E=$G(^PRCS(410,+PPV1,0)),PPV1E1=$P(PPV1E,U,1)
|
|
. I PPV1="" S PPV1E1=""
|
|
. ; exeternal value for AccountableOfficer PPV2
|
|
. I PPV2'="" S PPV2E=$G(^VA(200,+PPV2,0)),PPV2E1=$P(PPV2E,U,1)
|
|
. I PPV2="" S PPV2E1=""
|
|
. ; ext. date value for Date Signed
|
|
. I PPV3'="" S PPV3E=$P(PPV3,".",1),PPV3E1=$$FMTE^XLFDT(PPV3E)
|
|
. I PPV3="" S PPV3E1=""
|
|
. S PPV4=$P(PPOVAL,U,5),PPV5=$P(PPOVAL,U,9),PPV6=$P(PPOVAL,U,10)
|
|
. ; external for Purchasing agent PPV4
|
|
. ;
|
|
. I PPV4'="" S PPV4E1=$G(^VA(200,+PPV4,0)),PPV4E2=$P(PPV4E1,U,1)
|
|
. I PPV4="" S PPV4E2=""
|
|
. ; get external value for InvDistPoint
|
|
. S PPV7E=$P(PPOVAL,U,11)
|
|
. I PPV7E'="" S PPV7E1=$G(^PRCP(445,+PPV7E,0)),PPV7E2=$P(PPV7E1,U,1)
|
|
. I PPV7E="" S PPV7E2=""
|
|
. S PPV7=PPV7E2
|
|
. S PPVALL=PPV1E1_U_PPV2E1_U_PPV3E1_U_PPV4E2_U_PPV5_U_PPV6_U_PPV7
|
|
. ;
|
|
. S PPOVAL2=PPOKEY_U_PPO_U_PPVALL
|
|
. S ^TMP($J,"PO2237",POID,PPO)=PPOVAL2
|
|
. Q
|
|
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
|