| [613] | 1 | RMPRPIYW ;HINCIO/ODJ - PIP Data Entry - Transfer;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;***** FLOCNM - Prompt for 'FROM' location
|
|---|
| 6 | FLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
|
|---|
| 7 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
|
|---|
| 8 | D NOW^%DTC S RMPRTDT=X
|
|---|
| 9 | S RMPREXC=""
|
|---|
| 10 | S RMPRERR=0
|
|---|
| 11 | S DIR(0)="FOA^1:30"
|
|---|
| 12 | S DIR("A")="From Location: "
|
|---|
| 13 | S DIR("?")="^D QM^RMPRPIYB"
|
|---|
| 14 | S DIR("??")="^D QM2^RMPRPIYB"
|
|---|
| 15 | FLOCNM1 D ^DIR
|
|---|
| 16 | I $D(DTOUT) S RMPREXC="T" G FLOCNMX
|
|---|
| 17 | I $D(DIROUT) S RMPREXC="P" G FLOCNMX
|
|---|
| 18 | I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G FLOCNMX
|
|---|
| 19 | K RMPR5
|
|---|
| 20 | S RMPR5("STATION")=RMPRSTN
|
|---|
| 21 | S RMPR5("NAME")=X
|
|---|
| 22 | D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
|
|---|
| 23 | I $G(RMPR5("IEN"))="" D G FLOCNM1
|
|---|
| 24 | . W !,"Please enter a valid Location"
|
|---|
| 25 | . Q
|
|---|
| 26 | FLOCNMX Q RMPRERR
|
|---|
| 27 | ;
|
|---|
| 28 | ;***** TLOCNM - Prompt for 'TO' Location
|
|---|
| 29 | TLOCNM(RMPRSTN,RMPR5,RMPREXC) ;
|
|---|
| 30 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,RMPRYN,DA,RMPRTDT
|
|---|
| 31 | D NOW^%DTC S RMPRTDT=X
|
|---|
| 32 | S RMPREXC=""
|
|---|
| 33 | S RMPRERR=0
|
|---|
| 34 | S DIR(0)="FOA^1:30"
|
|---|
| 35 | S DIR("A")="Enter Receiving Location: "
|
|---|
| 36 | S DIR("?")="^D QM^RMPRPIYB"
|
|---|
| 37 | S DIR("??")="^D QM2^RMPRPIYB"
|
|---|
| 38 | TLOCNM1 D ^DIR
|
|---|
| 39 | I $D(DTOUT) S RMPREXC="T" G TLOCNMX
|
|---|
| 40 | I $D(DIROUT) S RMPREXC="P" G TLOCNMX
|
|---|
| 41 | I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G TLOCNMX
|
|---|
| 42 | K RMPR5
|
|---|
| 43 | S RMPR5("STATION")=RMPRSTN
|
|---|
| 44 | S RMPR5("NAME")=X
|
|---|
| 45 | D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
|
|---|
| 46 | I $G(RMPR5("IEN"))="" D G TLOCNM1
|
|---|
| 47 | . W !,"Please enter a valid Location"
|
|---|
| 48 | . Q
|
|---|
| 49 | TLOCNMX Q RMPRERR
|
|---|
