RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994
;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996
;
;RVD patch #53 only issue stock items from PIP
;
;RVD patch #62 pce interface, delete transaction if 2319 is deleted.
;
;RVD patch #61 PIP new files.
;
EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS
;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS
S RMPRF=1 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
;
EN2 ;Create 10-2421
S RMPRF=2 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
;
EN3 ;2520 Transaction without printing
S RMPRF=10 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 K RMPRAMT G EXIT
;
EN4 ;2914 EYEGLASS RECORD
;SETS FORM TYPE CODE FOR 2914
;VARIABLES REQUIRED: NONE
S RMPRF=8 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
;
EN5 ;CLOSE-OUT
S RMPRF="E" D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPRE21 G EXIT
;
EN6 ;NO-FORM DAILY RECORD
S RMPRF=9 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
;
EN7 ;ISSUE FROM STOCK
K RMPRDFN,RMPR
;patch #61 call rmprpiyi instead of rmprsti
S RMPRF=11 D ^RMPRPIYI G EXIT
;
EN9 ;PICKUP AND DELIVERY
D DIV4^RMPRSIT G:$D(X) EXIT S RMPRF=1 D EN^RMPRDP G EXIT
;
EN10 ;Edit 2319 Entry
S RMPREDT=1 ;set flag for the edit
D DIV4^RMPRSIT G:$D(X) EXIT S DIC("S")="I $P(^(0),U,13)=3,$P(^(0),U,10)=RMPR(""STA"")" I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
S DIC("W")="D EN^RMPRD1",DIC="^RMPR(660,",DIC(0)="AEQMZ",DIC("A")="Please Enter the 2319 Date or the Patient's Name: "
D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE
S (RMPRDA,DA)=+Y,DIE=DIC D TYP1^RMPRE29 K DIR
W ! S DIR(0)="Y",DIR("A")="Would You like to Delete this 2319 Entry (Y/N)" D ^DIR
I '$D(DTOUT)&(Y>0) D
.;added by patch #62.
.I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
..S RMCHK=$$DEL^RMPRPCED(RMPRDA)
.S DA=RMPRDA,DIK="^RMPR(660," D ^DIK
L -^RMPR(660,RMPRDA,0)
W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR
G:'$D(DTOUT)&(Y>0) EN10
EXIT K I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR
N RMPR,RMPRSITE D KILL^XUSCLEAN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPROP 2205 printed Dec 13, 2024@02:35:23 Page 2
RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994
+1 ;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996
+2 ;
+3 ;RVD patch #53 only issue stock items from PIP
+4 ;
+5 ;RVD patch #62 pce interface, delete transaction if 2319 is deleted.
+6 ;
+7 ;RVD patch #61 PIP new files.
+8 ;
EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS
+1 ;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS
+2 SET RMPRF=1
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPR21
GOTO EXIT
+3 ;
EN2 ;Create 10-2421
+1 SET RMPRF=2
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPR21
GOTO EXIT
+2 ;
EN3 ;2520 Transaction without printing
+1 SET RMPRF=10
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPR21
KILL RMPRAMT
GOTO EXIT
+2 ;
EN4 ;2914 EYEGLASS RECORD
+1 ;SETS FORM TYPE CODE FOR 2914
+2 ;VARIABLES REQUIRED: NONE
+3 SET RMPRF=8
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPR21
GOTO EXIT
+4 ;
EN5 ;CLOSE-OUT
+1 SET RMPRF="E"
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPRE21
GOTO EXIT
+2 ;
EN6 ;NO-FORM DAILY RECORD
+1 SET RMPRF=9
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO ^RMPR21
GOTO EXIT
+2 ;
EN7 ;ISSUE FROM STOCK
+1 KILL RMPRDFN,RMPR
+2 ;patch #61 call rmprpiyi instead of rmprsti
+3 SET RMPRF=11
DO ^RMPRPIYI
GOTO EXIT
+4 ;
EN9 ;PICKUP AND DELIVERY
+1 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
SET RMPRF=1
DO EN^RMPRDP
GOTO EXIT
+2 ;
EN10 ;Edit 2319 Entry
+1 ;set flag for the edit
SET RMPREDT=1
+2 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
SET DIC("S")="I $P(^(0),U,13)=3,$P(^(0),U,10)=RMPR(""STA"")"
IF RMPRSITE=1
SET DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
+3 SET DIC("W")="D EN^RMPRD1"
SET DIC="^RMPR(660,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Please Enter the 2319 Date or the Patient's Name: "
+4 DO ^DIC
if +Y'>0
GOTO EXIT
LOCK +^RMPR(660,+Y,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+5 ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE
+6 SET (RMPRDA,DA)=+Y
SET DIE=DIC
DO TYP1^RMPRE29
KILL DIR
+7 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Would You like to Delete this 2319 Entry (Y/N)"
DO ^DIR
+8 IF '$DATA(DTOUT)&(Y>0)
Begin DoDot:1
+9 ;added by patch #62.
+10 IF $DATA(^RMPR(660,RMPRDA,10))
IF $PIECE(^RMPR(660,RMPRDA,10),U,12)
Begin DoDot:2
+11 SET RMCHK=$$DEL^RMPRPCED(RMPRDA)
End DoDot:2
+12 SET DA=RMPRDA
SET DIK="^RMPR(660,"
DO ^DIK
End DoDot:1
+13 LOCK -^RMPR(660,RMPRDA,0)
+14 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Would You like to Edit another Entry (Y/N)"
DO ^DIR
+15 if '$DATA(DTOUT)&(Y>0)
GOTO EN10
EXIT KILL I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR
+1 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
QUIT
