GMRGARC0 ;HIRMFO/RM-ARCHIVE/PURGE UTILITY FOR GMR TEXT FILE ;4/15/96
 ;;3.0;Text Generator;**1**;Jan 24, 1996
 ;
EN1 ; Entry from the option Purge GMR Text File Data [GMRG-PURGE PT DATA]
 ;
 L +^GMRD(124.1,1,"PURGE"):1 I '$T W !!,"SOMEONE ELSE IS RUNNING THE PURGE OPTION, TRY AGAIN LATER!!" G Q
 I $P($G(^GMRD(124.1,1,"PURGE")),"^") W !!,"THE GMR TEXT FILE PURGE IS ALREADY RUNNING, TRY AGAIN LATER!!" G UNL
 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."
 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
 S GMRGPMO=Y,X="T-"_GMRGPMO_"M",%DT="" D ^%DT I Y<0 G UNL
 S GMRGPURG=Y,GMRGPURG(0)=$$FMTE^XLFDT(Y)
 S DIR("?")="   ANSWERING YES HERE CONFIRMS YOU WISH TO PURGE THE GMR TEXT DATA."
 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
 S DIR("?")="   ANSWERING YES HERE WILL BEGIN THE PURGE.",DIR("B")="YES"
 S DIR("A")="OK to proceed: ",DIR(0)="YA" W ! D ^DIR K DIR I Y'=1 G UNL
 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
 W !!,"Job queued as task #"_ZTSK
 S $P(^GMRD(124.1,1,"PURGE"),"^")=ZTSK
 S DA=1,DIK="^GMRD(124.1,",DIK(1)=2 D IX1^DIK
 K ZTSK
 G UNL
START ; Enter here from queued job
 ;
 ;  Input variable:  GMRGPURG=date to end loop for data purge
 ;
 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
 .   S DA=0 F  S DA=$O(^NURSC(216.8,"B",GMRGPDA,DA)) Q:DA'>0  S DIK="^NURSC(216.8," D ^DIK
 .   S DA=GMRGPDA,DIK="^GMR(124.3," D ^DIK
 .   I $$S^%ZTLOAD S ZTSTOP=1
 .   Q
 I '$G(ZTSTOP) S DIE="^GMRD(124.1,",DA=1,DR="2///@" D ^DIE
Q ; Clean up and exit
 I $D(ZTQUEUED),'$G(ZTSTOP) D
 .  S ZTREQ="@"
 .  N XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
 .  S XQA(DUZ)="",XQAMSG="Purge is completed.  Restart journaling for the GMR and NURSC globals." D SETUP^XQALERT
 .  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
 .  Q
 K %DT,DA,DIE,DIK,DIR,DR,GMRGDATE,GMRGPDA,GMRGPMO,GMRGPURG,X,Y D ^%ZISC
 Q
UNL ; Unlock ^GMRD(124.1,1,"PURGE") and go to Q
 L -^GMRD(124.1,1,"PURGE")
 G Q