source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGARC0.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: 2.5 KB
Line 
1GMRGARC0 ;HIRMFO/RM-ARCHIVE/PURGE UTILITY FOR GMR TEXT FILE ;4/15/96
2 ;;3.0;Text Generator;**1**;Jan 24, 1996
3 ;
4EN1 ; Entry from the option Purge GMR Text File Data [GMRG-PURGE PT DATA]
5 ;
6 L +^GMRD(124.1,1,"PURGE"):1 I '$T W !!,"SOMEONE ELSE IS RUNNING THE PURGE OPTION, TRY AGAIN LATER!!" G Q
7 I $P($G(^GMRD(124.1,1,"PURGE")),"^") W !!,"THE GMR TEXT FILE PURGE IS ALREADY RUNNING, TRY AGAIN LATER!!" G UNL
8 K DIR S DIR("?")=" ENTER THE NUMBER OF MONTHS OF GMR TEXT DATA TO BE RETAINED.",DIR("?",1)=" YOU MUST RETAIN AT LEAST SIX MONTHS OF GMR TEXT DATA."
9 S DIR(0)="NAO^6:99999",DIR("A")="Enter number of months to RETAIN GMR Text data: " W ! D ^DIR K DIR G UNL:'Y
10 S GMRGPMO=Y,X="T-"_GMRGPMO_"M",%DT="" D ^%DT I Y<0 G UNL
11 S GMRGPURG=Y,GMRGPURG(0)=$$FMTE^XLFDT(Y)
12 S DIR("?")=" ANSWERING YES HERE CONFIRMS YOU WISH TO PURGE THE GMR TEXT DATA."
13 S DIR("A",1)="Are you sure you only want to retain data from "_GMRGPURG(0),DIR("A")="to today (Y/N): ",DIR(0)="YA" W ! D ^DIR K DIR I Y'=1 G UNL
14 S DIR("?")=" ANSWERING YES HERE WILL BEGIN THE PURGE.",DIR("B")="YES"
15 S DIR("A")="OK to proceed: ",DIR(0)="YA" W ! D ^DIR K DIR I Y'=1 G UNL
16 S ZTIO="",ZTRTN="START^GMRGARC0",ZTDESC="GMR Text File Date Purge",ZTSAVE("GMRGPURG")="" D ^%ZTLOAD I '$D(ZTSK) W !!,"Job not queued, please try again..." G UNL
17 W !!,"Job queued as task #"_ZTSK
18 S $P(^GMRD(124.1,1,"PURGE"),"^")=ZTSK
19 S DA=1,DIK="^GMRD(124.1,",DIK(1)=2 D IX1^DIK
20 K ZTSK
21 G UNL
22START ; Enter here from queued job
23 ;
24 ; Input variable: GMRGPURG=date to end loop for data purge
25 ;
26 S GMRGDATE=0 F S GMRGDATE=$O(^GMR(124.3,"AUPDT",GMRGDATE)) Q:GMRGDATE'>0!(GMRGDATE>GMRGPURG)!$G(ZTSTOP) S GMRGPDA=0 F S GMRGPDA=$O(^GMR(124.3,"AUPDT",GMRGDATE,GMRGPDA)) Q:GMRGPDA'>0!$G(ZTSTOP) D
27 . S DA=0 F S DA=$O(^NURSC(216.8,"B",GMRGPDA,DA)) Q:DA'>0 S DIK="^NURSC(216.8," D ^DIK
28 . S DA=GMRGPDA,DIK="^GMR(124.3," D ^DIK
29 . I $$S^%ZTLOAD S ZTSTOP=1
30 . Q
31 I '$G(ZTSTOP) S DIE="^GMRD(124.1,",DA=1,DR="2///@" D ^DIE
32Q ; Clean up and exit
33 I $D(ZTQUEUED),'$G(ZTSTOP) D
34 . S ZTREQ="@"
35 . N XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
36 . S XQA(DUZ)="",XQAMSG="Purge is completed. Restart journaling for the GMR and NURSC globals." D SETUP^XQALERT
37 . S XQA(DUZ)="",XQA("G.NURS-ADP")="",XQAMSG="Patient plan of care data older than "_$$FMTE^XLFDT(GMRGPURG,2)_" has been purged from the system." D SETUP^XQALERT
38 . Q
39 K %DT,DA,DIE,DIK,DIR,DR,GMRGDATE,GMRGPDA,GMRGPMO,GMRGPURG,X,Y D ^%ZISC
40 Q
41UNL ; Unlock ^GMRD(124.1,1,"PURGE") and go to Q
42 L -^GMRD(124.1,1,"PURGE")
43 G Q
Note: See TracBrowser for help on using the repository browser.