- 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 Mar 13, 2025@21:18:35 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
