- 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 Feb 18, 2025@23:59:15 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