source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIUI.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCPEIUI ;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 ;
7SETUNITS(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 ;
28EDITUI(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
Note: See TracBrowser for help on using the repository browser.