61 lines
3.7 KiB
Mathematica
61 lines
3.7 KiB
Mathematica
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
|