| [613] | 1 | PRCPWI ;WISC/RFJ-increment/decrement due-ins/due-outs for a 2237 ;09 Sep 91
|
|---|
| 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 | EN2 ; increment due-ins/due-outs and outstanding transactions
|
|---|
| 8 | ; da=internal entry number to 410
|
|---|
| 9 | N %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA,V,VENDATA,CONV
|
|---|
| 10 | S:'$D(DA) DA=0 S TRAN=$G(^PRCS(410,+DA,0)),FORM=$P(TRAN,"^",4) I FORM<3 Q
|
|---|
| 11 | S INVPT=$P(TRAN,"^",6) Q:'$D(^PRCP(445,+INVPT,0)) S VENDOR=+$P($G(^PRCS(410,DA,3)),"^",4)_";PRC(440," Q:+VENDOR=0
|
|---|
| 12 | ; get whse inv point for issue books (due-outs)
|
|---|
| 13 | K WHSE I $P(TRAN,"^",4)=5 S %=0 F S %=$O(^PRCP(445,"AC","W",%)) Q:'% I +$G(^PRCP(445,+%,0))=$P(TRAN,"^",5) S WHSE=% Q
|
|---|
| 14 | ; loop items in transaction
|
|---|
| 15 | W !!?4,"incrementing due-ins in inventory point: ",$P($$INVNAME^PRCPUX1(INVPT),"-",2,99)
|
|---|
| 16 | I $D(WHSE) W !?4,"incrementing due-outs in inventory point: ",$P($$INVNAME^PRCPUX1(WHSE),"-",2,99)
|
|---|
| 17 | S PRCPLI=0 F S PRCPLI=$O(^PRCS(410,DA,"IT",PRCPLI)) Q:'PRCPLI S PRCPDATA=$G(^(PRCPLI,0)),ITEMDA=+$P(PRCPDATA,"^",5),QTY=+$P(PRCPDATA,"^",2) I QTY>0 D
|
|---|
| 18 | . ; increment due-outs if issue book request and warehouse inv point
|
|---|
| 19 | . I $D(WHSE),$D(^PRCP(445,WHSE,1,ITEMDA,0)) D SETOUT^PRCPUDUE(WHSE,ITEMDA,QTY)
|
|---|
| 20 | . ; increment due-ins
|
|---|
| 21 | . I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
|
|---|
| 22 | . S VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR,1),QTY=QTY*$P(VENDATA,"^",4)
|
|---|
| 23 | . S:'+$P(VENDATA,"^",2) $P(VENDATA,"^",2)=$P(PRCPDATA,"^",3) S:'+$P(VENDATA,"^",3) $P(VENDATA,"^",3)=1
|
|---|
| 24 | . ; add/update outstanding transaction and due-ins
|
|---|
| 25 | . D ADDUPD^PRCPUTRA(INVPT,ITEMDA,DA,QTY_"^"_$P(VENDATA,"^",2,4))
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | EN3 ; decrement due-ins/due-outs and outstanding transactions
|
|---|
| 30 | ; for return to service
|
|---|
| 31 | ; da=internal entry number to 410
|
|---|
| 32 | N %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA
|
|---|
| 33 | S:'$D(DA) DA=0 S TRAN=$G(^PRCS(410,+DA,0)),FORM=$P(TRAN,"^",4) I FORM<3 Q
|
|---|
| 34 | S INVPT=$P(TRAN,"^",6) Q:'$D(^PRCP(445,+INVPT,0)) S VENDOR=+$P($G(^PRCS(410,DA,3)),"^",4)_";PRC(440," Q:+VENDOR=0
|
|---|
| 35 | ; get whse inv point for issue books (due-outs)
|
|---|
| 36 | K WHSE I $P(TRAN,"^",4)=5 S %=0 F S %=$O(^PRCP(445,"AC","W",%)) Q:'% I +$G(^PRCP(445,+%,0))=$P(TRAN,"^",5) S WHSE=% Q
|
|---|
| 37 | ; loop items in transaction
|
|---|
| 38 | W !!?4,"decrementing due-ins in inventory point: ",$P($$INVNAME^PRCPUX1(INVPT),"-",2,99)
|
|---|
| 39 | I $D(WHSE) W !?4,"decrementing due-outs in inventory point: ",$P($$INVNAME^PRCPUX1(WHSE),"-",2,99)
|
|---|
| 40 | S PRCPLI=0 F S PRCPLI=$O(^PRCS(410,DA,"IT",PRCPLI)) Q:'PRCPLI S PRCPDATA=$G(^(PRCPLI,0)),ITEMDA=+$P(PRCPDATA,"^",5),QTY=+$P(PRCPDATA,"^",2) I QTY>0 D
|
|---|
| 41 | . ; decrement due-outs if issue book request and warehouse inv point
|
|---|
| 42 | . I $D(WHSE),$D(^PRCP(445,WHSE,1,ITEMDA,0)) D SETOUT^PRCPUDUE(WHSE,ITEMDA,-QTY)
|
|---|
| 43 | . ; decrement due-ins and kill outstanding transaction
|
|---|
| 44 | . D KILLTRAN^PRCPUTRA(INVPT,ITEMDA,DA)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
| 48 | SPLIT(INVPT,ITEMDA,OLDTRAN,TRANDA) ; split request (called from prchsp)
|
|---|
| 49 | ; oldtran=old trans da, tranda=new trans da
|
|---|
| 50 | I '$D(^PRCP(445,+INVPT,1,+ITEMDA,7,+OLDTRAN,0)) Q
|
|---|
| 51 | S %=$P(^PRCP(445,INVPT,1,ITEMDA,7,OLDTRAN,0),"^",2,5) D ADDTRAN^PRCPUTRA(INVPT,ITEMDA,TRANDA,%),KILLTRAN^PRCPUTRA(INVPT,ITEMDA,OLDTRAN)
|
|---|
| 52 | Q
|
|---|
