| [613] | 1 | PRCPOPU ;WISC/RFJ,DWA-distibution order utilities ;27 Sep 93
|
|---|
| 2 | ;;5.1;IFCAP;**27**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | VARIABLE ; set up order variables for orderda
|
|---|
| 8 | N DFN,VADM,VAERR
|
|---|
| 9 | S PRCPORD(0)=$G(^PRCP(445.3,ORDERDA,0)),PRCPORD(2)=$G(^PRCP(445.3,ORDERDA,2))
|
|---|
| 10 | S PRCPPRIM=+$P(PRCPORD(0),"^",2),PRCPSECO=+$P(PRCPORD(0),"^",3),PRCPPAT=+$P(PRCPORD(2),"^")
|
|---|
| 11 | S $P(PRCPORD(0),"^",2)=$$INVNAME^PRCPUX1(PRCPPRIM)
|
|---|
| 12 | S $P(PRCPORD(0),"^",3)=$$INVNAME^PRCPUX1(PRCPSECO)
|
|---|
| 13 | S DFN=PRCPPAT I $$VERSION^XPDUTL("DG") D DEM^VADPT
|
|---|
| 14 | S $P(PRCPORD(2),"^")=$G(VADM(1))
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | DUEOUTIN(PRCPPRIM,PRCPSECO,ITEMDA,QTY,PRINT) ;
|
|---|
| 19 | ; update the primary prcpprim itemda dueouts by qty (- to subtract);
|
|---|
| 20 | ; update the secondary prcpseco itemda dueins by qty*conv
|
|---|
| 21 | ; print=1 to display message
|
|---|
| 22 | N %
|
|---|
| 23 | ;
|
|---|
| 24 | I PRINT W !!,"<*> Updating DUE-OUTS in primary ",$$INVNAME^PRCPUX1(PRCPPRIM),?60," by ",QTY
|
|---|
| 25 | D SETOUT^PRCPUDUE(PRCPPRIM,ITEMDA,QTY)
|
|---|
| 26 | ;
|
|---|
| 27 | S QTY=QTY*$P($$GETVEN^PRCPUVEN(PRCPSECO,ITEMDA,PRCPPRIM_";PRCP(445,",1),"^",4)
|
|---|
| 28 | I PRINT W !,"<*> Updating DUE-INS in secondary ",$$INVNAME^PRCPUX1(PRCPSECO),?60," by ",QTY
|
|---|
| 29 | D SETIN^PRCPUDUE(PRCPSECO,ITEMDA,QTY)
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | STATUS(ORDERDA) ; return status of order
|
|---|
| 34 | N %
|
|---|
| 35 | S %=$P($G(^PRCP(445.3,+ORDERDA,0)),"^",6) I %'="" S %=$P($P($P(^DD(445.3,5,0),"^",3),%_":",2),";")
|
|---|
| 36 | I %="" S %="<< NOT RELEASED >>"
|
|---|
| 37 | Q %
|
|---|
| 38 | ;
|
|---|
| 39 | ;
|
|---|
| 40 | TYPE(ORDERDA) ; return type of order
|
|---|
| 41 | N %
|
|---|
| 42 | S %=$P($G(^PRCP(445.3,+ORDERDA,0)),"^",8) I %'="" S %=$P($P($P(^DD(445.3,3.5,0),"^",3),%_":",2),";")
|
|---|
| 43 | I %="" S %="<< NO TYPE >>"
|
|---|
| 44 | Q %
|
|---|
