RMPR4C21 ;PHX/HNB-CANCEL A PURCHASE CARD TRANSACTION;3/1/1996
;;3.0;PROSTHETICS;**3,20,62,140**;Feb 09, 1996;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
;RVD patch #62 - pce interface
;
EN ;entry point for Cancel a Transaction Option
D DIV4^RMPRSIT G:$D(X) EXIT
W !!,"You may also make a selection by Purchase Card Transaction"
W !,"(Example, PC number), or Bank Authorization Number (6 digit number).",!
S DIC("A")="Select PATIENT: "
S DIC("S")="I $D(^(4)) I ('$P(^(0),U,8)&'$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))"
S DIC="^RMPR(664,",DIC(0)="AEQMN",DIC("W")="D EN2^RMPR4D1"
D ^DIC G:Y<0 EXIT S RMPRA=+Y K R90
CL S B2=^RMPR(664,RMPRA,0) G:$P(B2,U,8) M4 G:$P(B2,U,5) M6
L +^RMPR(664,RMPRA,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
K DIC,Y,DA S X=$P(B2,U,7),DIC=424,DIC(0)="MZ"
D ^DIC S $P(B2,U,7)=+Y
S RMPRDFN=$P(^RMPR(664,RMPRA,0),U,2),RMPRWO=$P(^(0),U,15),RMPRDA=$P(^(0),U,17)
S DFN=RMPRDFN D DEM^VADPT
S RMPRSSNE=VA("PID")
D ^RMPR4LI
A W !!,"Do you really want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H
;call IFCAP to cancel
S X=1
S RMPR442=$P($G(^RMPR(664,RMPRA,4)),U,6)
I RMPR442="" G BYPASS
I $P($G(^PRC(442,RMPR442,7)),U)=45 W !!,"Purchase Card CANCELLED in IFCAP, will cancel open Pros PC order, hit return" R X:10 G BYPASS
D CAN^PRCH7B(.X,RMPRA,RMPR442,0)
I X="^" W !!,"NOT CANCELED You must say YES to 'Approve and print Amendment number'" G EXIT
K RMPR442,X
BYPASS S RMPRAR=$S($P(^RMPR(664,RMPRA,0),U,12)'="":$P(^(0),U,12),1:""),$P(^(0),U,12)=""
D:RMPRAR'="" K660
Q:$G(RMPRA)'>0
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
C58 ;CLOSE OUT
I $D(RMPRWO),RMPRWO D D CA0^RMPR29M(RMPRDA,RMPRA)
.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
;
G K664
K660 ;DELETE APPLIANCE/REPAIR RECORDS
D SS660 Q:$G(RMPRAR)'>0
;modified by #62
;call pce delete if patient encounter was recorded
I $D(^RMPR(660,RMPRAR,10)),$P(^RMPR(660,RMPRAR,10),U,12) D
.S RMCHK=0
.S RMCHK=$$PCED^RMPRPCEP(RMPRAR)
S DA=RMPRAR,DIK="^RMPR(660," D ^DIK W "."
K RMPRAR
Q
SS660 ;
;
Q
K664 ;CANCEL FLAG
S $P(^RMPR(664,RMPRA,0),"^",5)=DT,$P(^RMPR(664,RMPRA,2),"^",2)=DUZ
S DA=RMPRA,DR="3.1",DIE="^RMPR(664," D ^DIE
W !,$C(7),$C(7),"Transaction Canceled and Deleted..." H 2 D LINK^RMPRS
;
EXIT L:$D(RMPRA) -^RMPR(664,RMPRA,0)
N RMPR,RMPRSITE D KILL^XUSCLEAN
K LINE,RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
K RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
K RMPRSSN,DR,PRC,RMPRC,DIC,DIK,%,R1,DA,B2,RMPRCK,DIC
K DIK,I,Y,RAC,R90,RMPRN,^TMP($J)
Q
H W !,"By entering Yes, will Delete the transaction in Prosthetics." G A
H2 W !,"By entering Yes, will Cancel the Transaction , and NOT UPDATE the 10-2319." G M3A
M3 W !,$C(7),$C(7),"TRANSACTION MISSING APPLIANCE/REPAIR RECORD!"
M3A W !,"Do you still want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H2 G C58
M4 W !,$C(7),$C(7),"This Transacion has already been Closed!" G EXIT
M6 W !,$C(7),$C(7),"This transaction has already been Canceled!" G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR4C21 3329 printed Oct 16, 2024@18:33:21 Page 2
RMPR4C21 ;PHX/HNB-CANCEL A PURCHASE CARD TRANSACTION;3/1/1996
+1 ;;3.0;PROSTHETICS;**3,20,62,140**;Feb 09, 1996;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;RVD patch #62 - pce interface
+4 ;
EN ;entry point for Cancel a Transaction Option
+1 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 WRITE !!,"You may also make a selection by Purchase Card Transaction"
+3 WRITE !,"(Example, PC number), or Bank Authorization Number (6 digit number).",!
+4 SET DIC("A")="Select PATIENT: "
+5 SET DIC("S")="I $D(^(4)) I ('$P(^(0),U,8)&'$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))"
+6 SET DIC="^RMPR(664,"
SET DIC(0)="AEQMN"
SET DIC("W")="D EN2^RMPR4D1"
+7 DO ^DIC
if Y<0
GOTO EXIT
SET RMPRA=+Y
KILL R90
CL SET B2=^RMPR(664,RMPRA,0)
if $PIECE(B2,U,8)
GOTO M4
if $PIECE(B2,U,5)
GOTO M6
+1 LOCK +^RMPR(664,RMPRA,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+2 KILL DIC,Y,DA
SET X=$PIECE(B2,U,7)
SET DIC=424
SET DIC(0)="MZ"
+3 DO ^DIC
SET $PIECE(B2,U,7)=+Y
+4 SET RMPRDFN=$PIECE(^RMPR(664,RMPRA,0),U,2)
SET RMPRWO=$PIECE(^(0),U,15)
SET RMPRDA=$PIECE(^(0),U,17)
+5 SET DFN=RMPRDFN
DO DEM^VADPT
+6 SET RMPRSSNE=VA("PID")
+7 DO ^RMPR4LI
A WRITE !!,"Do you really want to CANCEL this Transaction"
SET %=0
DO YN^DICN
if %<0!(%=2)
GOTO EXIT
if %=0
GOTO H
+1 ;call IFCAP to cancel
+2 SET X=1
+3 SET RMPR442=$PIECE($GET(^RMPR(664,RMPRA,4)),U,6)
+4 IF RMPR442=""
GOTO BYPASS
+5 IF $PIECE($GET(^PRC(442,RMPR442,7)),U)=45
WRITE !!,"Purchase Card CANCELLED in IFCAP, will cancel open Pros PC order, hit return"
READ X:10
GOTO BYPASS
+6 DO CAN^PRCH7B(.X,RMPRA,RMPR442,0)
+7 IF X="^"
WRITE !!,"NOT CANCELED You must say YES to 'Approve and print Amendment number'"
GOTO EXIT
+8 KILL RMPR442,X
BYPASS SET RMPRAR=$SELECT($PIECE(^RMPR(664,RMPRA,0),U,12)'="":$PIECE(^(0),U,12),1:"")
SET $PIECE(^(0),U,12)=""
+1 if RMPRAR'=""
DO K660
+2 if $GET(RMPRA)'>0
QUIT
+3 SET R1=0
FOR
SET R1=$ORDER(^RMPR(664,RMPRA,1,R1))
if R1'>0
QUIT
SET RMPRAR=$SELECT($PIECE(^RMPR(664,RMPRA,1,R1,0),U,13)'="":$PIECE(^(0),U,13),1:"")
SET $PIECE(^(0),U,13)=""
if RMPRAR=""
GOTO M3
DO K660
C58 ;CLOSE OUT
+1 IF $DATA(RMPRWO)
IF RMPRWO
Begin DoDot:1
+2 SET $PIECE(^RMPR(664.2,RMPRWO,0),U,16,17)=""
FOR DA=0:0
SET DA=$ORDER(^RMPR(664.2,RMPRWO,1,"AC",RMPRA,DA))
if DA'>0
QUIT
SET DIK="^RMPR(664.2,"_RMPRWO_",1,"
SET DA(1)=RMPRWO
DO ^DIK
End DoDot:1
DO CA0^RMPR29M(RMPRDA,RMPRA)
+3 ;
+4 GOTO K664
K660 ;DELETE APPLIANCE/REPAIR RECORDS
+1 DO SS660
if $GET(RMPRAR)'>0
QUIT
+2 ;modified by #62
+3 ;call pce delete if patient encounter was recorded
+4 IF $DATA(^RMPR(660,RMPRAR,10))
IF $PIECE(^RMPR(660,RMPRAR,10),U,12)
Begin DoDot:1
+5 SET RMCHK=0
+6 SET RMCHK=$$PCED^RMPRPCEP(RMPRAR)
End DoDot:1
+7 SET DA=RMPRAR
SET DIK="^RMPR(660,"
DO ^DIK
WRITE "."
+8 KILL RMPRAR
+9 QUIT
SS660 ;
+1 ;
+2 QUIT
K664 ;CANCEL FLAG
+1 SET $PIECE(^RMPR(664,RMPRA,0),"^",5)=DT
SET $PIECE(^RMPR(664,RMPRA,2),"^",2)=DUZ
+2 SET DA=RMPRA
SET DR="3.1"
SET DIE="^RMPR(664,"
DO ^DIE
+3 WRITE !,$CHAR(7),$CHAR(7),"Transaction Canceled and Deleted..."
HANG 2
DO LINK^RMPRS
+4 ;
EXIT if $DATA(RMPRA)
LOCK -^RMPR(664,RMPRA,0)
+1 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
+2 KILL LINE,RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
+3 KILL RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
+4 KILL RMPRSSN,DR,PRC,RMPRC,DIC,DIK,%,R1,DA,B2,RMPRCK,DIC
+5 KILL DIK,I,Y,RAC,R90,RMPRN,^TMP($JOB)
+6 QUIT
H WRITE !,"By entering Yes, will Delete the transaction in Prosthetics."
GOTO A
H2 WRITE !,"By entering Yes, will Cancel the Transaction , and NOT UPDATE the 10-2319."
GOTO M3A
M3 WRITE !,$CHAR(7),$CHAR(7),"TRANSACTION MISSING APPLIANCE/REPAIR RECORD!"
M3A WRITE !,"Do you still want to CANCEL this Transaction"
SET %=0
DO YN^DICN
if %<0!(%=2)
GOTO EXIT
if %=0
GOTO H2
GOTO C58
M4 WRITE !,$CHAR(7),$CHAR(7),"This Transacion has already been Closed!"
GOTO EXIT
M6 WRITE !,$CHAR(7),$CHAR(7),"This transaction has already been Canceled!"
GOTO EXIT
