source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPOPEE.m@ 701

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCPOPEE ;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 ;
7EDIT ; edit distribution order
8 D FULL^VALM1
9 S VALMBCK="R"
10 D ITEMS(ORDERDA)
11 D INIT^PRCPOPL
12 Q
13 ;
14 ;
15ITEMS(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
Note: See TracBrowser for help on using the repository browser.