1 | PRCPCSP ;WISC/RFJ/DXH - convert secondary to primary ;9.9.99
|
---|
2 | V ;;5.1;IFCAP;**1**;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; prcpflvl=1 => accept existing stock levels for some or all
|
---|
6 | ;
|
---|
7 | EN D ^PRCPUSEL Q:'$G(PRCP("I"))
|
---|
8 | I PRCP("DPTYPE")'="P" W !,"THIS OPTION SHOULD ONLY BE USED FROM WITHIN A PRIMARY INVENTORY POINT." Q
|
---|
9 | ;
|
---|
10 | N D0,DA,DATA,DELETE,DI,DIC,DIE,DIR,DQ,DR,EACHONE,ESCAPE,ITEMCNT,ITEMDA
|
---|
11 | N IMFDATA,INVPT,IPVND,LASTONE,NUMBER,PIECE,PRIM,PRCPINPT,PRCPITEM
|
---|
12 | N PRCPTYPE,UP,UR,VENDA,VENDATA,VENDOR,XH,XP
|
---|
13 | ASKNP ; ask for secondary inventory point to be converted
|
---|
14 | S PRIM=$$INVNAME^PRCPUX1(PRCP("I"))
|
---|
15 | K X
|
---|
16 | S X(1)="Select the SECONDARY inventory point to CONVERT."
|
---|
17 | S X(2)="It must be one of the DISTRIBUTION POINTS for "_PRIM_"."
|
---|
18 | W ! D DISPLAY^PRCPUX2(1,60,.X)
|
---|
19 | S INVPT=$$TO^PRCPUDPT(PRCP("I")) I 'INVPT Q
|
---|
20 | I '$D(^PRCP(445,INVPT,4,DUZ)) D G ASKNP
|
---|
21 | . K X
|
---|
22 | . S X(1)="ERROR: You are not an authorized user for this inventory point."
|
---|
23 | . D DISPLAY^PRCPUX2(5,75,.X)
|
---|
24 | S ITEMCNT=+$P($G(^PRCP(445,INVPT,1,0)),"^",4)
|
---|
25 | I 'ITEMCNT,'$O(^PRCP(445,INVPT,1,0)) D Q:$G(ESCAPE)
|
---|
26 | . K X
|
---|
27 | . S X(1)="There are no items stored in the selected secondary inventory point."
|
---|
28 | . S X(2)="Data base unchanged."
|
---|
29 | . S ESCAPE=1
|
---|
30 | . D DISPLAY^PRCPUX2(5,75,.X)
|
---|
31 | I $P($G(^PRCP(445,INVPT,5)),"^",1)]"" D QUIT
|
---|
32 | . K X
|
---|
33 | . S X(1)="This inventory point is linked to a supply station and cannot be converted."
|
---|
34 | . D DISPLAY^PRCPUX2(5,75,.X)
|
---|
35 | W !!?5,"Number of items currently stored: ",ITEMCNT
|
---|
36 | W !! K X
|
---|
37 | S X(1)="Existing PROCUREMENT and MANDATORY SOURCES for this secondary"
|
---|
38 | S X(2)="will be replaced with data taken from its supplying primary"
|
---|
39 | S X(3)="("_PRIM_") during the conversion. You can change these data"
|
---|
40 | S X(4)="later if you need to."
|
---|
41 | D DISPLAY^PRCPUX2(20,75,.X)
|
---|
42 | ;
|
---|
43 | D CONVRT^PRCPCSP1
|
---|
44 | Q
|
---|
45 | ;
|
---|
46 | HOLD ; can get here only from a crt
|
---|
47 | W !,"Press <RETURN> to continue, '^' to escape..." R X:DTIME
|
---|
48 | I '$T!($E(X)="^") S ESCAPE=1
|
---|
49 | Q
|
---|
50 | ;PRCPCSP
|
---|