source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPENU1.m@ 810

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

initial load of WorldVistAEHR

File size: 761 bytes
Line 
1PRCPENU1 ;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 ;
7DELETE(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 ;
15ADD(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
Note: See TracBrowser for help on using the repository browser.