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