Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (15 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR4C21.m

    r613 r623  
    1 RMPR4C21        ;PHX/HNB-CANCEL A PURCHASE CARD TRANSACTION;3/1/1996
    2         ;;3.0;PROSTHETICS;**3,20,62,140**;Feb 09, 1996;Build 10
    3         ;Per VHA Directive 2004-038, 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         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
    28         D CAN^PRCH7B(.X,RMPRA,RMPR442,0)
    29         I X="^" W !!,"NOT CANCELED You must say YES to 'Approve and print Amendment number'" G EXIT
    30         K RMPR442,X
    31 BYPASS  S RMPRAR=$S($P(^RMPR(664,RMPRA,0),U,12)'="":$P(^(0),U,12),1:""),$P(^(0),U,12)=""
    32         D:RMPRAR'="" K660
    33         Q:$G(RMPRA)'>0
    34         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
    35 C58     ;CLOSE OUT
    36         I $D(RMPRWO),RMPRWO D  D CA0^RMPR29M(RMPRDA,RMPRA)
    37         .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
    38         ;
    39         G K664
    40 K660    ;DELETE APPLIANCE/REPAIR RECORDS
    41         D SS660 Q:$G(RMPRAR)'>0
    42         ;modified by #62
    43         ;call pce delete if patient encounter was recorded
    44         I $D(^RMPR(660,RMPRAR,10)),$P(^RMPR(660,RMPRAR,10),U,12) D
    45         .S RMCHK=0
    46         .S RMCHK=$$PCED^RMPRPCEP(RMPRAR)
    47         S DA=RMPRAR,DIK="^RMPR(660," D ^DIK W "."
    48         K RMPRAR
    49         Q
    50 SS660   ;
    51         ;
    52         Q
    53 K664    ;CANCEL FLAG
    54         S $P(^RMPR(664,RMPRA,0),"^",5)=DT,$P(^RMPR(664,RMPRA,2),"^",2)=DUZ
    55         S DA=RMPRA,DR="3.1",DIE="^RMPR(664," D ^DIE
    56         W !,$C(7),$C(7),"Transaction Canceled and Deleted..." H 2 D LINK^RMPRS
    57         ;
    58 EXIT    L:$D(RMPRA) -^RMPR(664,RMPRA,0)
    59         N RMPR,RMPRSITE D KILL^XUSCLEAN
    60         K LINE,RMPRAMIS,RMPRA,RMPRAR,RMPRCNT
    61         K RMPRI,RMPRIT,RMPRIT1,RMPRU,RMPRX,X,PRCS,DIE,PRCSX,RMPRDFN,RMPRNAM
    62         K RMPRSSN,DR,PRC,RMPRC,DIC,DIK,%,R1,DA,B2,RMPRCK,DIC
    63         K DIK,I,Y,RAC,R90,RMPRN,^TMP($J)
    64         Q
    65 H       W !,"By entering Yes, will Delete the transaction in Prosthetics." G A
    66 H2      W !,"By entering Yes, will Cancel the Transaction , and NOT UPDATE the 10-2319." G M3A
    67 M3      W !,$C(7),$C(7),"TRANSACTION MISSING APPLIANCE/REPAIR RECORD!"
    68 M3A     W !,"Do you still want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H2 G C58
    69 M4      W !,$C(7),$C(7),"This Transacion has already been Closed!" G EXIT
    70 M6      W !,$C(7),$C(7),"This transaction has already been Canceled!" G EXIT
     1RMPR4C21 ;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 ;
     6EN ;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
     14CL 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
     22A 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
     30BYPASS 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
     34C58 ;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
     39K660 ;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
     49SS660 ;
     50 ;
     51 Q
     52K664 ;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 ;
     57EXIT 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
     64H W !,"By entering Yes, will Delete the transaction in Prosthetics." G A
     65H2 W !,"By entering Yes, will Cancel the Transaction , and NOT UPDATE the 10-2319." G M3A
     66M3 W !,$C(7),$C(7),"TRANSACTION MISSING APPLIANCE/REPAIR RECORD!"
     67M3A W !,"Do you still want to CANCEL this Transaction" S %=0 D YN^DICN G:%<0!(%=2) EXIT G:%=0 H2 G C58
     68M4 W !,$C(7),$C(7),"This Transacion has already been Closed!" G EXIT
     69M6 W !,$C(7),$C(7),"This transaction has already been Canceled!" G EXIT
Note: See TracChangeset for help on using the changeset viewer.