| 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
 | 
|---|