| [613] | 1 | PRCPEIQT ;WISC/RFJ-edit quantities, dueins, costs ; 5/4/99 3:40pm
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | QTY(PRCPINPT,ITEMDA) ; adjust primary or secondary quantity
|
|---|
| 8 | N %,ITEMDATA,ORDERNO,PRCPEIQT,PRCPID,QTY,REASON,VALUE,X,Y
|
|---|
| 9 | S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
|
|---|
| 10 | W !!?3,"QTY ON-HAND (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",+$P(ITEMDATA,"^",7)
|
|---|
| 11 | W !?10,"x",?16,"AVERAGE COST: ",$J(+$P(ITEMDATA,"^",22),0,3)
|
|---|
| 12 | W !?10,"=",?13,"INVENTORY VALUE: ",$J(+$P(ITEMDATA,"^",27),0,2),!
|
|---|
| 13 | S QTY=$$QTY^PRCPAWU0(-99999,99999) Q:QTY["^"
|
|---|
| 14 | W ! S VALUE=$$VALUE^PRCPAWU0(-9999999.99,9999999.99,"",0) Q:VALUE["^"
|
|---|
| 15 | S QTY=+QTY,VALUE=+VALUE I QTY=0,VALUE=0 Q
|
|---|
| 16 | W ! S REASON=$$REASON^PRCPAWU0("") Q:REASON["^"
|
|---|
| 17 | S ORDERNO=$$ORDERNO^PRCPUTRX(PRCPINPT)
|
|---|
| 18 | K PRCPEIQT S PRCPEIQT("QTY")=QTY,PRCPEIQT("INVVAL")=VALUE,PRCPEIQT("SELVAL")=0,PRCPEIQT("REASON")="0:"_REASON,PRCPEIQT("2237PO")=""
|
|---|
| 19 | D ITEM^PRCPUUIW(PRCPINPT,ITEMDA,"A",ORDERNO,.PRCPEIQT)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | DUEIN(PRCPINPT,ITEMDA) ; change primary or secondary due-ins
|
|---|
| 24 | N %,%H,D,D0,D1,DA,DD,DDC,DDH,DI,DIC,DIE,DIX,DIY,DIZ,DO,DQ,DR,DZ,ITEMDATA,PRCPTYPE,X,Y,Z
|
|---|
| 25 | S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
|
|---|
| 26 | S PRCPTYPE=$P(^PRCP(445,PRCPINPT,0),"^",3)
|
|---|
| 27 | W !!?3,"QTY DUE-IN (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA),!
|
|---|
| 28 | S:'$D(^PRCP(445,PRCPINPT,1,ITEMDA,7,0)) ^(0)="^445.09P^^"
|
|---|
| 29 | S (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DA(1)=PRCPINPT,DA=ITEMDA,DR=$S(PRCPTYPE="S":8.1,1:20)
|
|---|
| 30 | D ^DIE
|
|---|
| 31 | I PRCPTYPE="S" Q
|
|---|
| 32 | S (X,Y)=0 F S X=$O(^PRCP(445,PRCPINPT,1,ITEMDA,7,X)) Q:'X S Y=Y+$P($G(^(X,0)),"^",2)
|
|---|
| 33 | S X=Y-$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA) I X W !?5,"...total DUE-IN QUANTITY adjusted (by: ",X,") to: ",Y D SETIN^PRCPUDUE(PRCPINPT,ITEMDA,X),R^PRCPUREP
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | COSTEDIT(PRCPINPT,ITEMDA) ; edit last cost for invpt and item
|
|---|
| 38 | N %,D,D0,DA,DI,DIC,DIE,DQ,DR,DZ,X,X1,Y,Y1
|
|---|
| 39 | CE1 S DA(1)=PRCPINPT,DA=ITEMDA,(DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DR="4.7LAST COST;"
|
|---|
| 40 | D ^DIE
|
|---|
| 41 | S X1=$P(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",22),X=$P(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",15),Y=X1*1.1,Y1=X1/1.1
|
|---|
| 42 | I X>Y!(X<Y1) D
|
|---|
| 43 | . S Y="",DIR(0)="Y",DIR("B")="YES",DIR("A")="Re-Edit Last Cost"
|
|---|
| 44 | . S DIR("A",1)="** WARNING: Difference between last cost entered "
|
|---|
| 45 | . S DIR("A",2)="and average cost ("_X1_") is more than 10% **"
|
|---|
| 46 | . D ^DIR K DIR
|
|---|
| 47 | . I Y=1 S Y="YES"
|
|---|
| 48 | . Q
|
|---|
| 49 | I Y="YES" G CE1
|
|---|
| 50 | Q
|
|---|
