Routine: ENAR1

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

;;

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")

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)

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENAR1   3887     printed  Mar 13, 2025@20:56:10                                                                                                                                                                                                       Page 2

ENAR1     ;(WIRMFO)/JED-ARCHIVE MODULE ;4.22.97

 +1       ;;7.0;ENGINEERING;**40**;Aug 17, 1993

 +2       ;EXPECTS VARIABLES ENRT,ENGBL ;CALLED BY ENAR ;CALLS ENJC2,ENJDPL,ENJPARAM,ENARG,ENARGO,ENARGR

 +3        QUIT

 +4       ;;

G         ;GATHER RECORDS

 +1        IF $DATA(^ENAR(ENGBL,"LOCK"))

               SET ENERR="An ARCHIVE global exists which has not yet been ARCHIVED."

               GOTO MSG

 +2        DO GS

           if ENGS="010"

               GOTO G2

           DO @$SELECT(ENGS="1111":"AD",1:"AD3")

           if ENERR'=0

               GOTO MSG

           IF ENGS="010"

               IF $DATA(ENID)

                   SET ENTASK=5

                   SET ENDA=$PIECE(ENID,",",4)

                   DO UP

G2         DO G^ENARG

           if ENERR'=0

               GOTO MSG

           IF $DATA(^ENAR(ENGBL,-1))

               WRITE !!,*7,"Records gathering complete"

               SET ^ENAR(ENGBL,"LOCK")=""

               SET ENTASK=2

               DO UP

               DO OUT

               QUIT

 +1        SET ENERR="DATA NOT ACCEPTED."

           GOTO MSG

A         ;ARCHIVE & VERIFY RECORDS

 +1        DO GS

           IF ENGS'="1111"

               WRITE !,"Bad news, Your archive global is not as expected"

               DO MSG1

               SET ENERR="BAD ARCHIVE GLOBAL"

               KILL ^ENAR(ENGBL,"LOCK")

               GOTO MSG

 +2        DO C^ENAR2

           if ENERR'=0

               GOTO MSG

           SET ENTASK=3

           DO UP

           DO A^ENARGO

           if ENERR'=0

               GOTO MSG

 +3        SET ENTASK=4

           DO UP

           WRITE !!,*7,"verify completed"

           DO OUT

           QUIT

D         ;DELETE ARCHIVE GLOBAL

 +1        IF $DATA(^ENAR(ENGBL,"LOCK"))

               SET ENERR="An ARCHIVE global exists which has not yet been ARCHIVED."

               GOTO MSG

 +2        DO GS

           IF ENGS="010"

               WRITE !!,"Your archive global has been deleted already"

               DO OUT

               QUIT

 +3        IF ENGS="1111"

               DO C^ENAR2

               if ENERR'=0

                   GOTO MSG

D1         IF $EXTRACT(ENGS)=1

               IF '$DATA(ENDA)

                   IF $DATA(@ENID)

                       SET ENDA=+$PIECE(^ENAR(ENGBL,-1),",",4)

D11        WRITE !,"OK to delete this global"

           SET %=2

           DO YN^DICN

           if %=0

               GOTO D11

           IF %'=1

               SET ENERR="KEEP ARCHIVE GLOBAL"

               GOTO MSG

 +1        DO D2

           SET ENTASK=5

           if $DATA(ENDA)

               DO UP

           if ENERR'=0

               GOTO MSG

 +2        WRITE !!,*7,"Archive global deleted"

           DO OUT

           QUIT

D2         if $EXTRACT(ENGS)=1

               SET ENID=^ENAR(ENGBL,-1)

 +1        SET DIU=ENGBL

           SET DIU(0)=""

           DO EN^DIU2

           KILL DIU

 +2        KILL ^ENAR(ENGBL)

 +3        SET ENFN=$SELECT(ENRT=1:"WO ARCHIVE",ENRT=2:"2162 ACCIDENT ARCHIVE",ENRT=3:"EQUIPMENT INV. ARCHIVE",ENRT=4:"PROJECT ARCHIVE",ENRT=5:"CONTROL POINT ARCHIVE")

           SET ^ENAR(ENGBL,0)=ENFN_"^"_ENGBL_"^^"

           QUIT

R         ;RECALL ARCHIVE INFORMATION

 +1        IF $DATA(^ENAR(ENGBL,"LOCK"))

               SET ENERR="An ARCHIVE global exists which has not yet been ARCHIVED."

               GOTO MSG

 +2        DO GS

           IF ENGS'="010"

               DO AD

               IF ENERR=0

                   IF $DATA(ENID)

                       SET ENTASK=5

                       SET ENDA=+$PIECE(ENID,",",4)

                       DO UP

 +3        IF $ORDER(^ENAR(ENGBL,0))>0

               SET ENFN=$SELECT(ENRT=1:"WO ARCHIVE",ENRT=2:"2162 ACCIDENT ARCHIVE",ENRT=3:"EQUIPMENT INV. ARCHIVE",ENRT=4:"PROJECT ARCHIVE",ENRT=5:"CONTROL POINT ARCHIVE")

               WRITE !,"There is data in your ",ENFN," file."

               DO R1

               DO AD2

 +4        if ENERR'=0

               GOTO MSG

           DO R^ENARGR

           IF ENERR'=0

               GOTO MSG

 +5        SET ENTASK=6

           DO UP

           WRITE !!,"Recall completed"

           DO OUT

           QUIT

R1         WRITE !,"Before recalling more records, you must first delete existing data from",!,"your ",ENFN," file."

           QUIT

 +1       ;;

SID       ;SELECT ARCHIVE ID

 +1        SET DIC="^ENG(6919,"

           SET DIC(0)="AEQM"

           SET DIC("S")="I $D(^(1)),$P(^(1),""^"",1)=ENRT"

           DO ^DIC

           if +Y<0

               SET ENERR="I.D. SELECT"

           SET ENDA=+Y

           KILL DIC,Y

           QUIT

GS        ;GLOBAL STATUS

 +1        SET ENGS=999

           IF $DATA(^ENAR(ENGBL))

               SET ENGS=$DATA(^ENAR(ENGBL,-1))_$EXTRACT($DATA(^(0)))_$SELECT($ORDER(^ENAR(ENGBL,0))>0:"1",1:"0")

 +2        QUIT

AD        ;ARCHIVE DATA INFO

 +1        WRITE !!,"There is existing data ready for transport or review"

AD1        WRITE !,"Do you want to see the Archive ID information "

           SET %=1

           DO YN^DICN

           IF %=-1

               SET ENERR="ARCHIVE ID ABORT"

               QUIT

 +1        if %=0

               GOTO AD1

           if %=1

               DO ID^ENAR2

AD2        SET ENERR=0

           WRITE !!!,"OK to remove archive data "

           SET %=1

           DO YN^DICN

           if %=0

               GOTO AD2

           if %'=1

               SET ENERR="KILL OLD DATA"

           if %=1

               DO D2

           QUIT

AD3        WRITE !,"Note: your archive global is not in order",!,"OK to clean it up"

           SET %=1

           DO YN^DICN

           if %'=1

               SET ENERR="RESET ARCHIVE GLOBAL"

           if %=1

               DO D2

           QUIT

UP        ;UPDATE ARCHIVAL TRANSACTIONS

 +1        IF '$DATA(ENTASK)!(ENTASK<1)!(ENTASK>6)

               SET ENERR="NEED ENTASK"

               QUIT

 +2        SET Z=ENDA

           SET %DT="XT"

           SET X="N"

           DO ^%DT

           SET ENTIME=Y

           IF '$DATA(ENEMP)

               SET ENEMP="PROG.MODE"

               IF $DATA(DUZ)

                   IF DUZ>0

                       SET ENEMP=$PIECE($PIECE(^VA(200,DUZ,0),U),",")

 +3        IF $DATA(^ENG(6919,Z,2,0))'>0

               SET ^(0)="^6919.01DA^0^0"

 +4        LOCK +^ENG(6919,Z,2,0):60

 +5        SET ENA=$PIECE(^ENG(6919,Z,2,0),U,1,2)

           SET ENNXL=$PIECE(^(0),U,3)

           SET ENNXT=$PIECE(^(0),U,4)

UP2        SET ENNXL=ENNXL+1

           IF $DATA(^ENG(6919,Z,2,ENNXL,0))>0

               GOTO UP2

 +1        SET ENNXT=ENNXT+1

           SET ENOUT=ENA_U_ENNXL_U_ENNXT

 +2        SET ^ENG(6919,Z,2,0)=ENOUT

           SET ^ENG(6919,Z,2,ENNXL,0)=ENTIME_"^"_ENTASK_"^"_ENEMP

           LOCK -^ENG(6919,Z,2,0)

 +3        QUIT

MSG        WRITE @IOF,!!,*7,"Process terminated: ",ENERR

OUT        KILL %,ENA,ENDA,ENEMP,ENFN,ENGL,ENGS,ENID,ENNXL,ENNXT,ENOUT,ENTASK,ENTIME,X,Y,X

           SET ENERR=0

MSG1       WRITE !,"<cr> to continue"

           READ ENR:DTIME

           QUIT

 +1       ;

 +2       ;ENAR1

ENAR1.m