- 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 Apr 23, 2025@18:27:49 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
