89 lines
4.6 KiB
Mathematica
89 lines
4.6 KiB
Mathematica
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
|