| 1 | GMRGARC0 ;HIRMFO/RM-ARCHIVE/PURGE UTILITY FOR GMR TEXT FILE ;4/15/96
|
|---|
| 2 | ;;3.0;Text Generator;**1**;Jan 24, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | EN1 ; 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
|
|---|
| 22 | START ; 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
|
|---|
| 32 | Q ; 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
|
|---|
| 41 | UNL ; Unlock ^GMRD(124.1,1,"PURGE") and go to Q
|
|---|
| 42 | L -^GMRD(124.1,1,"PURGE")
|
|---|
| 43 | G Q
|
|---|
