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
|
---|