source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR22.m@ 619

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1RMPR22 ;PHX/DWL-EDIT 10-2319 RECORD ;8/29/1994
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3EN D GETPAT^RMPRUTIL
4LIST G:'$D(RMPRDFN) EXIT S RC=0,RMPRA="" D ^RMPRL22
5OVER S %=1 R !,"ARE YOU READY TO ACCEPT THESE ENTRIES" D YN^DICN G:$D(DTOUT) EXIT G:%=1 EXIT
6 S %=2 R !,"DO YOU WISH TO DELETE AN ENTRY" D YN^DICN G:$D(DTOUT) EXIT G:%=1 DEL
7 W !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO EDIT. " R ANS:DTIME Q:'$T!(ANS="^")
8 I ANS'?1.2N!(ANS>RC) W $C(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"." G OVER
9 I ANS>0,(ANS<(RC+1)) S RMPRA=RMPRA(ANS)
10 G EDIT
11EXIT 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
12 Q
13EDIT 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)
14 I RMPRI=$P(RED,U,6) S RMPRI=$P(^RMPR(661,RMPRI,0),U,1) G COST
15 S RMPRI=$P(^RMPR(661,RMPRI,0),U,1) S RMPRCT(RMPRA)=$S($D(RMPRCT(RMPRA)):RMPRCT(RMPRA),1:0)
16COST W !,"UNIT COST: $",RMPRCT(RMPRA)," " R ANS:DTIME G:'$T KILL^RMPR21 S:(RMPRCT(RMPRA)'=ANS)&(ANS>0) RMPRCT(RMPRA)=ANS
17 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)=""
18 S RMPRTO=$P(^RMPR(660,RMPRA,0),U,7)*RMPRCT(RMPRA),$P(^(0),U,16)=RMPRTO W !,"TOTAL COST: $",RMPRTO
19 G LIST
20DEL W !,"ENTER THE NUMBER OF THE ENTRY YOU WISH TO DELETE. " R ANS:DTIME Q:'$T!(ANS="^")
21 I ANS'?1.1N!(ANS>RC) W $C(7),!,"ANSWER MUST BE A WHOLE NUMBER NOT GREATER THAN ",RC,"." G LIST
22 I ANS>0,(ANS<(RC+1)) K RMPRCT(ANS) S DA=RMPRA(ANS),DIK="^RMPR(660," D ^DIK K RMPRA(ANS)
23 G LIST
Note: See TracBrowser for help on using the repository browser.