source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYW.m@ 1720

Last change on this file since 1720 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1RMPRPIYW ;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
6FLOCNM(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"
15FLOCNM1 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
26FLOCNMX Q RMPRERR
27 ;
28 ;***** TLOCNM - Prompt for 'TO' Location
29TLOCNM(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"
38TLOCNM1 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
49TLOCNMX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.