RMPR4EPC ;PHX/HNB -EDIT PURCHASE CARD TRANSACTION ;3/12/1996
;;3.0;PROSTHETICS;**3,15**;Feb 09, 1996
I '$D(RMPR) D DIV4^RMPRSIT G:$D(X) EXIT
W ! S DIC="^RMPR(664,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: "
S DIC("W")="D EN2^RMPR4D1"
S DIC("S")="I $D(^(4)) I ('$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))" W !
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
S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPR4 PC]" D ^DIE
S BO=0,BA=$P(^RMPR(664,RMPRDA,4),U,2)
;ba is bank authorization number
F S BO=$O(^RMPR(664,RMPRDA,1,BO)) Q:BO'>0 D
.S R660=$P(^RMPR(664,RMPRDA,1,BO,0),U,13)
.S $P(^RMPR(660,R660,4),U,2)=BA
L -^RMPR(664,DA,0)
W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR
G:'$D(DTOUT)&(Y>0) RMPR4EPC
EXIT ;common exit point
K DIC,DIE,DIR,%,X,Y,BA,BO,DA,DR,DTOUT,DUOUT,R660,RMPRDA Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR4EPC 897 printed Dec 13, 2024@02:32:47 Page 2
RMPR4EPC ;PHX/HNB -EDIT PURCHASE CARD TRANSACTION ;3/12/1996
+1 ;;3.0;PROSTHETICS;**3,15**;Feb 09, 1996
+2 IF '$DATA(RMPR)
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+3 WRITE !
SET DIC="^RMPR(664,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select PATIENT: "
+4 SET DIC("W")="D EN2^RMPR4D1"
+5 SET DIC("S")="I $D(^(4)) I ('$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))"
WRITE !
+6 DO ^DIC
if +Y'>0
GOTO EXIT
LOCK +^RMPR(664,+Y,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+7 SET (RMPRDA,DA)=+Y
SET DIE=DIC
SET DR="[RMPR4 PC]"
DO ^DIE
+8 SET BO=0
SET BA=$PIECE(^RMPR(664,RMPRDA,4),U,2)
+9 ;ba is bank authorization number
+10 FOR
SET BO=$ORDER(^RMPR(664,RMPRDA,1,BO))
if BO'>0
QUIT
Begin DoDot:1
+11 SET R660=$PIECE(^RMPR(664,RMPRDA,1,BO,0),U,13)
+12 SET $PIECE(^RMPR(660,R660,4),U,2)=BA
End DoDot:1
+13 LOCK -^RMPR(664,DA,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 RMPR4EPC
EXIT ;common exit point
+1 KILL DIC,DIE,DIR,%,X,Y,BA,BO,DA,DR,DTOUT,DUOUT,R660,RMPRDA
QUIT
