RMPRPIYN ;HINCIO/ODJ - EL - Edit Location ;3/8/01
;;3.0;PROSTHETICS;**61,154**;Feb 09, 1996;Build 6
Q
;
;***** EL - Edit Inventory LOCATION
; no inputs required
; other than standard VISTA vars. (DUZ, etc)
;
EL N RMPRERR,RMPRSTN,RMPREXC,RMPR5
;
;***** STN - call prompt for Site/Station
STN S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
I RMPRERR G ELX
I RMPREXC'="" G ELX
;
;***** LOCN - call prompt for Location
LOCN W @IOF,!!,"Editing an Inventory Location.....",!
LOCN1 D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
I RMPREXC="T"!(RMPREXC="^") G ELX
I RMPREXC="P" G STN
S RMPR5("STATION")=RMPRSTN("IEN")
S RMPR5("STATION IEN")=RMPRSTN("IEN")
;
;***** LOCN2 - call prompt to change Location name
LOCN2 W ! D EDLOC(.RMPR5,.RMPREXC)
I RMPREXC="T" G ELX
I RMPREXC'="" G LOCN
G ELX
;
;***** exit points
ELX D KILL^XUSCLEAN
Q
;
;***** EDLOC - prompt for change of Location name
EDLOC(RMPR5,RMPREXC) ;
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRNEWN,RMPR5N,RMPRERR
S RMPREXC=""
S DIR(0)="FOA^3:30"
S DIR("A")="LOCATION: "
S DIR("B")=RMPR5("NAME")
S DIR("?")="Answer must be 3-30 characters in length."
S DIR("??")="^D ELQQM^RMPRPIYN"
EDLOC1 D ^DIR
I $D(DTOUT) S RMPREXC="T" G EDLOCX
I $D(DIROUT) S RMPREXC="P" G EDLOCX
I X=""!(X["^") S RMPREXC="^" G EDLOCX
I $E(X)="@" W !,"Cannot delete location, only deactivate" K X G EDLOC1
I X=RMPR5("NAME") G EDLOCX
L +^RMPR(661.5,RMPR5("IEN")):0 E D G EDLOCX
. W !,"Location being edited by another user, cannot continue."
. H 2
. S RMPREXC="P"
. Q
I $D(^RMPR(661.5,"XSL",RMPR5("STATION"),X)) D G EDLOCU
. W !,"Location name already in use, cannot continue.",!
. H 2
. S RMPREXC="P"
. Q
S RMPRNEWN=X
D ELOK(.RMPRYN,.RMPREXC)
I RMPREXC="T" G EDLOCU
I RMPREXC'=""!(RMPRYN="N") S RMPREXC="" L -^RMPR(661.5,RMPR5("IEN")) G EDLOC1
S RMPR5N("IEN")=RMPR5("IEN")
S RMPR5N("NAME")=RMPRNEWN
S RMPRERR=$$UPD^RMPRPIX5(.RMPR5N)
W !
W "Location has been edited from '"_RMPR5("NAME")_"'"
W " to '"_RMPRNEWN_"' !!!"
H 2
EDLOCU L -^RMPR(661.5,RMPR5("IEN"))
EDLOCX Q
ELQQM W !,"This is a location of an item or stock being tracked for inventory."
Q
;
; Y/N Prompt to confirm change of Location Name
ELOK(RMPRYN,RMPREXC) ;
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT
S RMPRYN="N"
S RMPREXC=""
S DIR(0)="Y"
S DIR("B")="N"
S DIR("A")="Are you sure you want to change the name of this location"
D ^DIR
I $D(DTOUT) S RMPREXC="T" G ELOKX
I $D(DIROUT) S RMPREXC="P" G ELOKX
I X=""!(X["^") S RMPREXC="^" G ELOKX
S RMPRYN="N" S:Y RMPRYN="Y"
ELOKX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYN 2633 printed Nov 22, 2024@17:47:10 Page 2
RMPRPIYN ;HINCIO/ODJ - EL - Edit Location ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,154**;Feb 09, 1996;Build 6
+2 QUIT
+3 ;
+4 ;***** EL - Edit Inventory LOCATION
+5 ; no inputs required
+6 ; other than standard VISTA vars. (DUZ, etc)
+7 ;
EL NEW RMPRERR,RMPRSTN,RMPREXC,RMPR5
+1 ;
+2 ;***** STN - call prompt for Site/Station
STN SET RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
+1 IF RMPRERR
GOTO ELX
+2 IF RMPREXC'=""
GOTO ELX
+3 ;
+4 ;***** LOCN - call prompt for Location
LOCN WRITE @IOF,!!,"Editing an Inventory Location.....",!
LOCN1 DO LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
+1 IF RMPREXC="T"!(RMPREXC="^")
GOTO ELX
+2 IF RMPREXC="P"
GOTO STN
+3 SET RMPR5("STATION")=RMPRSTN("IEN")
+4 SET RMPR5("STATION IEN")=RMPRSTN("IEN")
+5 ;
+6 ;***** LOCN2 - call prompt to change Location name
LOCN2 WRITE !
DO EDLOC(.RMPR5,.RMPREXC)
+1 IF RMPREXC="T"
GOTO ELX
+2 IF RMPREXC'=""
GOTO LOCN
+3 GOTO ELX
+4 ;
+5 ;***** exit points
ELX DO KILL^XUSCLEAN
+1 QUIT
+2 ;
+3 ;***** EDLOC - prompt for change of Location name
EDLOC(RMPR5,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRNEWN,RMPR5N,RMPRERR
+2 SET RMPREXC=""
+3 SET DIR(0)="FOA^3:30"
+4 SET DIR("A")="LOCATION: "
+5 SET DIR("B")=RMPR5("NAME")
+6 SET DIR("?")="Answer must be 3-30 characters in length."
+7 SET DIR("??")="^D ELQQM^RMPRPIYN"
EDLOC1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO EDLOCX
+2 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO EDLOCX
+3 IF X=""!(X["^")
SET RMPREXC="^"
GOTO EDLOCX
+4 IF $EXTRACT(X)="@"
WRITE !,"Cannot delete location, only deactivate"
KILL X
GOTO EDLOC1
+5 IF X=RMPR5("NAME")
GOTO EDLOCX
+6 LOCK +^RMPR(661.5,RMPR5("IEN")):0
IF '$TEST
Begin DoDot:1
+7 WRITE !,"Location being edited by another user, cannot continue."
+8 HANG 2
+9 SET RMPREXC="P"
+10 QUIT
End DoDot:1
GOTO EDLOCX
+11 IF $DATA(^RMPR(661.5,"XSL",RMPR5("STATION"),X))
Begin DoDot:1
+12 WRITE !,"Location name already in use, cannot continue.",!
+13 HANG 2
+14 SET RMPREXC="P"
+15 QUIT
End DoDot:1
GOTO EDLOCU
+16 SET RMPRNEWN=X
+17 DO ELOK(.RMPRYN,.RMPREXC)
+18 IF RMPREXC="T"
GOTO EDLOCU
+19 IF RMPREXC'=""!(RMPRYN="N")
SET RMPREXC=""
LOCK -^RMPR(661.5,RMPR5("IEN"))
GOTO EDLOC1
+20 SET RMPR5N("IEN")=RMPR5("IEN")
+21 SET RMPR5N("NAME")=RMPRNEWN
+22 SET RMPRERR=$$UPD^RMPRPIX5(.RMPR5N)
+23 WRITE !
+24 WRITE "Location has been edited from '"_RMPR5("NAME")_"'"
+25 WRITE " to '"_RMPRNEWN_"' !!!"
+26 HANG 2
EDLOCU LOCK -^RMPR(661.5,RMPR5("IEN"))
EDLOCX QUIT
ELQQM WRITE !,"This is a location of an item or stock being tracked for inventory."
+1 QUIT
+2 ;
+3 ; Y/N Prompt to confirm change of Location Name
ELOK(RMPRYN,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT
+2 SET RMPRYN="N"
+3 SET RMPREXC=""
+4 SET DIR(0)="Y"
+5 SET DIR("B")="N"
+6 SET DIR("A")="Are you sure you want to change the name of this location"
+7 DO ^DIR
+8 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO ELOKX
+9 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO ELOKX
+10 IF X=""!(X["^")
SET RMPREXC="^"
GOTO ELOKX
+11 SET RMPRYN="N"
if Y
SET RMPRYN="Y"
ELOKX QUIT
