RMPRPIYW ;HINCIO/ODJ - PIP Data Entry - Transfer;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** FLOCNM - Prompt for 'FROM' location
FLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
D NOW^%DTC S RMPRTDT=X
S RMPREXC=""
S RMPRERR=0
S DIR(0)="FOA^1:30"
S DIR("A")="From Location: "
S DIR("?")="^D QM^RMPRPIYB"
S DIR("??")="^D QM2^RMPRPIYB"
FLOCNM1 D ^DIR
I $D(DTOUT) S RMPREXC="T" G FLOCNMX
I $D(DIROUT) S RMPREXC="P" G FLOCNMX
I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G FLOCNMX
K RMPR5
S RMPR5("STATION")=RMPRSTN
S RMPR5("NAME")=X
D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
I $G(RMPR5("IEN"))="" D G FLOCNM1
. W !,"Please enter a valid Location"
. Q
FLOCNMX Q RMPRERR
;
;***** TLOCNM - Prompt for 'TO' Location
TLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
D NOW^%DTC S RMPRTDT=X
S RMPREXC=""
S RMPRERR=0
S DIR(0)="FOA^1:30"
S DIR("A")="Enter Receiving Location: "
S DIR("?")="^D QM^RMPRPIYB"
S DIR("??")="^D QM2^RMPRPIYB"
TLOCNM1 D ^DIR
I $D(DTOUT) S RMPREXC="T" G TLOCNMX
I $D(DIROUT) S RMPREXC="P" G TLOCNMX
I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G TLOCNMX
K RMPR5
S RMPR5("STATION")=RMPRSTN
S RMPR5("NAME")=X
D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
I $G(RMPR5("IEN"))="" D G TLOCNM1
. W !,"Please enter a valid Location"
. Q
TLOCNMX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYW 1430 printed Oct 16, 2024@18:37:57 Page 2
RMPRPIYW ;HINCIO/ODJ - PIP Data Entry - Transfer;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** FLOCNM - Prompt for 'FROM' location
FLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
+1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
+2 DO NOW^%DTC
SET RMPRTDT=X
+3 SET RMPREXC=""
+4 SET RMPRERR=0
+5 SET DIR(0)="FOA^1:30"
+6 SET DIR("A")="From Location: "
+7 SET DIR("?")="^D QM^RMPRPIYB"
+8 SET DIR("??")="^D QM2^RMPRPIYB"
FLOCNM1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO FLOCNMX
+2 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO FLOCNMX
+3 IF X=""!(X["^")!($DATA(DUOUT))
SET RMPREXC="^"
GOTO FLOCNMX
+4 KILL RMPR5
+5 SET RMPR5("STATION")=RMPRSTN
+6 SET RMPR5("NAME")=X
+7 DO LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
+8 IF $GET(RMPR5("IEN"))=""
Begin DoDot:1
+9 WRITE !,"Please enter a valid Location"
+10 QUIT
End DoDot:1
GOTO FLOCNM1
FLOCNMX QUIT RMPRERR
+1 ;
+2 ;***** TLOCNM - Prompt for 'TO' Location
TLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
+1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
+2 DO NOW^%DTC
SET RMPRTDT=X
+3 SET RMPREXC=""
+4 SET RMPRERR=0
+5 SET DIR(0)="FOA^1:30"
+6 SET DIR("A")="Enter Receiving Location: "
+7 SET DIR("?")="^D QM^RMPRPIYB"
+8 SET DIR("??")="^D QM2^RMPRPIYB"
TLOCNM1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO TLOCNMX
+2 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO TLOCNMX
+3 IF X=""!(X["^")!($DATA(DUOUT))
SET RMPREXC="^"
GOTO TLOCNMX
+4 KILL RMPR5
+5 SET RMPR5("STATION")=RMPRSTN
+6 SET RMPR5("NAME")=X
+7 DO LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
+8 IF $GET(RMPR5("IEN"))=""
Begin DoDot:1
+9 WRITE !,"Please enter a valid Location"
+10 QUIT
End DoDot:1
GOTO TLOCNM1
TLOCNMX QUIT RMPRERR
