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

Last change on this file since 1327 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1ENAR1 ;(WIRMFO)/JED-ARCHIVE MODULE ;4.22.97
2 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
3 ;EXPECTS VARIABLES ENRT,ENGBL ;CALLED BY ENAR ;CALLS ENJC2,ENJDPL,ENJPARAM,ENARG,ENARGO,ENARGR
4 Q
5 ;;
6G ;GATHER RECORDS
7 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
8 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
9G2 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
10 S ENERR="DATA NOT ACCEPTED." G MSG
11A ;ARCHIVE & VERIFY RECORDS
12 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
13 D C^ENAR2 G:ENERR'=0 MSG S ENTASK=3 D UP,A^ENARGO G:ENERR'=0 MSG
14 S ENTASK=4 D UP W !!,*7,"verify completed" D OUT Q
15D ;DELETE ARCHIVE GLOBAL
16 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
17 D GS I ENGS="010" W !!,"Your archive global has been deleted already" D OUT Q
18 I ENGS="1111" D C^ENAR2 G:ENERR'=0 MSG
19D1 I $E(ENGS)=1,'$D(ENDA),$D(@ENID) S ENDA=+$P(^ENAR(ENGBL,-1),",",4)
20D11 W !,"OK to delete this global" S %=2 D YN^DICN G:%=0 D11 I %'=1 S ENERR="KEEP ARCHIVE GLOBAL" G MSG
21 D D2 S ENTASK=5 D:$D(ENDA) UP G:ENERR'=0 MSG
22 W !!,*7,"Archive global deleted" D OUT Q
23D2 S:$E(ENGS)=1 ENID=^ENAR(ENGBL,-1)
24 S DIU=ENGBL,DIU(0)="" D EN^DIU2 K DIU
25 K ^ENAR(ENGBL)
26 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
27R ;RECALL ARCHIVE INFORMATION
28 I $D(^ENAR(ENGBL,"LOCK")) S ENERR="An ARCHIVE global exists which has not yet been ARCHIVED." G MSG
29 D GS I ENGS'="010" D AD I ENERR=0,$D(ENID) S ENTASK=5,ENDA=+$P(ENID,",",4) D UP
30 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
31 G:ENERR'=0 MSG D R^ENARGR I ENERR'=0 G MSG
32 S ENTASK=6 D UP W !!,"Recall completed" D OUT Q
33R1 W !,"Before recalling more records, you must first delete existing data from",!,"your ",ENFN," file." Q
34 ;;
35SID ;SELECT ARCHIVE ID
36 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
37GS ;GLOBAL STATUS
38 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")
39 Q
40AD ;ARCHIVE DATA INFO
41 W !!,"There is existing data ready for transport or review"
42AD1 W !,"Do you want to see the Archive ID information " S %=1 D YN^DICN I %=-1 S ENERR="ARCHIVE ID ABORT" Q
43 G AD1:%=0 D ID^ENAR2:%=1
44AD2 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
45AD3 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
46UP ;UPDATE ARCHIVAL TRANSACTIONS
47 I '$D(ENTASK)!(ENTASK<1)!(ENTASK>6) S ENERR="NEED ENTASK" Q
48 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),",")
49 I $D(^ENG(6919,Z,2,0))'>0 S ^(0)="^6919.01DA^0^0"
50 L +^ENG(6919,Z,2,0):60
51 S ENA=$P(^ENG(6919,Z,2,0),U,1,2),ENNXL=$P(^(0),U,3),ENNXT=$P(^(0),U,4)
52UP2 S ENNXL=ENNXL+1 I $D(^ENG(6919,Z,2,ENNXL,0))>0 G UP2
53 S ENNXT=ENNXT+1,ENOUT=ENA_U_ENNXL_U_ENNXT
54 S ^ENG(6919,Z,2,0)=ENOUT,^ENG(6919,Z,2,ENNXL,0)=ENTIME_"^"_ENTASK_"^"_ENEMP L -^ENG(6919,Z,2,0)
55 Q
56MSG W @IOF,!!,*7,"Process terminated: ",ENERR
57OUT K %,ENA,ENDA,ENEMP,ENFN,ENGL,ENGS,ENID,ENNXL,ENNXT,ENOUT,ENTASK,ENTIME,X,Y,X S ENERR=0
58MSG1 W !,"<cr> to continue" R ENR:DTIME Q
59 ;
60 ;ENAR1
Note: See TracBrowser for help on using the repository browser.