source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPENE2.m@ 1226

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1PRCPENE2 ;WISC/RFJ-enter/edit inv parameters (list manager) ;06 Jan 94
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DISTRPTS ; edit distribution points
8 D FULL^VALM1
9 N CLREND,COLUMN,INVPT,FLAG,LINE,PRCPDATA
10 F W ! S INVPT=$$INVPT^PRCPUINV(PRC("SITE"),$S(PRCPTYPE="W":"P",1:"S"),1,1,"") Q:'INVPT D
11 . I '$D(^PRCP(445,PRCPINPT,2,INVPT)) D I %<1 Q
12 . . S FLAG=0
13 . . I PRCPTYPE="P" D I FLAG Q
14 . . . N PRCPSB S PRCPSB=0
15 . . . S PRCPSB=$O(^PRCP(445,"AB",INVPT,PRCPSB))
16 . . . I PRCPSB D EN^DDIOL("This secondary is already stocked by "_$$INVNAME^PRCPUX1(PRCPSB)_".") S FLAG=1,%=0 Q
17 . . S XP="THIS INVENTORY IS NOT BEING STOCKED BY "_$$INVNAME^PRCPUX1(PRCPINPT)_".",XP(1)="DO YOU WANT TO MAKE IT A DISTRIBUTION POINT"
18 . . W ! S %=$$YN^PRCPUYN(2) I %'=1 Q
19 . . D ADD^PRCPENU1(PRCPINPT,INVPT) S %=1
20 . N PRCPINPT,PRCPTYPE
21 . S PRCPINPT=INVPT,PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
22 . I '$D(^PRCP(445,PRCPINPT,4,DUZ,0)) W !,"YOU ARE NOT AN AUTHORIZED USER FOR THIS INVENTORY POINT." Q
23 . I '$$KEY^PRCPUREP("PRCP"_$TR(PRCPTYPE,"WSP","W2")_" MGRKEY",DUZ)
24 . L +^PRCP(445,PRCPINPT,0):1 I '$T D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",0)
25 . I PRCPTYPE="S" L +^PRCP(445,PRCPINPT,5):1 I '$T D Q
26 . . D SHOWWHO^PRCPULOC(445,PRCPINPT_"-0",5)
27 . . L -^PRCP(445,PRCPINPT,0)
28 . D ADD^PRCPULOC(445,PRCPINPT_"-0",0,"Enter/Edit Inventory Parameters")
29 . I PRCPTYPE="S" D ADD^PRCPULOC(445,PRCPINPT_"-5",0,"Enter/Edit Inventory Parameters")
30 . D EN^VALM("PRCP INVENTORY PARAMETERS")
31 . D CLEAR^PRCPULOC(445,PRCPINPT_"-0",0)
32 . I PRCPTYPE="S" D CLEAR^PRCPULOC(445,PRCPINPT_"-5",0)
33 . L -^PRCP(445,PRCPINPT,0)
34 . I PRCPTYPE="S" L -^PRCP(445,PRCPINPT,5)
35 D INIT^PRCPENLM
36 S VALMBCK="R"
37 Q
38 ;
39 ;
40STOCKED ; edit who stocks inventory point
41 D FULL^VALM1
42 N DA,DATA,DINUM,INVPT,INVPTNM,PRCPINNM,PRCPFLAG,SCREEN,X
43 S PRCPINNM=$$INVNAME^PRCPUX1(PRCPINPT)
44 W !!,"CHECKING INVENTORY POINTS DISTRIBUTING TO '",PRCPINNM,"':" W:PRCPTYPE="W" !,"(THERE SHOULD NOT BE ANY)"
45 S SCREEN=$P($G(^DD(445.03,.01,0)),"^",5,99)
46 S DA=0 F S DA=$O(^PRCP(445,"AB",PRCPINPT,DA)) Q:'DA S DATA=$G(^PRCP(445,DA,0)) I DATA D
47 . W !?5,$P(DATA,"^"),?40,"TYPE: ",$S($P(DATA,"^",3)="W":"WAREHOUSE",$P(DATA,"^",3)="P":"PRIMARY",$P(DATA,"^",3)="S":"SECONDARY",1:"??")
48 . I SCREEN="" Q
49 . S X=PRCPINPT X SCREEN I $D(X) Q
50 . D DELETE^PRCPENU1(DA,PRCPINPT)
51 ;
52 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
53 . I $D(^PRCP(445,INVPT,2,PRCPINPT)) D Q
54 . . 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"
55 . . S XH="ENTER 'YES' TO REMOVE IT, 'NO' TO LEAVE IT AS A DISTRIBUTION POINT."
56 . . W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
57 . . I %=1 D DELETE^PRCPENU1(INVPT,PRCPINPT)
58 . ;
59 . 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."
60 . W ! S %=$$YN^PRCPUYN(1) I '% S PRCPFLAG=1 Q
61 . I %=1 D ADD^PRCPENU1(INVPT,PRCPINPT)
62 ;
63 I PRCPTYPE="S" D
64 . ; restrict update if supply station IP has regular orders
65 . S SCREEN=$P($G(^PRCP(445,PRCPINPT,5)),"^",1) ; supply station?
66 . I SCREEN]"" S SCREEN=$$ORDCHK^PRCPUITM(0,PRCPINPT,"R","")
67 . I 'SCREEN D
68 . . W ! S INVPT=0
69 . . F S INVPT=$O(^PRCP(445,"AB",PRCPINPT,INVPT)) Q:'INVPT!($G(PRCPFLAG)) D
70 . . . S INVPTNM=$$INVNAME^PRCPUX1(INVPT)
71 . . . S XP="THIS SECONDARY INVENTORY POINT, '"_PRCPINNM_"', IS CURRENTLY DISTRIBUTED"
72 . . . S XP(1)="TO BY THE PRIMARY INVENTORY POINT, '"_INVPTNM_"'."
73 . . . S XP(2)=" DO YOU WANT TO REMOVE IT AS A PRIMARY DISTRIBUTION POINT"
74 . . . S XH="ENTER 'YES' TO REMOVE IT, 'NO' TO LEAVE IT AS A DISTRIBUTION POINT."
75 . . . W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
76 . . . I %=1 D DELETE^PRCPENU1(INVPT,PRCPINPT)
77 . I SCREEN D
78 . . W ! S INVPT=0
79 . . S INVPT=$O(^PRCP(445,"AB",PRCPINPT,INVPT)),INVPTNM=$$INVNAME^PRCPUX1(INVPT)
80 . . D EN^DDIOL("THIS SECONDARY INVENTORY POINT, '"_PRCPINNM_"', IS STOCKED BY THE PRIMARY")
81 . . D EN^DDIOL("INVENTORY POINT, '"_INVPTNM_"', AND HAS OUTSTANDING REGULAR ORDERS.")
82 . . D EN^DDIOL(" You must post or delete these orders before removing the primary")
83 . . D EN^DDIOL(" distribution point.")
84 . . D P^PRCPUREP ; pause to allow user to see message
85 ;
86 D INIT^PRCPENLM
87 S VALMBCK="R"
88 Q
Note: See TracBrowser for help on using the repository browser.