| 1 | PRCPENU1 ;WISC/RFJ-utility for distribution point edit ;06 Jan 94
|
|---|
| 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 | DELETE(INVPT,DISTRPT) ; delete distrpt from invpt
|
|---|
| 8 | I '$D(^PRCP(445,+INVPT,2,+DISTRPT)) Q
|
|---|
| 9 | N DA,DIC,DIK
|
|---|
| 10 | S DIK="^PRCP(445,"_(+INVPT)_",2,",DA(1)=+INVPT,DA=+DISTRPT
|
|---|
| 11 | D ^DIK
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | ADD(INVPT,DISTRPT) ; add distrpt for invpt
|
|---|
| 16 | I '$D(^PRCP(445,+INVPT,0)) Q
|
|---|
| 17 | I '$D(^PRCP(445,+DISTRPT,0)) Q
|
|---|
| 18 | N D0,DA,DD,DIC,DINUM,DLAYGO,X,Y
|
|---|
| 19 | I '$D(^PRCP(445,+INVPT,2,0)) S ^(0)="^445.03PA^^"
|
|---|
| 20 | S DIC="^PRCP(445,"_(+INVPT)_",2,",DIC(0)="L",DLAYGO=445,DA(1)=+INVPT,(X,DINUM)=+DISTRPT,PRCPPRIV=1
|
|---|
| 21 | D FILE^DICN K PRCPPRIV
|
|---|
| 22 | I Y<1 W !," UNABLE TO ADD INVENTORY POINT AS A WAREHOUSE DISTRIBUTION POINT."
|
|---|
| 23 | Q
|
|---|
