PRCPEIUI ;WISC/RFJ-units per issue ;01 Dec 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
SETUNITS(PRCPINPT,ITEMDA) ; called to automatically set units
I '$D(^PRCP(445,+PRCPINPT,1,+ITEMDA,0)) Q
N D,DATA,MANSRCE,PRCPLOCK,TYPE,UI,UP,WHSESRCE
S TYPE=$P($G(^PRCP(445,+PRCPINPT,0)),"^",3)
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
;
; unit of issue (whse) = unit of receipts (whse vendor)
S MANSRCE=$$MANDSRCE^PRCPU441(ITEMDA)_";PRC(440," S:'MANSRCE MANSRCE=""
I TYPE="W",+MANSRCE,+MANSRCE=WHSESRCE S DATA=$G(^PRC(441,ITEMDA,2,+MANSRCE,0)) I DATA'="" D
. S UP=$$UNITVAL^PRCPUX1($P(DATA,"^",8),$P(DATA,"^",7)," per ")
. W !?4,"UNIT per PURCHASE (WHSE VENDOR): ",UP
. I UP["?" W !,"The UNIT per PURCHASE in the item master file needs to be correctly entered."
. I UP'["?" S UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ") I UI'=UP W !?4,"THE UNIT per ISSUE SHOULD EQUAL THE UNIT per PURCHASE."
. ; update issue multiples (field 16,16.5) if warehouse
. S D=^PRCP(445,PRCPINPT,1,ITEMDA,0)
. 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)
. 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)
. S ^PRCP(445,PRCPINPT,1,ITEMDA,0)=D
Q
;
;
EDITUI(PRCPINPT,ITEMDA) ; edit unit per issue and update
I '$D(^PRCP(445,+PRCPINPT,1,+ITEMDA,0)) Q
N D,D0,DA,DI,DIC,DIE,DQ,DR,PRCPUI,TYPE,UI,X,Y
S TYPE=$P(^PRCP(445,PRCPINPT,0),"^",3),PRCPUI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ")
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
S UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ") I UI=PRCPUI!(UI["?") Q
I TYPE'="S" D UPDATE^PRCPEIPU(PRCPINPT,ITEMDA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPEIUI 2097 printed Sep 23, 2025@19:49:47 Page 2
PRCPEIUI ;WISC/RFJ-units per issue ;01 Dec 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SETUNITS(PRCPINPT,ITEMDA) ; called to automatically set units
+1 IF '$DATA(^PRCP(445,+PRCPINPT,1,+ITEMDA,0))
QUIT
+2 NEW D,DATA,MANSRCE,PRCPLOCK,TYPE,UI,UP,WHSESRCE
+3 SET TYPE=$PIECE($GET(^PRCP(445,+PRCPINPT,0)),"^",3)
+4 IF TYPE'="S"
SET WHSESRCE=$ORDER(^PRC(440,"AC","S",0))
IF 'WHSESRCE
WRITE !!,"YOU DO NOT HAVE A VENDOR (FILE #440) ENTERED AS A SUPPLY WAREHOUSE.",!
DO R^PRCPUREP
QUIT
+5 ;
+6 ; unit of issue (whse) = unit of receipts (whse vendor)
+7 SET MANSRCE=$$MANDSRCE^PRCPU441(ITEMDA)_";PRC(440,"
if 'MANSRCE
SET MANSRCE=""
+8 IF TYPE="W"
IF +MANSRCE
IF +MANSRCE=WHSESRCE
SET DATA=$GET(^PRC(441,ITEMDA,2,+MANSRCE,0))
IF DATA'=""
Begin DoDot:1
+9 SET UP=$$UNITVAL^PRCPUX1($PIECE(DATA,"^",8),$PIECE(DATA,"^",7)," per ")
+10 WRITE !?4,"UNIT per PURCHASE (WHSE VENDOR): ",UP
+11 IF UP["?"
WRITE !,"The UNIT per PURCHASE in the item master file needs to be correctly entered."
+12 IF UP'["?"
SET UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ")
IF UI'=UP
WRITE !?4,"THE UNIT per ISSUE SHOULD EQUAL THE UNIT per PURCHASE."
+13 ; update issue multiples (field 16,16.5) if warehouse
+14 SET D=^PRCP(445,PRCPINPT,1,ITEMDA,0)
+15 WRITE !!?5,"ISSUE MULTIPLE : ",+$PIECE(D,"^",25)
IF $PIECE(DATA,"^",11)
IF $PIECE(DATA,"^",11)'=$PIECE(D,"^",25)
SET $PIECE(D,"^",25)=$PIECE(DATA,"^",11)
WRITE ?27,"adjusted to: ",$PIECE(D,"^",25)
+16 WRITE !?5,"MINIMUM ISSUE QTY: ",+$PIECE(D,"^",17)
IF $PIECE(DATA,"^",12)
IF $PIECE(DATA,"^",12)'=$PIECE(D,"^",17)
SET $PIECE(D,"^",17)=$PIECE(DATA,"^",12)
WRITE ?27,"adjusted to: ",$PIECE(D,"^",17)
+17 SET ^PRCP(445,PRCPINPT,1,ITEMDA,0)=D
End DoDot:1
+18 QUIT
+19 ;
+20 ;
EDITUI(PRCPINPT,ITEMDA) ; edit unit per issue and update
+1 IF '$DATA(^PRCP(445,+PRCPINPT,1,+ITEMDA,0))
QUIT
+2 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,PRCPUI,TYPE,UI,X,Y
+3 SET TYPE=$PIECE(^PRCP(445,PRCPINPT,0),"^",3)
SET PRCPUI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ")
+4 SET DA(1)=PRCPINPT
SET DA=ITEMDA
SET (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,"
SET DR="4;4.5;"_$SELECT(TYPE="P":"16;16.5;",1:"")
WRITE !
DO ^DIE
IF $DATA(Y)
QUIT
+5 SET UI=$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per ")
IF UI=PRCPUI!(UI["?")
QUIT
+6 IF TYPE'="S"
DO UPDATE^PRCPEIPU(PRCPINPT,ITEMDA)
+7 QUIT
