RMPR22 ;PHX/DWL-EDIT 10-2319 RECORD ;8/29/1994
;;3.0;PROSTHETICS;;Feb 09, 1996
EN D GETPAT^RMPRUTIL
LIST G:'$D(RMPRDFN) EXIT S RC=0,RMPRA="" D ^RMPRL22
OVER S %=1 R !,"ARE YOU READY TO ACCEPT THESE ENTRIES" D YN^DICN G:$D(DTOUT) EXIT G:%=1 EXIT
S %=2 R !,"DO YOU WISH TO DELETE AN ENTRY" D YN^DICN G:$D(DTOUT) EXIT G:%=1 DEL
W !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO EDIT. " R ANS:DTIME Q:'$T!(ANS="^")
I ANS'?1.2N!(ANS>RC) W $C(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"." G OVER
I ANS>0,(ANS<(RC+1)) S RMPRA=RMPRA(ANS)
G EDIT
EXIT K RMPRQT,Y,RMPRK,%,DIC,DIK,RMPRG,DA,DIE,DR,RMPRI,PRCP("I"),PRCP("ITEM"),PRCP("TYP"),PRCP("COM"),X,RMPRGIP,RMPRDFN,RMPRD,RMPRACT,RMPRIP,RMPRTO,RMPRCT,RMPRRD,RED,RMPRDD,RMPRSO
Q
EDIT S DIC="^RMPR(660,",DIC(0)="N,Z",X=RMPRA D ^DIC G:Y=-1 LIST S RED=^RMPR(660,+Y,0),DA=+Y,DIE=DIC,DR="4" D ^DIE S RMPRI=$P(^RMPR(660,DA,0),U,6)
I RMPRI=$P(RED,U,6) S RMPRI=$P(^RMPR(661,RMPRI,0),U,1) G COST
S RMPRI=$P(^RMPR(661,RMPRI,0),U,1) S RMPRCT(RMPRA)=$S($D(RMPRCT(RMPRA)):RMPRCT(RMPRA),1:0)
COST W !,"UNIT COST: $",RMPRCT(RMPRA)," " R ANS:DTIME G:'$T KILL^RMPR21 S:(RMPRCT(RMPRA)'=ANS)&(ANS>0) RMPRCT(RMPRA)=ANS
S DR="5;12;7;2;62;63;10;9;21;16" D ^DIE I $P(^RMPR(660,RMPRA,0),U,14)["V"&($P(^(0),U,9)'="") S $P(^(0),U,9)=""
S RMPRTO=$P(^RMPR(660,RMPRA,0),U,7)*RMPRCT(RMPRA),$P(^(0),U,16)=RMPRTO W !,"TOTAL COST: $",RMPRTO
G LIST
DEL W !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO DELETE. " R ANS:DTIME Q:'$T!(ANS="^")
I ANS'?1.1N!(ANS>RC) W $C(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"." G LIST
I ANS>0,(ANS<(RC+1)) K RMPRCT(ANS) S DA=RMPRA(ANS),DIK="^RMPR(660," D ^DIK K RMPRA(ANS)
G LIST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR22 1690 printed Nov 22, 2024@17:42 Page 2
RMPR22 ;PHX/DWL-EDIT 10-2319 RECORD ;8/29/1994
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
EN DO GETPAT^RMPRUTIL
LIST if '$DATA(RMPRDFN)
GOTO EXIT
SET RC=0
SET RMPRA=""
DO ^RMPRL22
OVER SET %=1
READ !,"ARE YOU READY TO ACCEPT THESE ENTRIES"
DO YN^DICN
if $DATA(DTOUT)
GOTO EXIT
if %=1
GOTO EXIT
+1 SET %=2
READ !,"DO YOU WISH TO DELETE AN ENTRY"
DO YN^DICN
if $DATA(DTOUT)
GOTO EXIT
if %=1
GOTO DEL
+2 WRITE !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO EDIT. "
READ ANS:DTIME
if '$TEST!(ANS="^")
QUIT
+3 IF ANS'?1.2N!(ANS>RC)
WRITE $CHAR(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"."
GOTO OVER
+4 IF ANS>0
IF (ANS<(RC+1))
SET RMPRA=RMPRA(ANS)
+5 GOTO EDIT
EXIT KILL RMPRQT,Y,RMPRK,%,DIC,DIK,RMPRG,DA,DIE,DR,RMPRI,PRCP("I"),PRCP("ITEM"),PRCP("TYP"),PRCP("COM"),X,RMPRGIP,RMPRDFN,RMPRD,RMPRACT,RMPRIP,RMPRTO,RMPRCT,RMPRRD,RED,RMPRDD,RMPRSO
+1 QUIT
EDIT SET DIC="^RMPR(660,"
SET DIC(0)="N,Z"
SET X=RMPRA
DO ^DIC
if Y=-1
GOTO LIST
SET RED=^RMPR(660,+Y,0)
SET DA=+Y
SET DIE=DIC
SET DR="4"
DO ^DIE
SET RMPRI=$PIECE(^RMPR(660,DA,0),U,6)
+1 IF RMPRI=$PIECE(RED,U,6)
SET RMPRI=$PIECE(^RMPR(661,RMPRI,0),U,1)
GOTO COST
+2 SET RMPRI=$PIECE(^RMPR(661,RMPRI,0),U,1)
SET RMPRCT(RMPRA)=$SELECT($DATA(RMPRCT(RMPRA)):RMPRCT(RMPRA),1:0)
COST WRITE !,"UNIT COST: $",RMPRCT(RMPRA)," "
READ ANS:DTIME
if '$TEST
GOTO KILL^RMPR21
if (RMPRCT(RMPRA)'=ANS)&(ANS>0)
SET RMPRCT(RMPRA)=ANS
+1 SET DR="5;12;7;2;62;63;10;9;21;16"
DO ^DIE
IF $PIECE(^RMPR(660,RMPRA,0),U,14)["V"&($PIECE(^(0),U,9)'="")
SET $PIECE(^(0),U,9)=""
+2 SET RMPRTO=$PIECE(^RMPR(660,RMPRA,0),U,7)*RMPRCT(RMPRA)
SET $PIECE(^(0),U,16)=RMPRTO
WRITE !,"TOTAL COST: $",RMPRTO
+3 GOTO LIST
DEL WRITE !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO DELETE. "
READ ANS:DTIME
if '$TEST!(ANS="^")
QUIT
+1 IF ANS'?1.1N!(ANS>RC)
WRITE $CHAR(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"."
GOTO LIST
+2 IF ANS>0
IF (ANS<(RC+1))
KILL RMPRCT(ANS)
SET DA=RMPRA(ANS)
SET DIK="^RMPR(660,"
DO ^DIK
KILL RMPRA(ANS)
+3 GOTO LIST
