source: FOIAVistA/trunk/r/ENGINEERING-EN/ENAR1.m@ 677

ENAR1 ;(WIRMFO)/JED-ARCHIVE MODULE ;4.22.97
 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
 ;EXPECTS VARIABLES ENRT,ENGBL ;CALLED BY ENAR ;CALLS ENJC2,ENJDPL,ENJPARAM,ENARG,ENARGO,ENARGR
 Q
 ;;
G ;GATHER RECORDS
 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
 D GS G:ENGS="010" G2 D @$S(ENGS="1111":"AD",1:"AD3") G:ENERR'=0 MSG I ENGS="010",$D(ENID) S ENTASK=5,ENDA=$P(ENID,",",4) D UP
G2 D G^ENARG G:ENERR'=0 MSG I $D(^ENAR(ENGBL,-1)) W !!,*7,"Records gathering complete" S ^ENAR(ENGBL,"LOCK")="",ENTASK=2 D UP,OUT Q
 S ENERR="DATA NOT ACCEPTED." G MSG
A ;ARCHIVE & VERIFY RECORDS
 D GS I ENGS'="1111" W !,"Bad news, Your archive global is not as expected" D MSG1 S ENERR="BAD ARCHIVE GLOBAL" K ^ENAR(ENGBL,"LOCK") G MSG
 D C^ENAR2 G:ENERR'=0 MSG S ENTASK=3 D UP,A^ENARGO G:ENERR'=0 MSG
 S ENTASK=4 D UP W !!,*7,"verify completed" D OUT Q
D ;DELETE ARCHIVE GLOBAL
 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
 D GS I ENGS="010" W !!,"Your archive global has been deleted already" D OUT Q
 I ENGS="1111" D C^ENAR2 G:ENERR'=0 MSG
D1 I $E(ENGS)=1,'$D(ENDA),$D(@ENID) S ENDA=+$P(^ENAR(ENGBL,-1),",",4)
D11 W !,"OK to delete this global" S %=2 D YN^DICN G:%=0 D11 I %'=1 S ENERR="KEEP ARCHIVE GLOBAL" G MSG
 D D2 S ENTASK=5 D:$D(ENDA) UP G:ENERR'=0 MSG
 W !!,*7,"Archive global deleted" D OUT Q
D2 S:$E(ENGS)=1 ENID=^ENAR(ENGBL,-1)
 S DIU=ENGBL,DIU(0)="" D EN^DIU2 K DIU
 K ^ENAR(ENGBL)
 S ENFN=$S(ENRT=1:"WO ARCHIVE",ENRT=2:"2162 ACCIDENT ARCHIVE",ENRT=3:"EQUIPMENT INV. ARCHIVE",ENRT=4:"PROJECT ARCHIVE",ENRT=5:"CONTROL POINT ARCHIVE"),^ENAR(ENGBL,0)=ENFN_"^"_ENGBL_"^^" Q
R ;RECALL ARCHIVE INFORMATION
 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
 D GS I ENGS'="010" D AD I ENERR=0,$D(ENID) S ENTASK=5,ENDA=+$P(ENID,",",4) D UP
 I $O(^ENAR(ENGBL,0))>0 S ENFN=$S(ENRT=1:"WO ARCHIVE",ENRT=2:"2162 ACCIDENT ARCHIVE",ENRT=3:"EQUIPMENT INV. ARCHIVE",ENRT=4:"PROJECT ARCHIVE",ENRT=5:"CONTROL POINT ARCHIVE") W !,"There is data in your ",ENFN," file." D R1,AD2
 G:ENERR'=0 MSG D R^ENARGR I ENERR'=0 G MSG
 S ENTASK=6 D UP W !!,"Recall completed" D OUT Q
R1 W !,"Before recalling more records, you must first delete existing data from",!,"your ",ENFN," file." Q
 ;;
SID ;SELECT ARCHIVE ID
 S DIC="^ENG(6919,",DIC(0)="AEQM",DIC("S")="I $D(^(1)),$P(^(1),""^"",1)=ENRT" D ^DIC S:+Y<0 ENERR="I.D. SELECT" S ENDA=+Y K DIC,Y Q
GS ;GLOBAL STATUS
 S ENGS=999 I $D(^ENAR(ENGBL)) S ENGS=$D(^ENAR(ENGBL,-1))_$E($D(^(0)))_$S($O(^ENAR(ENGBL,0))>0:"1",1:"0")
 Q
AD ;ARCHIVE DATA INFO
 W !!,"There is existing data ready for transport or review"
AD1 W !,"Do you want to see the Archive ID information " S %=1 D YN^DICN I %=-1 S ENERR="ARCHIVE ID ABORT" Q
 G AD1:%=0 D ID^ENAR2:%=1
AD2 S ENERR=0 W !!!,"OK to remove archive data " S %=1 D YN^DICN G:%=0 AD2 S:%'=1 ENERR="KILL OLD DATA" D:%=1 D2 Q
AD3 W !,"Note: your archive global is not in order",!,"OK to clean it up" S %=1 D YN^DICN S:%'=1 ENERR="RESET ARCHIVE GLOBAL" D:%=1 D2 Q
UP ;UPDATE ARCHIVAL TRANSACTIONS
 I '$D(ENTASK)!(ENTASK<1)!(ENTASK>6) S ENERR="NEED ENTASK" Q
 S Z=ENDA,%DT="XT",X="N" D ^%DT S ENTIME=Y I '$D(ENEMP) S ENEMP="PROG.MODE" I $D(DUZ),DUZ>0 S ENEMP=$P($P(^VA(200,DUZ,0),U),",")
 I $D(^ENG(6919,Z,2,0))'>0 S ^(0)="^6919.01DA^0^0"
 L +^ENG(6919,Z,2,0):60
 S ENA=$P(^ENG(6919,Z,2,0),U,1,2),ENNXL=$P(^(0),U,3),ENNXT=$P(^(0),U,4)
UP2 S ENNXL=ENNXL+1 I $D(^ENG(6919,Z,2,ENNXL,0))>0 G UP2
 S ENNXT=ENNXT+1,ENOUT=ENA_U_ENNXL_U_ENNXT
 S ^ENG(6919,Z,2,0)=ENOUT,^ENG(6919,Z,2,ENNXL,0)=ENTIME_"^"_ENTASK_"^"_ENEMP L -^ENG(6919,Z,2,0)
 Q
MSG W @IOF,!!,*7,"Process terminated: ",ENERR
OUT K %,ENA,ENDA,ENEMP,ENFN,ENGL,ENGS,ENID,ENNXL,ENNXT,ENOUT,ENTASK,ENTIME,X,Y,X S ENERR=0
MSG1 W !,"<cr> to continue" R ENR:DTIME Q
 ;
 ;ENAR1