source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUTRA.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCPUTRA ;WISC/RFJ-outstanding transaction and duein update ;20 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 ;
7ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
8 ; PRCPDATA=qtyordered^unitofreceipt^pkgmult^convfact
9 I '+PRCPDATA Q
10 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
11 I $D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)) Q
12 N %,D0,DA,DATA,DD,DIC,DINUM,DLAYGO,X,Y
13 S:'$D(^PRCP(445,INVPT,1,ITEMDA,7,0)) ^(0)="^445.09P^^"
14 S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,",(X,DINUM)=TRANDA,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445
15 D FILE^DICN Q:Y<1
16 I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
17 L +^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
18 S ^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)_"^"_PRCPDATA
19 D SETIN^PRCPUDUE(INVPT,ITEMDA,+PRCPDATA)
20 L -^PRCP(445,INVPT,1,ITEMDA,7,TRANDA)
21 Q
22 ;
23 ;
24KILLTRAN(INVPT,ITEMDA,TRANDA) ; kill outstanding transaction
25 I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
26 N %,DIK,DA,DIC,QTY,X,Y
27 S QTY=$P(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)
28 I QTY D SETIN^PRCPUDUE(INVPT,ITEMDA,-QTY)
29 S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",7,",DA=TRANDA,DA(1)=ITEMDA,DA(2)=INVPT
30 D ^DIK
31 Q
32 ;
33 ;
34OUTST(INVPT,ITEMDA,TRANDA,QTY) ; add qty to outstanding transaction,
35 ; update duein
36 I 'QTY Q
37 I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) Q
38 N %,DATA,NEWQTY
39 S DATA=^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),NEWQTY=$P(DATA,"^",2)+QTY
40 I NEWQTY<0 S NEWQTY=0,QTY=-$P(DATA,"^",2)
41 S $P(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0),"^",2)=NEWQTY
42 I QTY D SETIN^PRCPUDUE(INVPT,ITEMDA,QTY)
43 ; kill transaction if duein is zero
44 I NEWQTY=0 D KILLTRAN(INVPT,ITEMDA,TRANDA)
45 Q
46 ;
47 ;
48ADDUPD(INVPT,ITEMDA,TRANDA,PRCPDATA) ; create outstanding transacation duein
49 ; prcpdata=qtyordered^unitofreceipt^pkgmult^convfact
50 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
51 I '$D(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0)) D ADDTRAN(INVPT,ITEMDA,TRANDA,PRCPDATA) Q
52 D OUTST(INVPT,ITEMDA,TRANDA,$P(PRCPDATA,"^"))
53 Q
54 ;
55 ;
56CHECKOUT(INVPT,ITEMDA,TRANDA) ; check outstanding transaction
57 ; returns => outstdata=vendor^pkgmult^unitreceipt^convfactor
58 ; => outsterr=error message
59 ; if outstdata and outsterr not defined, outstanding transaction is correct
60 K OUTSTERR,OUTSDATA
61 N %,OUTST,V,VENDATA,VENDOR
62 S OUTST=$G(^PRCP(445,INVPT,1,ITEMDA,7,TRANDA,0))
63 I OUTST="" S OUTSTERR="OUTSTANDING TRANSACTION NOT FOUND IN INVENTORY POINT." Q
64 S VENDOR=$P($G(^PRCS(410,TRANDA,3)),"^",4)
65 I 'VENDOR S OUTSTERR="VENDOR NOT SPECIFIED FOR OUTSTANDING TRANSACTION (FILE 441, FIELD 12)." Q
66 S VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR_";PRC(440,",0)
67 I 'VENDATA S OUTSTERR="VENDOR NOT INCLUDED AS A PROCUREMENT SOURCE FOR THIS ITEM." Q
68 S %=$$UNITVAL^PRCPUX1($P(VENDATA,"^",3),$P(VENDATA,"^",2)," per ")
69 I %["?" S OUTSTERR="PROCUREMENT SOURCE'S UNIT per RECEIPT ("_%_") IS INCORRECT." Q
70 I '$P(VENDATA,"^",4) S OUTSTERR="PROCUREMENT SOURCE'S CONVERSION FACTOR IS NOT DEFINED." Q
71 I $P(OUTST,"^",3,5)=$P(VENDATA,"^",2,4) Q
72 S OUTSDATA=VENDOR_"^"_$P(VENDATA,"^",3)_"^"_$P(VENDATA,"^",2)_"^"_$P(VENDATA,"^",4)
73 Q
Note: See TracBrowser for help on using the repository browser.