PRCPENU1 ;WISC/RFJ-utility for distribution point edit ;06 Jan 94
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
DELETE(INVPT,DISTRPT) ; delete distrpt from invpt
I '$D(^PRCP(445,+INVPT,2,+DISTRPT)) Q
N DA,DIC,DIK
S DIK="^PRCP(445,"_(+INVPT)_",2,",DA(1)=+INVPT,DA=+DISTRPT
D ^DIK
Q
;
;
ADD(INVPT,DISTRPT) ; add distrpt for invpt
I '$D(^PRCP(445,+INVPT,0)) Q
I '$D(^PRCP(445,+DISTRPT,0)) Q
N D0,DA,DD,DIC,DINUM,DLAYGO,X,Y
I '$D(^PRCP(445,+INVPT,2,0)) S ^(0)="^445.03PA^^"
S DIC="^PRCP(445,"_(+INVPT)_",2,",DIC(0)="L",DLAYGO=445,DA(1)=+INVPT,(X,DINUM)=+DISTRPT,PRCPPRIV=1
D FILE^DICN K PRCPPRIV
I Y<1 W !," UNABLE TO ADD INVENTORY POINT AS A WAREHOUSE DISTRIBUTION POINT."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPENU1 784 printed Dec 13, 2024@02:13:49 Page 2
PRCPENU1 ;WISC/RFJ-utility for distribution point edit ;06 Jan 94
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
DELETE(INVPT,DISTRPT) ; delete distrpt from invpt
+1 IF '$DATA(^PRCP(445,+INVPT,2,+DISTRPT))
QUIT
+2 NEW DA,DIC,DIK
+3 SET DIK="^PRCP(445,"_(+INVPT)_",2,"
SET DA(1)=+INVPT
SET DA=+DISTRPT
+4 DO ^DIK
+5 QUIT
+6 ;
+7 ;
ADD(INVPT,DISTRPT) ; add distrpt for invpt
+1 IF '$DATA(^PRCP(445,+INVPT,0))
QUIT
+2 IF '$DATA(^PRCP(445,+DISTRPT,0))
QUIT
+3 NEW D0,DA,DD,DIC,DINUM,DLAYGO,X,Y
+4 IF '$DATA(^PRCP(445,+INVPT,2,0))
SET ^(0)="^445.03PA^^"
+5 SET DIC="^PRCP(445,"_(+INVPT)_",2,"
SET DIC(0)="L"
SET DLAYGO=445
SET DA(1)=+INVPT
SET (X,DINUM)=+DISTRPT
SET PRCPPRIV=1
+6 DO FILE^DICN
KILL PRCPPRIV
+7 IF Y<1
WRITE !," UNABLE TO ADD INVENTORY POINT AS A WAREHOUSE DISTRIBUTION POINT."
+8 QUIT
