| 1 | PRCPEIUI ;WISC/RFJ-units per issue ;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 | ;
|
|---|
| 7 | SETUNITS(PRCPINPT,ITEMDA) ; called to automatically set units
|
|---|
| 8 | I '$D(^PRCP(445,+PRCPINPT,1,+ITEMDA,0)) Q
|
|---|
| 9 | N D,DATA,MANSRCE,PRCPLOCK,TYPE,UI,UP,WHSESRCE
|
|---|
| 10 | S TYPE=$P($G(^PRCP(445,+PRCPINPT,0)),"^",3)
|
|---|
| 11 | I TYPE'="S" S WHSESRCE=$O(^PRC(440,"AC","S",0)) I 'WHSESRCE W !!,"YOU DO NOT HAVE A VENDOR (FILE #440) ENTERED AS A SUPPLY WAREHOUSE.",! D R^PRCPUREP Q
|
|---|
| 12 | ;
|
|---|
| 13 | ; unit of issue (whse) = unit of receipts (whse vendor)
|
|---|
| 14 | S MANSRCE=$$MANDSRCE^PRCPU441(ITEMDA)_";PRC(440," S:'MANSRCE MANSRCE=""
|
|---|
| 15 | I TYPE="W",+MANSRCE,+MANSRCE=WHSESRCE S DATA=$G(^PRC(441,ITEMDA,2,+MANSRCE,0)) I DATA'="" D
|
|---|
| 16 | . S UP=$$UNITVAL^PRCPUX1($P(DATA,"^",8),$P(DATA,"^",7)," per ")
|
|---|
| 17 | . W !?4,"UNIT per PURCHASE (WHSE VENDOR): ",UP
|
|---|
| 18 | . I UP["?" W !,"The UNIT per PURCHASE in the item master file needs to be correctly entered."
|
|---|
| 19 | . I UP'["?" S UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ") I UI'=UP W !?4,"THE UNIT per ISSUE SHOULD EQUAL THE UNIT per PURCHASE."
|
|---|
| 20 | . ; update issue multiples (field 16,16.5) if warehouse
|
|---|
| 21 | . S D=^PRCP(445,PRCPINPT,1,ITEMDA,0)
|
|---|
| 22 | . W !!?5,"ISSUE MULTIPLE : ",+$P(D,"^",25) I $P(DATA,"^",11),$P(DATA,"^",11)'=$P(D,"^",25) S $P(D,"^",25)=$P(DATA,"^",11) W ?27,"adjusted to: ",$P(D,"^",25)
|
|---|
| 23 | . W !?5,"MINIMUM ISSUE QTY: ",+$P(D,"^",17) I $P(DATA,"^",12),$P(DATA,"^",12)'=$P(D,"^",17) S $P(D,"^",17)=$P(DATA,"^",12) W ?27,"adjusted to: ",$P(D,"^",17)
|
|---|
| 24 | . S ^PRCP(445,PRCPINPT,1,ITEMDA,0)=D
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | ;
|
|---|
| 28 | EDITUI(PRCPINPT,ITEMDA) ; edit unit per issue and update
|
|---|
| 29 | I '$D(^PRCP(445,+PRCPINPT,1,+ITEMDA,0)) Q
|
|---|
| 30 | N D,D0,DA,DI,DIC,DIE,DQ,DR,PRCPUI,TYPE,UI,X,Y
|
|---|
| 31 | S TYPE=$P(^PRCP(445,PRCPINPT,0),"^",3),PRCPUI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ")
|
|---|
| 32 | S DA(1)=PRCPINPT,DA=ITEMDA,(DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DR="4;4.5;"_$S(TYPE="P":"16;16.5;",1:"") W ! D ^DIE I $D(Y) Q
|
|---|
| 33 | S UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ") I UI=PRCPUI!(UI["?") Q
|
|---|
| 34 | I TYPE'="S" D UPDATE^PRCPEIPU(PRCPINPT,ITEMDA)
|
|---|
| 35 | Q
|
|---|
