RMPRPIYW.m

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 ---RMPRPIYW   1430     printed  Apr 09, 2024@21:35:36                                                                                                                                                                                                    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