- RMPRC21 ;PHX/HNB-CANCEL A 1358 PROSTHETIC REQUEST ;8/29/1994
- ;;3.0;PROSTHETICS;**62**;Feb 09, 1996
- ;
- ; RVD patch # 62 - call pce delete if PCE was recorded and cancelled.
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;entry point for Cancel a Transaction Option
- D DIV4^RMPRSIT G:$D(X) EXIT
- S PRCS("A")="Select OBLIGATION NUMBER: " D EN1^PRCS58 G:Y=-1 EXIT
- S RMPROB=$P(Y,U,2),RMPR("OB")=$P(Y(0),U,1)
- S DIC("A")="Select TRANSACTION: "
- S DIC("S")="S R90=^(0) I $P(R90,U,3)=RMPR(""OB""),('$P(R90,U,5)&'$P(R90,U,8)),($P(R90,U,14)=RMPR(""STA""))" I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(R90,U,14)="""")"
- S DIC="^RMPR(664,",DIC(0)="AEQM",DIC("W")="D EN2^RMPRD1"
- 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),RMPRNAM=$P(^DPT(RMPRDFN,0),U,1),RMPRSSN=$P(^(0),U,9)
- D ^RMPRLI
- A W !!,"Do you really want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H
- 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 IFCAP DAILY RECORD
- 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
- I $P(B2,U,7)'>0 W !,$C(7),"DID NOT HAVE AN IFCAP DAILY RECORD" G K664
- D NOW^%DTC S PRCSX=$P(B2,U,7)_U_%_U_0_U_"Canceled"_U_1 D ^PRCS58CC
- I +Y=0 W !,$C(7),$C(7),"FAILED TO CLOSE IFCAP DAILY RECORD FOR THE FOLLOWING REASON ",$P(Y,U,2),!,"PLEASE CONTACT YOUR APPLICATION COORDINATOR!"
- 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 ;set new status in 660.5
- W !!,"CANCELLING THE OBLIGATION!"
- I $G(RMPRF)'>0 S RMPRF=$P($G(^RMPR(664,RMPRA,2)),U,4)
- 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..." D LINK^RMPRS
- ;
- EXIT L:$D(RMPRA) -^RMPR(664,RMPRA,0)
- K LINE,PRCSCPAN,PRCSIP,RMPR("OB"),RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
- K RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
- K RMPROB,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, this will Delete the transaction in Prosthetics, and Cancel the Transaction in IFCAP." G A
- H2 W !,"By entering Yes, this will Cancel the Transaction in IFCAP,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 Transaction 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[HRMPRC21 3479 printed Jan 18, 2025@03:35:09 Page 2
- RMPRC21 ;PHX/HNB-CANCEL A 1358 PROSTHETIC REQUEST ;8/29/1994
- +1 ;;3.0;PROSTHETICS;**62**;Feb 09, 1996
- +2 ;
- +3 ; RVD patch # 62 - call pce delete if PCE was recorded and cancelled.
- +4 ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;entry point for Cancel a Transaction Option
- +1 DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- +2 SET PRCS("A")="Select OBLIGATION NUMBER: "
- DO EN1^PRCS58
- if Y=-1
- GOTO EXIT
- +3 SET RMPROB=$PIECE(Y,U,2)
- SET RMPR("OB")=$PIECE(Y(0),U,1)
- +4 SET DIC("A")="Select TRANSACTION: "
- +5 SET DIC("S")="S R90=^(0) I $P(R90,U,3)=RMPR(""OB""),('$P(R90,U,5)&'$P(R90,U,8)),($P(R90,U,14)=RMPR(""STA""))"
- IF RMPRSITE=1
- SET DIC("S")=DIC("S")_"!($P(R90,U,14)="""")"
- +6 SET DIC="^RMPR(664,"
- SET DIC(0)="AEQM"
- SET DIC("W")="D EN2^RMPRD1"
- +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)
- SET RMPRNAM=$PIECE(^DPT(RMPRDFN,0),U,1)
- SET RMPRSSN=$PIECE(^(0),U,9)
- +5 DO ^RMPRLI
- 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 SET RMPRAR=$SELECT($PIECE(^RMPR(664,RMPRA,0),U,12)'="":$PIECE(^(0),U,12),1:"")
- SET $PIECE(^(0),U,12)=""
- +2 if RMPRAR'=""
- DO K660
- +3 if $GET(RMPRA)'>0
- QUIT
- +4 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 IFCAP DAILY RECORD
- +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 IF $PIECE(B2,U,7)'>0
- WRITE !,$CHAR(7),"DID NOT HAVE AN IFCAP DAILY RECORD"
- GOTO K664
- +4 DO NOW^%DTC
- SET PRCSX=$PIECE(B2,U,7)_U_%_U_0_U_"Canceled"_U_1
- DO ^PRCS58CC
- +5 IF +Y=0
- WRITE !,$CHAR(7),$CHAR(7),"FAILED TO CLOSE IFCAP DAILY RECORD FOR THE FOLLOWING REASON ",$PIECE(Y,U,2),!,"PLEASE CONTACT YOUR APPLICATION COORDINATOR!"
- +6 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 ;
- +8 SET DA=RMPRAR
- SET DIK="^RMPR(660,"
- DO ^DIK
- WRITE "."
- +9 KILL RMPRAR
- +10 QUIT
- SS660 ;set new status in 660.5
- +1 WRITE !!,"CANCELLING THE OBLIGATION!"
- +2 IF $GET(RMPRF)'>0
- SET RMPRF=$PIECE($GET(^RMPR(664,RMPRA,2)),U,4)
- +3 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
- WRITE !,$CHAR(7),$CHAR(7),"Transaction Canceled and Deleted..."
- DO LINK^RMPRS
- +3 ;
- EXIT if $DATA(RMPRA)
- LOCK -^RMPR(664,RMPRA,0)
- +1 KILL LINE,PRCSCPAN,PRCSIP,RMPR("OB"),RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
- +2 KILL RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
- +3 KILL RMPROB,RMPRSSN,DR,PRC,RMPRC,DIC,DIK,%,R1,DA,B2,RMPRCK,DIC
- +4 KILL DIK,I,Y,RAC,R90,RMPRN,^TMP($JOB)
- +5 QUIT
- H WRITE !,"By entering Yes, this will Delete the transaction in Prosthetics, and Cancel the Transaction in IFCAP."
- GOTO A
- H2 WRITE !,"By entering Yes, this will Cancel the Transaction in IFCAP,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 Transaction has already been Closed!"
- GOTO EXIT
- M6 WRITE !,$CHAR(7),$CHAR(7),"This transaction has already been Canceled!"
- GOTO EXIT