| [613] | 1 | PRCHCON2 ;WISC/KMB-CONV. TEMPORARY 2237 TO PC ORDER ;1/9/97 3:08 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | SET442 ; set variables needed to create 442 record
|
|---|
| 5 | N NDA,SERV,IC,AA,BB,CC,CR,BOC,FSC,TOTAL,STR1,I,J,II,ZS,ZSO,PMULT,CONV,CONT,ITEM,VSTOCK,UCOST,UOP,MAX,NSN,CCEN,NCOST
|
|---|
| 6 | N NDC,QTY,SKU,SPEC,PRCHCV,PRCHCCP,PRCHV,PRCHCPD,PRCHCI,PRCHCII,PRCHCPO
|
|---|
| 7 | N VENDOR,VENDOR1,CNT,CNNT,CP,FCP,TDATE,SG,NDA,AR,PRCHPC
|
|---|
| 8 | S PRCHPC=2,PRCKAREN=1
|
|---|
| 9 | S PRC("SITE")=$P(PNW(1),"-"),PRC("FY")=$P(PNW(1),"-",2),PRC("QTR")=$P(PNW(1),"-",3),PRCSQ=1
|
|---|
| 10 | S (CNNT,CNT,IC)=""
|
|---|
| 11 | F I=1:1:14 S AR(I)=$G(^PRCS(410,DA,I))
|
|---|
| 12 | S CCEN=$P(AR(3),U,3),VENDOR=$P(AR(3),U,4),VENDOR1=$P(AR(2),U),NCOST=$P(AR(4),U),CR=$P(AR(1),U,5),SG=$P(AR(11),U),FCP=PRC("CP"),CP=$P(PRC("CP")," ")
|
|---|
| 13 | S CCEN=$P(CCEN," ")
|
|---|
| 14 | S PRCHCV=VENDOR1,PRCHCPD=+$P(AR(1),U,15),PRCHCCP=CP
|
|---|
| 15 | S CNNT=$P($G(^PRCS(410,DA,"IT",0)),U,4) I CNNT'="" S IC=1 F I=1:1:CNNT D
|
|---|
| 16 | .S STR1=$G(^PRCS(410,DA,"IT",I,0)) I STR1="" Q
|
|---|
| 17 | .S (FSC,PMULT,NSN,MAX,NDC,SKU,CONT,CONV)="",AA(IC)=$P(STR1,U) F II=2:1:7 S AA(IC)=AA(IC)_"^"_$P(STR1,"^",II)
|
|---|
| 18 | .S UCOST=$P(STR1,U,7),ITEM=$P(STR1,U,5),QTY=$P(STR1,U,2)
|
|---|
| 19 | .I VENDOR'="",ITEM'="",$G(^PRC(441,ITEM,2,+VENDOR,0))'="" D
|
|---|
| 20 | ..S ZSO=$G(^PRC(441,ITEM,2,+VENDOR,0)),ZS=$G(^PRC(441,ITEM,0))
|
|---|
| 21 | ..S NSN=$P(ZS,U,5),BOC=$P(ZS,U,10),FSC=$P(ZS,U,3),UCOST=$P(ZSO,U,2),CONT=$P(ZSO,U,3)
|
|---|
| 22 | ..S PMULT=$P(ZSO,U,8),MAX=$P(ZSO,U,9),CONV=$P(ZSO,U,10) S:CONT'="" CONT=$P($G(^PRC(440,+VENDOR,4,CONT,0)),U)
|
|---|
| 23 | ..S SKU=$P($G(^PRC(441,ITEM,3)),U,8)
|
|---|
| 24 | .S CNT=+$P($G(^PRCS(410,DA,"IT",IC,1,0)),U,2) I CNT'="" S CNT=+$P($G(^PRCS(410,DA,"IT",IC,1,0)),U,4)
|
|---|
| 25 | .I $G(CNT)'="" F J=1:1:CNT S BB(IC,J)=$G(^PRCS(410,DA,"IT",IC,1,J,0))
|
|---|
| 26 | .S AA(IC)=AA(IC)_"^"_"^^"_UCOST_"^^^"_PMULT_"^"_NSN_"^"_MAX_"^"_NDC_"^"_SKU_"^"_CONV
|
|---|
| 27 | .S TOTAL=QTY*UCOST,CC(IC)=TOTAL_"^"_CONT_"^"_FSC
|
|---|
| 28 | .S IC=IC+1
|
|---|
| 29 | S CNNT=IC-1,PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
|
|---|
| 30 | D NOW^%DTC S SPEC=$P($G(^PRC(420,PRC("SITE"),1,CP,0)),U,12),SERV=$P($G(^(0)),U,10),TDATE=X
|
|---|
| 31 | ;;;;;;;;;;;;;;;;
|
|---|
| 32 | S NDA=DA K DA D ^PRCHCON3
|
|---|
| 33 | I $G(PDA)'="" S $P(^PRCS(410,NDA,4),"^",5)=$P($P(^PRC(442,PDA,0),"^"),"-",2)
|
|---|
| 34 | K %,PDA,OUT,DR,DA,DIE,FLAG,PRC,PRCKAREN Q
|
|---|
