| 1 | PRCPOPEE ;WISC/RFJ-edit distribution order items ;27 Sep 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 | EDIT ; edit distribution order
|
|---|
| 8 | D FULL^VALM1
|
|---|
| 9 | S VALMBCK="R"
|
|---|
| 10 | D ITEMS(ORDERDA)
|
|---|
| 11 | D INIT^PRCPOPL
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | ITEMS(ORDERDA) ; edit items on distribution order orderda
|
|---|
| 16 | I '$D(^PRCP(445.3,ORDERDA,0)) Q
|
|---|
| 17 | N AFTERQTY,BEFORQTY,CONV,ITEMDA,PRIMITEM,PRCPORD,SECOITEM,UNITCOST,UNITR,VDATA
|
|---|
| 18 | D VARIABLE^PRCPOPU
|
|---|
| 19 | ;
|
|---|
| 20 | F S ITEMDA=+$$ITEMSEL^PRCPOPUS(ORDERDA,PRCPPRIM,1) Q:'ITEMDA D
|
|---|
| 21 | . ;
|
|---|
| 22 | . ; show inventory data
|
|---|
| 23 | . S PRIMITEM=^PRCP(445,PRCPPRIM,1,ITEMDA,0)
|
|---|
| 24 | . S UNITCOST=+$P(PRIMITEM,"^",22) I $P(PRIMITEM,"^",15)>UNITCOST S UNITCOST=+$P(PRIMITEM,"^",15)
|
|---|
| 25 | . ;
|
|---|
| 26 | . W !!,"Data for PRIMARY inventory point: ",$P(PRCPORD(0),"^",2)
|
|---|
| 27 | . W !?5,"Quantity On-Hand: ",+$P(PRIMITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPPRIM,ITEMDA," per ")
|
|---|
| 28 | . W !?5,"Quantity Due-Out: ",$$GETOUT^PRCPUDUE(PRCPPRIM,ITEMDA),!?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPPRIM,ITEMDA),!?12,"Unit Cost: ",UNITCOST
|
|---|
| 29 | . I $P(PRIMITEM,"^",25) W !?2,"Required Issue Mult: ",$P(PRIMITEM,"^",25)
|
|---|
| 30 | . I $P(PRIMITEM,"^",17) W !?4,"Minimum Issue Qty: ",$P(PRIMITEM,"^",17)
|
|---|
| 31 | . ;
|
|---|
| 32 | . S SECOITEM=$G(^PRCP(445,PRCPSECO,1,ITEMDA,0))
|
|---|
| 33 | . W !!,"Data for SECONDARY inventory point: ",$P(PRCPORD(0),"^",3)
|
|---|
| 34 | . I SECOITEM="" S CONV=1 W !?5,"ITEM NOT STORED IN SECONDARY INVENTORY POINT",!
|
|---|
| 35 | . ;
|
|---|
| 36 | . I SECOITEM'="" D
|
|---|
| 37 | . . W !?5,"Quantity On-Hand: ",+$P(SECOITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPSECO,ITEMDA," per ")
|
|---|
| 38 | . . S VDATA=$$GETVEN^PRCPUVEN(PRCPSECO,ITEMDA,PRCPPRIM_";PRCP(445,",1),UNITR=$$UNITVAL^PRCPUX1(+$P(VDATA,"^",3),$P(VDATA,"^",2)," per "),CONV=$P(VDATA,"^",4)
|
|---|
| 39 | . . W !?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPSECO,ITEMDA),?40,"Unit per Recpt: ",UNITR,!?37,"Conversion Factor: ",CONV
|
|---|
| 40 | . ;
|
|---|
| 41 | . ; enter data
|
|---|
| 42 | . I '$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",3) S $P(^(0),"^",3)=UNITCOST
|
|---|
| 43 | . S BEFORQTY=+$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
|
|---|
| 44 | . D ITEMEDIT^PRCPOPUS(ORDERDA,ITEMDA,0)
|
|---|
| 45 | . S AFTERQTY=+$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
|
|---|
| 46 | . ;
|
|---|
| 47 | . ; if status is released and beginning qty '= current qty
|
|---|
| 48 | . ; update dueins and dueouts
|
|---|
| 49 | . I $P(PRCPORD(0),"^",6)'="",BEFORQTY'=AFTERQTY D DUEOUTIN^PRCPOPU(PRCPPRIM,PRCPSECO,ITEMDA,$S(AFTERQTY<0:0,1:AFTERQTY)-BEFORQTY,1)
|
|---|
| 50 | . ;
|
|---|
| 51 | . I AFTERQTY=0 D DELITEM^PRCPOPD(ORDERDA,ITEMDA) W !!,"** ITEM HAS BEEN DELETED FROM THE ORDER **" Q
|
|---|
| 52 | . I AFTERQTY>0,AFTERQTY<$P(PRIMITEM,"^",17) W !,"WARNING -- THE QUANTITY IS LESS THAN THE MINIMUM ISSUE QUANTITY"
|
|---|
| 53 | . I $P(PRIMITEM,"^",25)>0 S %=AFTERQTY/$P(PRIMITEM,"^",25) I $P(%,".",2)>0 W !,"WARNING -- THE QUANTITY IS NOT A CORRECT REQUIRED ISSUE MULTIPLE"
|
|---|
| 54 | Q
|
|---|
