source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIPS.m@ 1582

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCPEIPS ;WISC/RFJ-procurement sources edit ;01 Dec 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SOURCES(INVPT,ITEMDA) ; check/update procurement sources invpt itemda
8 I '$D(^PRCP(445,+INVPT,1,+ITEMDA,0)) Q
9 ;
10 N %,DATA,DIC,MANSRCE,TYPE,UP,UR,VENDA,VENDATA,VENDOR,Y
11 S TYPE=$P($G(^PRCP(445,+INVPT,0)),"^",3)
12 S IOP="HOME" D ^%ZIS K IOP W @IOF
13 ;
14 ; add procurement sources which should be there
15 W !!?5,"...adding ",$S(TYPE="S":"inventory points",1:"vendors from item master file")," as procurement sources"
16 ; for warehouse and primaries
17 I TYPE'="S" D
18 . S DIC="^PRC(440,"
19 . S VENDA=0 F S VENDA=$O(^PRC(441,ITEMDA,2,VENDA)) Q:'VENDA I '$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDA_";PRC(440,",1) S Y=VENDA D SCREEN^PRCPUMAN(INVPT,ITEMDA,0) I $T D
20 . . W !?15,$P($G(^PRC(440,VENDA,0)),"^")," added" D ADDVEN^PRCPUVEN(INVPT,ITEMDA,VENDA_";PRC(440,","","","")
21 . . I $Y>(IOSL-2) D R^PRCPUREP W @IOF
22 ; secondaries
23 I TYPE="S" D
24 . S DIC="^PRCP(445,"
25 . S VENDA=0 F S VENDA=$O(^PRCP(445,"AB",INVPT,VENDA)) Q:'VENDA I '$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDA_";PRCP(445,",1),$P($G(^PRCP(445,VENDA,0)),"^",3)="P",$D(^(2,INVPT,0)),$D(^PRCP(445,VENDA,1,ITEMDA,0)) D
26 . . W !?15,$P(^PRCP(445,VENDA,0),"^")," added" D ADDVEN^PRCPUVEN(INVPT,ITEMDA,VENDA_";PRCP(445,","","","")
27 . . I $Y>(IOSL-2) D R^PRCPUREP W @IOF
28 I $Y>(IOSL-2) D R^PRCPUREP W @IOF
29 ;
30 ; check procurement sources
31 W !!?5,"...checking currently stored procurement sources"
32 S VENDA=0 F S VENDA=$O(^PRCP(445,INVPT,1,ITEMDA,5,VENDA)) Q:'VENDA S DATA=^(VENDA,0) I DATA'="" D
33 . S VENDOR=$$VENNAME^PRCPUX1($P(DATA,"^")),DIC=$S($P(DATA,"^")["PRCP(445":"^PRCP(445,",1:"^PRC(440,")
34 . I $Y>(IOSL-6) D R^PRCPUREP W @IOF
35 . W !?15,VENDOR S Y=+$P(DATA,"^") D SCREEN^PRCPUMAN(INVPT,ITEMDA,0)
36 . I '$T W " deleted" D DELVEN^PRCPUVEN(INVPT,ITEMDA,VENDA) Q
37 . ;
38 . ; update data
39 . ; secondaries
40 . I TYPE="S" D Q
41 . . S VENDATA=$G(^PRCP(445,+$P(DATA,"^"),1,ITEMDA,0)),UP=$$UNITVAL^PRCPUX1($P(VENDATA,"^",14),$P(VENDATA,"^",5)," per ")
42 . . S UR=$$UNITVAL^PRCPUX1($P(DATA,"^",3),$P(DATA,"^",2)," per ")
43 . . W !?25,"UNIT per PURCHASE: ",UP,!?25,"UNIT per RECEIPT: ",UR
44 . . I UP'=UR,UP'["?" S $P(DATA,"^",3)=$P(VENDATA,"^",14),$P(DATA,"^",2)=$P(VENDATA,"^",5) W !?25,"*** UNIT per RECEIPT changed to UNIT per PURCHASE ***"
45 . . I '$P(DATA,"^",4) S %=$P(^PRCP(445,INVPT,1,ITEMDA,0),"^",14) S:'% %=1 S $P(DATA,"^",4)=($P(DATA,"^",3)/%)\1 S:'$P(DATA,"^",4) $P(DATA,"^",4)=1
46 . . W !?25,"CONVERSION FACTOR: ",$P(DATA,"^",4)
47 . . S ^PRCP(445,INVPT,1,ITEMDA,5,VENDA,0)=DATA
48 . ;
49 . ; for primary and warehouse
50 . S VENDATA=$G(^PRC(441,ITEMDA,2,+$P(DATA,"^"),0)),UP=$$UNITVAL^PRCPUX1($P(VENDATA,"^",8),$P(VENDATA,"^",7)," per ")
51 . S UR=$$UNITVAL^PRCPUX1($P(DATA,"^",3),$P(DATA,"^",2)," per ")
52 . W ?54,"LAST COST: ",$J($P(VENDATA,"^",2),0,3),!?25,"UNIT per PURCHASE: ",UP,!?25,"UNIT per RECEIPT : ",UR
53 . I UP'=UR,UP'["?" S $P(DATA,"^",3)=$P(VENDATA,"^",8),$P(DATA,"^",2)=$P(VENDATA,"^",7) W !?25,"*** UNIT per RECEIPT changed to UNIT per PURCHASE ***"
54 . I '$P(DATA,"^",4) S %=$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",14) S:'% %=1 S $P(DATA,"^",4)=($P(DATA,"^",3)/%)\1 S:'$P(DATA,"^",4) $P(DATA,"^",4)=1
55 . W !?25,"CONVERSION FACTOR: ",$P(DATA,"^",4)
56 . S ^PRCP(445,INVPT,1,ITEMDA,5,VENDA,0)=DATA
57 I $Y>(IOSL-3) D R^PRCPUREP W @IOF
58 ;
59 ; check mandatory source
60 W !!?5,"...checking mandatory source in the inventory point"
61 S MANSRCE=+$$MANDSRCE^PRCPU441(ITEMDA)
62 I TYPE="W",MANSRCE'=$O(^PRC(440,"AC","S",0)) D
63 . W !,"ITEM IS NOT SET UP AS POSTED STOCK. THE MANDATORY SOURCE IN THE ITEM MASTER",!,"FILE DOES NOT EQUAL THE WAREHOUSE VENDOR."
64 . D SETMAN^PRCPEIPU(INVPT,ITEMDA,"")
65 I TYPE="P",MANSRCE D SETMAN^PRCPEIPU(INVPT,ITEMDA,MANSRCE_";PRC(440,")
66 Q
Note: See TracBrowser for help on using the repository browser.