source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHCON2.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PRCHCON2 ;WISC/KMB-CONV. TEMPORARY 2237 TO PC ORDER ;1/9/97 3:08 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SET442 ; 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
Note: See TracBrowser for help on using the repository browser.