Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPURG.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPURG.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPURG.m
r613 r623 1 ECXPURG ;BIR/CML-Driver for Purge of DSS Data from Local Extract & Holding Files ; 4/17/07 2:35pm 2 ;;3.0;DSS EXTRACTS;**9,24,33,35,49,102**;Dec 22, 1997;Build 17 3 EN ;entry point from option 4 W @IOF,!!,"This option will allow you to purge:" 5 W !,"1. individual or a range of DSS extracts, or" 6 W !,"2. data that resides in the ""holding files"" for the IVP and UDP extracts." 7 W !,"3. data that resides in the ""holding file"" for the VBECS extract" 8 W !!,"Care must be taken for several reasons:" 9 W !!,"- You can purge ANY existing extract. This includes transmitted and non-" 10 W !," transmitted extracts as well as extracts that did not run to completion" 11 W !," due to errors or system problems." 12 W !,"- Choosing a range of extracts (or a broad date range for the ""holding" 13 W !," files"") could mean an excessively large number of records and be very" 14 W !," CPU intensive. Please be sure to queue this purge for off-hours and" 15 W !," limit the number of extracts to be purged per a single queued session." 16 W !,"- The IVP, UDP and VBECS ""holding"" files are intermediate files that" 17 W !," are populated ""realtime"" by inpatient pharmacy and VBECS activity. These" 18 W !," files are then used to generate the IVP, UDP and VBECS extracts and CANNOT be" 19 W !," recreated. Once they are purged for a date range, extracts can no longer be" 20 W !," generated for that time period." 21 ; 22 K DIR W ! 23 S DIR(0)="SAM^E:Extract Files;I:IVP Holding File;U:UDP Holding File;V:VBECS Holding File" 24 S DIR("A")="Purge (E)xtract files, (I)VP data, (U)DP data or (V)BECS data? " 25 D ^DIR K DIR G:$D(DIRUT) QUIT S ECY=Y 26 I ECY="E" D ^ECXPURG1 I $D(ECLOC) S ZTSAVE("ECLOC(")="",ZTIO="",ZTRTN="PUR1^ECXPURG",ZTDESC="DSS - Purge of Extract Files" D QUE 27 I ECY="I" D DATES^ECXPURG1 I $D(ECBDT)&($D(ECEDT)) S (ZTSAVE("ECBDT"),ZTSAVE("ECEDT"))="",ZTIO="",ZTRTN="PUR2^ECXPURG",ZTDESC="DSS - Purge of IVP Holding File" D QUE 28 I ECY="U" D DATES^ECXPURG1 I $D(ECBDT)&($D(ECEDT)) S (ZTSAVE("ECBDT"),ZTSAVE("ECEDT"))="",ZTIO="",ZTRTN="PUR3^ECXPURG",ZTDESC="DSS - Purge of UDP Holding File" D QUE 29 I ECY="V" D DATES^ECXPURG1 I $D(ECBDT)&($D(ECEDT)) S (ZTSAVE("ECBDT"),ZTSAVE("ECEDT"))="",ZTIO="",ZTRTN="PUR4^ECXPURG",ZTDESC="DSS - Purge of VBECS Holding File" D QUE 30 QUIT ; 31 K %X,%Y,EC,ECBDT,ECDATE,ECDT,ECEDT,ECEX,ECFR,ECLOC,ECRC,ECTO,ECTRN,ECTYP,ECY,HDT,HI,JJ,LN,LO,PG,QFLG,SS,X,Y,ZTSK 32 K ECXDIV 33 S:$D(ZTQUEUED) ZTREQ="@" 34 Q 35 QUE W $C(7),$C(7),!!?3,"<<This purge should be queued to run during non-peak hours.>>",! 36 D ^%ZTLOAD 37 I $D(ZTSK) W !,"Request queued as Task #",ZTSK,".",! 38 Q 39 ; 40 PUR1 ; entry point for queued purge job of extract files 41 S ECDA=0 F S ECDA=$O(ECLOC(ECDA)) Q:'ECDA D 42 .S ECFILE=^ECX(727,ECDA,"FILE"),ECJ=0 43 .I ECFILE=727.827 D 44 ..S DA(1)=1 45 ..S DA=$O(^ECX(728,DA(1),"CBOC","B",ECDA,0)) 46 ..S DIK="^ECX(728,"_DA(1)_","_"""CBOC"""_"," 47 ..I DA'="" D ^DIK K DIK,DA 48 .F S ECJ=$O(^ECX(ECFILE,"AC",ECDA,ECJ)) Q:'ECJ D 49 ..S DIK="^ECX("_ECFILE_",",DA=ECJ D ^DIK K DIK,DA 50 .I ECFILE=727.816 S ECFILE=727.818,ECJ=0 D 51 ..F S ECJ=$O(^ECX(ECFILE,"AC",ECDA,ECJ)) Q:'ECJ D 52 ...S DIK="^ECX("_ECFILE_",",DA=ECJ D ^DIK K DIK,DA 53 .S ^ECX(727,ECDA,"PURG")=DT 54 D QUIT 55 Q 56 ; 57 PUR2 ; entry point for queued purge job of IVP holding file (#728.113) 58 F ECDT=ECBDT-1:0 S ECDT=$O(^ECX(728.113,"A",ECDT)) Q:'ECDT Q:ECDT>ECEDT S ECPT=0 F S ECPT=$O(^ECX(728.113,"A",ECDT,ECPT)) Q:'ECPT D 59 .S ECOR=0 F S ECOR=$O(^ECX(728.113,"A",ECDT,ECPT,ECOR)) Q:'ECOR D 60 ..S ECREC=0 F S ECREC=$O(^ECX(728.113,"A",ECDT,ECPT,ECOR,ECREC)) Q:'ECREC D 61 ...S DIK="^ECX(728.113,",DA=ECREC D ^DIK K DIK,DA 62 D QUIT 63 Q 64 ; 65 PUR3 ; entry point for queued purge job of UDP holding file (#728.904) 66 F ECDT=ECBDT-1:0 S ECDT=$O(^ECX(728.904,"A",ECDT)) Q:'ECDT Q:ECDT>ECEDT D 67 .S ECREC=0 F S ECREC=$O(^ECX(728.904,"A",ECDT,ECREC)) Q:'ECREC D 68 ..S DIK="^ECX(728.904,",DA=ECREC D ^DIK K DIK,DA 69 D QUIT 70 Q 71 ; 72 PUR4 ; entry point for queued purge job of VBECS holding file (#6002.03) 73 N ECDT,ECREC,DIK,DA 74 S ECDT=ECBDT-1,ECEDT=ECEDT+.9 75 F S ECDT=$O(^VBEC(6002.03,"C",ECDT)) Q:'ECDT!(ECDT>ECEDT) D 76 .S ECREC=0 F S ECREC=$O(^VBEC(6002.03,"C",ECDT,ECREC)) Q:'ECREC D 77 ..S DIK="^VBEC(6002.03,",DA=ECREC D ^DIK K DIK,DA 78 Q 1 ECXPURG ;BIR/CML-Driver for Purge of DSS Data from Local Extract & Holding Files ; [ 12/03/96 5:19 PM ] 2 ;;3.0;DSS EXTRACTS;**9,24,33,35,49**;Dec 22, 1997 3 EN ;entry point from option 4 W @IOF,!!,"This option will allow you to purge:" 5 W !,"1. individual or a range of DSS extracts, or" 6 W !,"2. data that resides in the ""holding files"" for the IVP and UDP extracts." 7 W !!,"Care must be taken for several reasons:" 8 W !!,"- You can purge ANY existing extract. This includes transmitted and non-" 9 W !," transmitted extracts as well as extracts that did not run to completion" 10 W !," due to errors or system problems." 11 W !,"- Choosing a range of extracts (or a broad date range for the ""holding" 12 W !," files"") could mean an excessively large number of records and be very" 13 W !," CPU intensive. Please be sure to queue this purge for off-hours and" 14 W !," limit the number of extracts to be purged per a single queued session." 15 W !,"- The IVP and UDP ""holding"" files are intermediate files that are" 16 W !," populated ""realtime"" by inpatient pharmacy activity. These files are" 17 W !," then used to generate the IVP and UDP extracts and CANNOT be recreated." 18 W !," Once they are purged for a date range, extracts can no longer be" 19 W !," generated for that time period." 20 ; 21 K DIR W ! 22 S DIR(0)="SAM^E:Extract Files;I:IVP Holding File;U:UDP Holding File" 23 S DIR("A")="Purge (E)xtract files, (I)VP data, or (U)DP data? " 24 D ^DIR K DIR G:$D(DIRUT) QUIT S ECY=Y 25 I ECY="E" D ^ECXPURG1 I $D(ECLOC) S ZTSAVE("ECLOC(")="",ZTIO="",ZTRTN="PUR1^ECXPURG",ZTDESC="DSS - Purge of Extract Files" D QUE 26 I ECY="I" D DATES^ECXPURG1 I $D(ECBDT)&($D(ECEDT)) S (ZTSAVE("ECBDT"),ZTSAVE("ECEDT"))="",ZTIO="",ZTRTN="PUR2^ECXPURG",ZTDESC="DSS - Purge of IVP Holding File" D QUE 27 I ECY="U" D DATES^ECXPURG1 I $D(ECBDT)&($D(ECEDT)) S (ZTSAVE("ECBDT"),ZTSAVE("ECEDT"))="",ZTIO="",ZTRTN="PUR3^ECXPURG",ZTDESC="DSS - Purge of UDP Holding File" D QUE 28 QUIT ; 29 K %X,%Y,EC,ECBDT,ECDATE,ECDT,ECEDT,ECEX,ECFR,ECLOC,ECRC,ECTO,ECTRN,ECTYP,ECY,HDT,HI,JJ,LN,LO,PG,QFLG,SS,X,Y,ZTSK 30 K ECXDIV 31 S:$D(ZTQUEUED) ZTREQ="@" 32 Q 33 QUE W $C(7),$C(7),!!?3,"<<This purge should be queued to run during non-peak hours.>>",! 34 D ^%ZTLOAD 35 I $D(ZTSK) W !,"Request queued as Task #",ZTSK,".",! 36 Q 37 ; 38 PUR1 ; entry point for queued purge job of extract files 39 S ECDA=0 F S ECDA=$O(ECLOC(ECDA)) Q:'ECDA D 40 .S ECFILE=^ECX(727,ECDA,"FILE"),ECJ=0 41 .I ECFILE=727.827 D 42 ..S DA(1)=1 43 ..S DA=$O(^ECX(728,DA(1),"CBOC","B",ECDA,0)) 44 ..S DIK="^ECX(728,"_DA(1)_","_"""CBOC"""_"," 45 ..I DA'="" D ^DIK K DIK,DA 46 .F S ECJ=$O(^ECX(ECFILE,"AC",ECDA,ECJ)) Q:'ECJ D 47 ..S DIK="^ECX("_ECFILE_",",DA=ECJ D ^DIK K DIK,DA 48 .I ECFILE=727.816 S ECFILE=727.818,ECJ=0 D 49 ..F S ECJ=$O(^ECX(ECFILE,"AC",ECDA,ECJ)) Q:'ECJ D 50 ...S DIK="^ECX("_ECFILE_",",DA=ECJ D ^DIK K DIK,DA 51 .S ^ECX(727,ECDA,"PURG")=DT 52 D QUIT 53 Q 54 ; 55 PUR2 ; entry point for queued purge job of IVP holding file (#728.113) 56 F ECDT=ECBDT-1:0 S ECDT=$O(^ECX(728.113,"A",ECDT)) Q:'ECDT Q:ECDT>ECEDT S ECPT=0 F S ECPT=$O(^ECX(728.113,"A",ECDT,ECPT)) Q:'ECPT D 57 .S ECOR=0 F S ECOR=$O(^ECX(728.113,"A",ECDT,ECPT,ECOR)) Q:'ECOR D 58 ..S ECREC=0 F S ECREC=$O(^ECX(728.113,"A",ECDT,ECPT,ECOR,ECREC)) Q:'ECREC D 59 ...S DIK="^ECX(728.113,",DA=ECREC D ^DIK K DIK,DA 60 D QUIT 61 Q 62 ; 63 PUR3 ; entry point for queued purge job of UDP holding file (#728.904) 64 F ECDT=ECBDT-1:0 S ECDT=$O(^ECX(728.904,"A",ECDT)) Q:'ECDT Q:ECDT>ECEDT D 65 .S ECREC=0 F S ECREC=$O(^ECX(728.904,"A",ECDT,ECREC)) Q:'ECREC D 66 ..S DIK="^ECX(728.904,",DA=ECREC D ^DIK K DIK,DA 67 D QUIT 68 Q
Note:
See TracChangeset
for help on using the changeset viewer.
