| [623] | 1 | RMPR4C21 ;PHX/HNB-CANCEL A PURCHASE CARD TRANSACTION;3/1/1996
|
|---|
| 2 | ;;3.0;PROSTHETICS;**3,20,62**;Feb 09, 1996
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;RVD patch #62 - pce interface
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;entry point for Cancel a Transaction Option
|
|---|
| 7 | D DIV4^RMPRSIT G:$D(X) EXIT
|
|---|
| 8 | W !!,"You may also make a selection by Purchase Card Transaction"
|
|---|
| 9 | W !,"(Example, PC number), or Bank Authorization Number (6 digit number).",!
|
|---|
| 10 | S DIC("A")="Select PATIENT: "
|
|---|
| 11 | S DIC("S")="I $D(^(4)) I ('$P(^(0),U,8)&'$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))"
|
|---|
| 12 | S DIC="^RMPR(664,",DIC(0)="AEQMN",DIC("W")="D EN2^RMPR4D1"
|
|---|
| 13 | D ^DIC G:Y<0 EXIT S RMPRA=+Y K R90
|
|---|
| 14 | CL S B2=^RMPR(664,RMPRA,0) G:$P(B2,U,8) M4 G:$P(B2,U,5) M6
|
|---|
| 15 | L +^RMPR(664,RMPRA,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
|
|---|
| 16 | K DIC,Y,DA S X=$P(B2,U,7),DIC=424,DIC(0)="MZ"
|
|---|
| 17 | D ^DIC S $P(B2,U,7)=+Y
|
|---|
| 18 | S RMPRDFN=$P(^RMPR(664,RMPRA,0),U,2),RMPRWO=$P(^(0),U,15),RMPRDA=$P(^(0),U,17)
|
|---|
| 19 | S DFN=RMPRDFN D DEM^VADPT
|
|---|
| 20 | S RMPRSSNE=VA("PID")
|
|---|
| 21 | D ^RMPR4LI
|
|---|
| 22 | A W !!,"Do you really want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H
|
|---|
| 23 | ;call IFCAP to cancel
|
|---|
| 24 | S X=1
|
|---|
| 25 | S RMPR442=$P($G(^RMPR(664,RMPRA,4)),U,6)
|
|---|
| 26 | I RMPR442="" G BYPASS
|
|---|
| 27 | D CAN^PRCH7B(.X,RMPRA,RMPR442,0)
|
|---|
| 28 | I X="^" W !!,"NOT CANCELED You must say YES to 'Approve and print Amendment number'" G EXIT
|
|---|
| 29 | K RMPR442,X
|
|---|
| 30 | BYPASS S RMPRAR=$S($P(^RMPR(664,RMPRA,0),U,12)'="":$P(^(0),U,12),1:""),$P(^(0),U,12)=""
|
|---|
| 31 | D:RMPRAR'="" K660
|
|---|
| 32 | Q:$G(RMPRA)'>0
|
|---|
| 33 | S R1=0 F S R1=$O(^RMPR(664,RMPRA,1,R1)) Q:R1'>0 S RMPRAR=$S($P(^RMPR(664,RMPRA,1,R1,0),U,13)'="":$P(^(0),U,13),1:""),$P(^(0),U,13)="" G:RMPRAR="" M3 D K660
|
|---|
| 34 | C58 ;CLOSE OUT
|
|---|
| 35 | I $D(RMPRWO),RMPRWO D D CA0^RMPR29M(RMPRDA,RMPRA)
|
|---|
| 36 | .S $P(^RMPR(664.2,RMPRWO,0),U,16,17)="" F DA=0:0 S DA=$O(^RMPR(664.2,RMPRWO,1,"AC",RMPRA,DA)) Q:DA'>0 S DIK="^RMPR(664.2,"_RMPRWO_",1,",DA(1)=RMPRWO D ^DIK
|
|---|
| 37 | ;
|
|---|
| 38 | G K664
|
|---|
| 39 | K660 ;DELETE APPLIANCE/REPAIR RECORDS
|
|---|
| 40 | D SS660 Q:$G(RMPRAR)'>0
|
|---|
| 41 | ;modified by #62
|
|---|
| 42 | ;call pce delete if patient encounter was recorded
|
|---|
| 43 | I $D(^RMPR(660,RMPRAR,10)),$P(^RMPR(660,RMPRAR,10),U,12) D
|
|---|
| 44 | .S RMCHK=0
|
|---|
| 45 | .S RMCHK=$$PCED^RMPRPCEP(RMPRAR)
|
|---|
| 46 | S DA=RMPRAR,DIK="^RMPR(660," D ^DIK W "."
|
|---|
| 47 | K RMPRAR
|
|---|
| 48 | Q
|
|---|
| 49 | SS660 ;
|
|---|
| 50 | ;
|
|---|
| 51 | Q
|
|---|
| 52 | K664 ;CANCEL FLAG
|
|---|
| 53 | S $P(^RMPR(664,RMPRA,0),"^",5)=DT,$P(^RMPR(664,RMPRA,2),"^",2)=DUZ
|
|---|
| 54 | S DA=RMPRA,DR="3.1",DIE="^RMPR(664," D ^DIE
|
|---|
| 55 | W !,$C(7),$C(7),"Transaction Canceled and Deleted..." H 2 D LINK^RMPRS
|
|---|
| 56 | ;
|
|---|
| 57 | EXIT L:$D(RMPRA) -^RMPR(664,RMPRA,0)
|
|---|
| 58 | N RMPR,RMPRSITE D KILL^XUSCLEAN
|
|---|
| 59 | K LINE,RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
|
|---|
| 60 | K RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
|
|---|
| 61 | K RMPRSSN,DR,PRC,RMPRC,DIC,DIK,%,R1,DA,B2,RMPRCK,DIC
|
|---|
| 62 | K DIK,I,Y,RAC,R90,RMPRN,^TMP($J)
|
|---|
| 63 | Q
|
|---|
| 64 | H W !,"By entering Yes, will Delete the transaction in Prosthetics." G A
|
|---|
| 65 | H2 W !,"By entering Yes, will Cancel the Transaction , and NOT UPDATE the 10-2319." G M3A
|
|---|
| 66 | M3 W !,$C(7),$C(7),"TRANSACTION MISSING APPLIANCE/REPAIR RECORD!"
|
|---|
| 67 | M3A W !,"Do you still want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H2 G C58
|
|---|
| 68 | M4 W !,$C(7),$C(7),"This Transacion has already been Closed!" G EXIT
|
|---|
| 69 | M6 W !,$C(7),$C(7),"This transaction has already been Canceled!" G EXIT
|
|---|
