source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRCDP.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1RMPRCDP ;PHX/DWL,HNB-PURGE FILE 664 ;8/29/1994
2 ;;3.0;PROSTHETICS;**3**;Feb 09, 1996
3EN1 ;Purge 664, Canceled Transactions
4 D DIV4^RMPRSIT Q:$D(X)
5EN4 K IOP,ZTIO,%ZIS S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP END
6 ;I IOST["C-" W !,$C(7),"YOU MAY NOT SELECT YOUR TERMINAL" G EN4
7 I $D(IO("Q")) D
8 .S ZTRTN="EN11^RMPRCDP"
9 .S ZTDESC="CANCEL TRANSACTIONS IN FILE 664 FOR A STATION/DIVISION"
10 .F RD="I","RMPRIEN","RMPRDT","RMPRSITE","RMPR(" S ZTSAVE(RD)=""
11 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"<REQUEST QUEUED!>",1:"<REQUEST NOT QUEUED!>") G END
12EN11 S (I,RMPRIEN)=0,RMPRDT=$P(^RMPR(669.9,RMPRSITE,0),U,10) G:RMPRDT'>89 END
13 S X1=DT,X2=-RMPRDT D C^%DTC S RMPRDT=X D NOW^%DTC S Y=% X ^DD("DD")
14 U IO W !!,"Purge Canceled Prosthetic Purchasing Transactions For: ",!,$P(^RMPR(669.9,RMPRSITE,0),U,1)," On ",Y,!!
15 F S RMPRIEN=$O(^RMPR(664,RMPRIEN)) Q:RMPRIEN'>0 D
16 .;quit if it is a purchase card transaction, non get purged
17 .Q:$D(^RMPR(664,RMPRIEN,4))
18 .I ($P(^RMPR(664,RMPRIEN,0),U,5))&($P(^(0),U,5)<RMPRDT&($P(^(0),U,14)=RMPR("STA"))) D
19 ..S DA=RMPRIEN,DIC="^RMPR(664," D EN^DIQ
20 ..S DA=RMPRIEN,DIK=DIC D ^DIK W "Deleted...",! S RDEL=1
21 I '$D(RDEL) S $P(L,"-",IOM)="" W !,L,!,?5,"NO CANCELED PURCHASING TRANSACTIONS DELETED"
22 G END
23EN ;PURGE 664 FILE OF ENTRIES CLOSED OUT FOR A STATION/DIVISION
24 D DIV4^RMPRSIT Q:$D(X)
25EN5 K IOP,%ZIS,ZTIO S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP END
26 ;I IOST["C-" W !,$C(7),"YOU MAY NOT SELECT YOUR OWN TERMINAL" G EN5
27 I $D(IO("Q")) S ZTRTN="EN2^RMPRCDP",ZTDESC="PURGE 664 OF CLOSED OUT ENTRIES" F RD="I","RMPRIEN","RMPRDT","RMPRSITE","RMPR(" S ZTSAVE(RD)=""
28 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"<REQUEST QUEUED!>",1:"<REQUEST NOT QUEUED>") G END
29EN2 S (I,RMPRIEN)=0,RMPRDT=$P(^RMPR(669.9,RMPRSITE,0),U,9) G:RMPRDT'>89 END
30 S X1=DT,X2=-RMPRDT D C^%DTC S RMPRDT=X D NOW^%DTC S Y=% X ^DD("DD")
31 U IO W !!,"Purge Closed Prosthetic Purchasing Transactions For",!,$P(^RMPR(669.9,RMPRSITE,0),U,1)," On ",Y,!!
32 F S RMPRIEN=$O(^RMPR(664,RMPRIEN)) Q:RMPRIEN'>0 D
33 .;quit if it is a purchase card transaction, non get purged
34 .Q:$D(^RMPR(664,RMPRIEN,4))
35 .I ($P(^RMPR(664,RMPRIEN,0),U,8))&($P(^(0),U,8)<RMPRDT&($P(^(0),U,14)=RMPR("STA"))) D
36 ..S DA=RMPRIEN,DIC="^RMPR(664," D EN^DIQ
37 ..S DA=RMPRIEN,DIK=DIC D ^DIK W "Deleted",! S RDEL=1
38 I '$D(RDEL) S $P(L,"-",IOM)="" W !,L,!,?5,"NO CLOSED PURCHASING TRANSACTIONS DELETED",!
39END K I,RD,RMPRIEN,RMPRDT,RMPR,DIK,DA,DIC,X1,X2,L,RDEL,ZTSK D ^%ZISC
40 Q
41EN3 ;Purge Non-Obligated Transactions
42 ;IF C.P. and Reference Number missing, transaction not obligated to IFCAP
43 D DIV4^RMPRSIT Q:$D(X)
44 K IOP,%ZIS,ZTIO S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP END
45 I $D(IO("Q")) S ZTRTN="EN3A^RMPRCDP",ZTDESC="Purge Non-Obligated Transactions For Station # "_RMPR("STA"),ZTSAVE("RMPR*")=""
46 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"<REQUEST QUEUED!>",1:"<REQUEST NOT QUEUED>")
47 G END
48EN3A ;
49 S RMPRA=0 F S RMPRA=$O(^RMPR(664,RMPRA)) Q:RMPRA'>0 D
50 .;quit if this is a purchase card transaction, non should be purged
51 .Q:$D(^RMPR(664,RMPRA,4))
52 .I '$P(^RMPR(664,RMPRA,0),U,6)&('$P(^(0),U,7))&($P(^(0),U,14)=RMPR("STA")) D
53 ..S DA=RMPRA,DIC="^RMPR(664," D EN^DIQ
54 ..S DA=RMPRA,DIK=DIC D ^DIK W "Deleted...",! S RDEL=1
55 I $G(RDEL)'=1 W !!,"No Non-Obligated Transactions deleted."
56 K RMPRA,DIK,DA,I,DIC D ^%ZISC
57 Q
Note: See TracBrowser for help on using the repository browser.