PRCPENE2 ;WISC/RFJ-enter/edit inv parameters (list manager)         ;06 Jan 94
V ;;5.1;IFCAP;**1**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
 ;
DISTRPTS ;  edit distribution points
 D FULL^VALM1
 N CLREND,COLUMN,INVPT,FLAG,LINE,PRCPDATA
 F  W ! S INVPT=$$INVPT^PRCPUINV(PRC("SITE"),$S(PRCPTYPE="W":"P",1:"S"),1,1,"") Q:'INVPT  D
 .   I '$D(^PRCP(445,PRCPINPT,2,INVPT)) D  I %<1 Q
 .   .   S FLAG=0
 .   .   I PRCPTYPE="P" D  I FLAG Q
 .   .   .   N PRCPSB S PRCPSB=0
 .   .   .   S PRCPSB=$O(^PRCP(445,"AB",INVPT,PRCPSB))
 .   .   .   I PRCPSB D EN^DDIOL("This secondary is already stocked by "_$$INVNAME^PRCPUX1(PRCPSB)_".") S FLAG=1,%=0 Q 
 .   .   S XP="THIS INVENTORY IS NOT BEING STOCKED BY "_$$INVNAME^PRCPUX1(PRCPINPT)_".",XP(1)="DO YOU WANT TO MAKE IT A DISTRIBUTION POINT"
 .   .   W ! S %=$$YN^PRCPUYN(2) I %'=1 Q
 .   .   D ADD^PRCPENU1(PRCPINPT,INVPT) S %=1
 .   N PRCPINPT,PRCPTYPE
 .   S PRCPINPT=INVPT,PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
 .   I '$D(^PRCP(445,PRCPINPT,4,DUZ,0)) W !,"YOU ARE NOT AN AUTHORIZED USER FOR THIS INVENTORY POINT." Q
 .   I '$$KEY^PRCPUREP("PRCP"_$TR(PRCPTYPE,"WSP","W2")_" MGRKEY",DUZ)
 .   L +^PRCP(445,PRCPINPT,0):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",0)
 .   I PRCPTYPE="S" L +^PRCP(445,PRCPINPT,5):1 I '$T D  Q
 .   .   D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",5)
 .   .   L -^PRCP(445,PRCPINPT,0)
 .   D ADD^PRCPULOC(445,PRCPINPT_"-0",0,"Enter/Edit Inventory Parameters")
 .   I PRCPTYPE="S" D ADD^PRCPULOC(445,PRCPINPT_"-5",0,"Enter/Edit Inventory Parameters")
 .   D EN^VALM("PRCP INVENTORY PARAMETERS")
 .   D CLEAR^PRCPULOC(445,PRCPINPT_"-0",0)
 .   I PRCPTYPE="S" D CLEAR^PRCPULOC(445,PRCPINPT_"-5",0)
 .   L -^PRCP(445,PRCPINPT,0)
 .   I PRCPTYPE="S" L -^PRCP(445,PRCPINPT,5)
 D INIT^PRCPENLM
 S VALMBCK="R"
 Q
 ;
 ;
STOCKED ;  edit who stocks inventory point
 D FULL^VALM1
 N DA,DATA,DINUM,INVPT,INVPTNM,PRCPINNM,PRCPFLAG,SCREEN,X
 S PRCPINNM=$$INVNAME^PRCPUX1(PRCPINPT)
 W !!,"CHECKING INVENTORY POINTS DISTRIBUTING TO '",PRCPINNM,"':" W:PRCPTYPE="W" !,"(THERE SHOULD NOT BE ANY)"
 S SCREEN=$P($G(^DD(445.03,.01,0)),"^",5,99)
 S DA=0 F  S DA=$O(^PRCP(445,"AB",PRCPINPT,DA)) Q:'DA  S DATA=$G(^PRCP(445,DA,0)) I DATA D
 .   W !?5,$P(DATA,"^"),?40,"TYPE: ",$S($P(DATA,"^",3)="W":"WAREHOUSE",$P(DATA,"^",3)="P":"PRIMARY",$P(DATA,"^",3)="S":"SECONDARY",1:"??")
 .   I SCREEN="" Q
 .   S X=PRCPINPT X SCREEN I $D(X) Q
 .   D DELETE^PRCPENU1(DA,PRCPINPT)
 ;
 I PRCPTYPE="P" W ! S INVPT=0 F  S INVPT=$O(^PRCP(445,"AC","W",INVPT)) Q:'INVPT!($G(PRCPFLAG))  S INVPTNM=$$INVNAME^PRCPUX1(INVPT) I +INVPTNM=PRC("SITE") D
 .   I $D(^PRCP(445,INVPT,2,PRCPINPT)) D  Q
 .   .   S XP="THIS PRIMARY INVENTORY POINT '"_PRCPINNM_"' IS CURRENTLY DISTRIBUTED",XP(1)="TO BY THE WAREHOUSE INVENTORY POINT '"_INVPTNM_"'.",XP(2)="  DO YOU WANT TO REMOVE IT AS A WAREHOUSE DISTRIBUTION POINT"
 .   .   S XH="ENTER 'YES' TO REMOVE IT, 'NO' TO LEAVE IT AS A DISTRIBUTION POINT."
 .   .   W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
 .   .   I %=1 D DELETE^PRCPENU1(INVPT,PRCPINPT)
 .   ;
 .   S XP="WILL THIS PRIMARY INVENTORY POINT '"_PRCPINNM_"' BE A",XP(1)="DISTRIBUTION POINT FOR THE WAREHOUSE INVENTORY POINT '"_INVPTNM_"'",XH="ENTER 'YES' TO ADD THE PRIMARY AS A WAREHOUSE DISTRIBUTION POINT."
 .   W ! S %=$$YN^PRCPUYN(1) I '% S PRCPFLAG=1 Q
 .   I %=1 D ADD^PRCPENU1(INVPT,PRCPINPT)
 ;
 I PRCPTYPE="S" D
 .   ; restrict update if supply station IP has regular orders
 .   S SCREEN=$P($G(^PRCP(445,PRCPINPT,5)),"^",1) ; supply station?
 .   I SCREEN]"" S SCREEN=$$ORDCHK^PRCPUITM(0,PRCPINPT,"R","")
 .   I 'SCREEN D
 .   .   W ! S INVPT=0
 .   .   F  S INVPT=$O(^PRCP(445,"AB",PRCPINPT,INVPT)) Q:'INVPT!($G(PRCPFLAG))  D
 .   .   .   S INVPTNM=$$INVNAME^PRCPUX1(INVPT)
 .   .   .   S XP="THIS SECONDARY INVENTORY POINT, '"_PRCPINNM_"', IS CURRENTLY DISTRIBUTED"
 .   .   .   S XP(1)="TO BY THE PRIMARY INVENTORY POINT, '"_INVPTNM_"'."
 .   .   .   S XP(2)="  DO YOU WANT TO REMOVE IT AS A PRIMARY DISTRIBUTION POINT"
 .   .   .   S XH="ENTER 'YES' TO REMOVE IT, 'NO' TO LEAVE IT AS A DISTRIBUTION POINT."
 .   .   .   W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
 .   .   .   I %=1 D DELETE^PRCPENU1(INVPT,PRCPINPT)
 .   I SCREEN D
 .   .   W ! S INVPT=0
 .   .   S INVPT=$O(^PRCP(445,"AB",PRCPINPT,INVPT)),INVPTNM=$$INVNAME^PRCPUX1(INVPT)
 .   .   D EN^DDIOL("THIS SECONDARY INVENTORY POINT, '"_PRCPINNM_"', IS STOCKED BY THE PRIMARY")
 .   .   D EN^DDIOL("INVENTORY POINT, '"_INVPTNM_"', AND HAS OUTSTANDING REGULAR ORDERS.")
 .   .   D EN^DDIOL("     You must post or delete these orders before removing the primary")
 .   .   D EN^DDIOL("     distribution point.")
 .   .   D P^PRCPUREP ; pause to allow user to see message
 ;
 D INIT^PRCPENLM
 S VALMBCK="R"
 Q