source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPWI.m@ 623

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRCPWI ;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 ;
7EN2 ; 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 ;
29EN3 ; 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 ;
48SPLIT(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
Note: See TracBrowser for help on using the repository browser.