| [613] | 1 | RMPR4EPC ;PHX/HNB -EDIT PURCHASE CARD TRANSACTION ;3/12/1996
|
|---|
| 2 | ;;3.0;PROSTHETICS;**3,15**;Feb 09, 1996
|
|---|
| 3 | I '$D(RMPR) D DIV4^RMPRSIT G:$D(X) EXIT
|
|---|
| 4 | W ! S DIC="^RMPR(664,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: "
|
|---|
| 5 | S DIC("W")="D EN2^RMPR4D1"
|
|---|
| 6 | S DIC("S")="I $D(^(4)) I ('$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))" W !
|
|---|
| 7 | D ^DIC G:+Y'>0 EXIT L +^RMPR(664,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
|
|---|
| 8 | S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPR4 PC]" D ^DIE
|
|---|
| 9 | S BO=0,BA=$P(^RMPR(664,RMPRDA,4),U,2)
|
|---|
| 10 | ;ba is bank authorization number
|
|---|
| 11 | F S BO=$O(^RMPR(664,RMPRDA,1,BO)) Q:BO'>0 D
|
|---|
| 12 | .S R660=$P(^RMPR(664,RMPRDA,1,BO,0),U,13)
|
|---|
| 13 | .S $P(^RMPR(660,R660,4),U,2)=BA
|
|---|
| 14 | L -^RMPR(664,DA,0)
|
|---|
| 15 | W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR
|
|---|
| 16 | G:'$D(DTOUT)&(Y>0) RMPR4EPC
|
|---|
| 17 | EXIT ;common exit point
|
|---|
| 18 | K DIC,DIE,DIR,%,X,Y,BA,BO,DA,DR,DTOUT,DUOUT,R660,RMPRDA Q
|
|---|
