source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPURG.m@ 701

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PPPPURG ;ALB/GGP,DAD - ppp logfile purge routine ;03/13/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**2,5,21**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; purge any log entrys which are earlier than (today-days retained)
6 ; days =days retained
7 ; pdate =purge date in fileman format (purge before this day)
8 ; date =date of current record
9LOG ;
10 N PURGE,BOGUS,DAYS,PDATE,DATE,X,Y,DIR,Y
11 ;
12 S DIR(0)="YA",DIR("A")="Purge entries in PPP LOG file: ",DIR("B")="NO"
13 S DIR("?")="Enter yes to purge out entries in file." D ^DIR
14 I Y D Q
15 .D LOG1 W !!,"RETAINED LAST "_$G(DAYS)_" DAYS, PURGED "_$G(PURGE)_" RECORDS.",!!,"PPP LOG file unchanged"
16 Q
17 ;
18LOG1 ; -- purges entries from log file
19 S PURGE=0
20 S BOGUS=$$LOGEVNT^PPPMSC1(1019,"LOG1_PPPPURG")
21 ; write log 'purge started'
22 ;
23 S DAYS=$P($G(^PPP(1020.1,1,0)),"^",11),X1=DT,X2=-DAYS+1 D C^%DTC S PDATE=X
24 ;W !,PDATE
25LOOP ;
26 ;loop through date in 'c'->date index
27 S DATE="" FOR X=0:0 D Q:DATE=""
28 .S DATE=$O(^PPP(1020.4,"C",DATE)) Q:DATE=""
29 .S DA=""
30 .;
31 .; loop thru rec with same date, check date/delete
32 .;
33 .F Y=0:0 D Q:DA=""
34 ..S DA=$O(^PPP(1020.4,"C",DATE,DA)) Q:DA=""
35 ..I (DATE<PDATE) D
36 ...S DIK="^PPP(1020.4,"
37 ...;W !,"PURGING= ",DA
38 ...D ^DIK S PURGE=PURGE+1
39EXIT ;
40 ;write # of days retained, and # of records purged from logfile
41 ;
42 S BOGUS=$$LOGEVNT^PPPMSC1(1020,"_PPPPURG","RETAINED LAST "_$G(DAYS)_" DAYS, PURGED "_$G(PURGE)_" RECORDS.")
43 S:$D(ZTQUEUED) ZTREQ="@"
44 Q
45 ;
46XREF ;
47 ; purge any xref entrys which are earlier than (today-days retained)
48 ; days =days retained
49 ; pdate =purge date in fileman format (purge before this day)
50 ; date =date of current record
51 ;
52 N PURGE,BOGUS,DAYS,PDATE,DATE,X,Y,DIR,Y
53 ;
54 S DIR(0)="YA",DIR("A")="Purge entries in PPP FOREIGN FACILITY XREF file: ",DIR("B")="NO"
55 S DIR("?")="Enter yes to purge out entries in file." D ^DIR
56 I Y D Q
57 .D XREF1
58 .W !!,"RETAINED LAST "_$G(DAYS)_" DAYS, PURGED "_$G(PURGE)_" RECORDS."
59 W !!,"PPP FOREIGN FACILITY XREF file unchanged"
60 Q
61 ;
62XREF1 ; -- purges other facility Xref
63 S PURGE=0
64 S BOGUS=$$LOGEVNT^PPPMSC1(1021,"XREF1_PPPPURG")
65 ; WRITE LOG 'XREF PURGE STARTED'
66 ;
67 S DAYS=$P($G(^PPP(1020.1,1,0)),"^",12)
68 ; CALCULATE PURGE DATE
69 S X1=DT,X2=-DAYS+1
70 D C^%DTC S PDATE=X
71 ;W !,PDATE
72 ;
73XREFLOOP ;
74 ;DAVE B (PPP*1*21)
75 ;Loop through "D" xref
76 K DATE,PURGE
771 S DATE=$S('$D(DATE):$O(^PPP(1020.2,"D",0)),1:$O(^PPP(1020.2,"D",DATE))) G KLLQ:DATE'>0 S IFN=0
78 I DATE>PDATE G 1
79 ;
802 S IFN=$O(^PPP(1020.2,"D",DATE,IFN)) G 1:IFN'>0
81 S DATA=$G(^PPP(1020.2,IFN,0))
82 S DATA1=$G(^PPP(1020.2,IFN,1))
83 S PATDFN=$S($P($G(DATA),"^")="":0,1:$P($G(DATA),"^"))
84 S POV=$S($P($G(DATA),"^",2)="":0,1:$P($G(DATA),"^",2))
85 K ^PPP(1020.2,"ARPOV",POV,PATDFN,IFN)
86 K ^PPP(1020.2,"APOV",PATDFN,POV,IFN)
87 S DA=IFN,DIK="^PPP(1020.2," D ^DIK S PURGE=$G(PURGE)+1 G 2
88 ;
89KLLQ K DATE,DATA,DATA1,PATDFN,POV,IFN Q
90 ;
91XREFEXIT ;
92 ;write # of days retained, and # of records purged from xref
93 ;
94 S BOGUS=$$LOGEVNT^PPPMSC1(1022,"_PPPPURG","RETAINED LAST "_$G(DAYS)_" DAYS, PURGED "_$G(PURGE)_" RECORDS.")
95 S:$D(ZTQUEUED) ZTREQ="@"
96 Q
97SETUP1 ;queues background job to purge logfile data
98 D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("B")="NOW",%DT("A")="QUEUE JOBS TO RUN AT WHAT TIME: " D ^%DT S PSOQTIME=Y I $D(DTOUT)!(Y=-1) W !,"Try again later",! G OUT
99 S ZTIO="",ZTRTN="LOG1^PPPPURG",ZTDTH=PSOQTIME,ZTDESC="PPP PURGE LOGFILE DATA" D ^%ZTLOAD
100OUT K Y,X,PSOQTIME,%DT
101 Q
102 ;
103SETUP2 ;queues background job to purge xref data
104 D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("B")="NOW",%DT("A")="QUEUE JOBS TO RUN AT WHAT TIME: " D ^%DT S PSOQTIME=Y I $D(DTOUT)!(Y=-1) W !,"Try again later",! G OUT2
105 S ZTIO="",ZTRTN="XREF1^PPPPURG",ZTDTH=PSOQTIME,ZTDESC="PPP PURGE FORIEGN FACILITY XREF" D ^%ZTLOAD
106OUT2 K Y,X,PSOQTIME,%DT
107 Q
Note: See TracBrowser for help on using the repository browser.