ENARGR ;(WIRMFO)/JED,SAB-RECALL ARCHIVED DATA ;2.14.97
;;7.0;ENGINEERING;**40**;Aug 17, 1993
Q
R ; Recall Global from archive media
; called from ENAR1
; input
; ENGBL - global subscript in ^ENAR to be recalled (e.g. 6919.1)
; ENRT - number associated with type of archive (e.g. 1 for W.O.)
; ENERR - error message text (should be 0 for no error)
; output
; ENDA - ien of ENG ARCHIVE LOG entry
; ENERR - error message text or 0 when no error
;
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")
; select and open archive media
S ENHFSM="R",ENHFSIO="" D ARDEV^ENARGO I ENERR'=0 G OUT
I IOT="MT" D MTSETUP^ENARGO I ENERR'=0 G CLOUT
I IOT="MT" D MTCHECK^ENARGO I ENERR'=0 G CLOUT
; get header info from archive media
U IO R ENHD(1):15,ENHD(2):15,ENHD(3):15,ENHD(4):15
D CLOSE^ENARGO
I ENHD(3)'=("^ENAR("_ENGBL_",-1)") D G OUT
. W $C(7),!!,"Expected: ","^ENAR("_ENGBL_",-1)"
. W !,"Found: ",ENHD(3)
. W !,"Sorry, this media is unacceptable!"
. W !,"Press <RETURN> to continue" R ENR:DTIME
. S ENERR="BOGUS MEDIA"
; confirm
S ENDA=+$P(ENHD(4),",",4) D ID^ENAR2 I ENERR'=0 G OUT
W !!!!,"Media written on: ",ENHD(1),!,"with header: ",ENHD(2),!
S DIR(0)="Y",DIR("A")="Is this the media you want",DIR("B")="YES"
D ^DIR K DIR I 'Y S ENERR="RECALL RECORDS ABORT" G OUT
; ask type of recall
S DIR(0)="SB^A:ALL RECORDS;O:ONE RECORD"
S DIR("A")="Select type of recall to perform",DIR("B")="ALL"
S DIR("?",1)="ALL RECORDS - Recall all records from archive media."
S DIR("?",2)="ONE RECORD - Search entire archive for a specific record"
S DIR("?",3)=" and recall it if found."
S DIR("?",4)=" "
S DIR("?")="Enter ALL or ONE"
D ^DIR K DIR I $D(DIRUT) S ENERR="RECALL TYPE NOT SPECIFIED" G OUT
S ENRCLT=Y
;
; select and open archive media
W !,"Please wait while I reopen the archive device."
S IOP=ENION,ENHFSM="R" D ARDEV^ENARGO I ENERR'=0 G OUT
I IOT="MT" D MTCHECK^ENARGO I ENERR'=0 G CLOUT
U IO R ENX:15,ENX(1):15 U IO(0) ; skip first 2 header lines
I ENRCLT="A" D RALL I ENERR'=0 G CLOUT
I ENRCLT="O" D RONE I ENERR'=0 G CLOUT
D CLOSE^ENARGO
W !,"Elapsed time: ",$J($P($H,",",2)-ENSTART/60,6,2)," minutes."
;
RINIT ; initialize data dictionary
; save variables
F ENX="ENDA","ENERR","ENGBL","ENRT" S ^TMP("ENAR",$J,ENX)=@ENX
; perform init
I $D(^ENAR(ENGBL,-1,"INIT")) X ^("INIT")
; restore variables
F ENX="ENDA","ENERR","ENGBL","ENRT" S @ENX=^TMP("ENAR",$J,ENX)
K ^TMP("ENAR",$J)
; check result
I $D(DIFQ) D G:ENERR'=0 OUT G RINIT
. W $C(7),!,"But your file is not initialized properly",!
. S DIR(0)="Y",DIR("A")="Do you want to re-try",DIR("B")="YES"
. S DIR("?",1)="If you answer no the "_ENFN_" file will be cleaned out"
. S DIR("?",2)=" "
. S DIR("?")="Enter Y or N"
. D ^DIR K DIR I 'Y D GS^ENAR1,D2^ENAR1 S ENERR="ARCHIVE RECALL ABORT"
;
K ^ENAR(ENGBL,-1)
W !!,"O.K. Archive file is ready"
G OUT
;
RALL ; recall all records
W !,"Now fetching global"
U IO
S ENJ=0,ENSTART=$P($H,",",2)
F R ENX:15,ENX(1):15 Q:ENX="**EOF**"!'$T D:ENX'["LOCK"
. S @ENX=ENX(1),ENJ=ENJ+1
. I '(ENJ#50) U IO(0) W "." U IO
U IO(0)
I ENX="**EOF**" W !!,"The global is now on the system disk"
E S ENERR="COULD NOT RECALL ALL RECORDS"
Q
;
RONE ; recall one record
W !,"Enter the exact "_ENFN_" record name. Remember to include"
W !,"your station number as a pre-fix! (e.g. 688-B970121-001)",!
S DIR(0)="F",DIR("A")="Exact "_ENFN_" record name"
D ^DIR K DIR I $D(DIRUT) S ENERR="SINGLE RECORD UNSPECIFIED" Q
S ENR=Y
;
; read media and recall data dictionary nodes, stop if record located
S ENSTART=$P($H,",",2)
U IO
S ENJ=0
F R ENX:15,ENX(1):15 Q:$P(ENX(1),U,1)=ENR!(ENX="**EOF**")!'$T D
. S:$P(ENX,",",2)="-1" @ENX=ENX(1) ; only store data dictionary stuff
. S ENJ=ENJ+1
. I '(ENJ#50) U IO(0) W "." U IO
U IO(0)
;
I $P(ENX(1),U,1)'=ENR D Q:ENERR'=0 G RONE
. ; recall didn't stop at desired record
. K ^ENAR(ENGBL,-1)
. W !,"Sorry, that record doesn't appear to be on this archive."
. S DIR(0)="Y",DIR("A")="Try another record",DIR("B")="NO"
. D ^DIR K DIR I 'Y S ENERR="DIDN'T FIND SINGLE RECORD" Q
. ; rewind (or close and reopen) device for retry
. W !,"Please wait while I rewind (or reopen) the archive device."
. S Y=$S("^MT^HFS^SDP^"[(U_IOT_U):$$REWIND^%ZIS(IO,IOT,IOPAR),1:0)
. I 'Y D CLOSE^ENARGO S IOP=ENION,ENHFSM="R" D ARDEV^ENARGO Q:ENERR'=0
. I IOT="MT" D MTCHECK^ENARGO Q:ENERR'=0
. U IO R ENX:15,ENX(1):15 ; skip first 2 header lines
. U IO(0)
;
; recall stopped at desired record
W !!,"Found record ",$P(ENX(1),U,1),!
S ENJ=$P(ENX,",",2)
; save data
S @ENX=ENX(1)
S ^ENAR(ENGBL,0)=ENFN_U_ENGBL_U_ENJ_"^1"
S ^ENAR(ENGBL,"B",$P(ENX(1),U,1),ENJ)=""
; retrieve remaining nodes of record
U IO
F R ENX:15,ENX(1):15 Q:$P(ENX,",",2)'=ENJ!(ENX="**EOF**")!'$T D
. S @ENX=ENX(1)
Q
;
CLOUT ; Close Archive Media and Exit
D CLOSE^ENARGO
OUT ; Exit
K ENA,ENBOT,ENEOT,ENFN,ENHD,ENHFSIO,ENHFSM,ENION,ENJ,ENMTERR
K ENONLINE,ENR,ENRCLT,ENREW,ENSTART,ENWPROT,ENX
K DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
Q
;
;ENARGR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARGR 5277 printed Mar 13, 2025@20:56:18 Page 2
ENARGR ;(WIRMFO)/JED,SAB-RECALL ARCHIVED DATA ;2.14.97
+1 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
+2 QUIT
R ; Recall Global from archive media
+1 ; called from ENAR1
+2 ; input
+3 ; ENGBL - global subscript in ^ENAR to be recalled (e.g. 6919.1)
+4 ; ENRT - number associated with type of archive (e.g. 1 for W.O.)
+5 ; ENERR - error message text (should be 0 for no error)
+6 ; output
+7 ; ENDA - ien of ENG ARCHIVE LOG entry
+8 ; ENERR - error message text or 0 when no error
+9 ;
+10 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")
+11 ; select and open archive media
+12 SET ENHFSM="R"
SET ENHFSIO=""
DO ARDEV^ENARGO
IF ENERR'=0
GOTO OUT
+13 IF IOT="MT"
DO MTSETUP^ENARGO
IF ENERR'=0
GOTO CLOUT
+14 IF IOT="MT"
DO MTCHECK^ENARGO
IF ENERR'=0
GOTO CLOUT
+15 ; get header info from archive media
+16 USE IO
READ ENHD(1):15,ENHD(2):15,ENHD(3):15,ENHD(4):15
+17 DO CLOSE^ENARGO
+18 IF ENHD(3)'=("^ENAR("_ENGBL_",-1)")
Begin DoDot:1
+19 WRITE $CHAR(7),!!,"Expected: ","^ENAR("_ENGBL_",-1)"
+20 WRITE !,"Found: ",ENHD(3)
+21 WRITE !,"Sorry, this media is unacceptable!"
+22 WRITE !,"Press <RETURN> to continue"
READ ENR:DTIME
+23 SET ENERR="BOGUS MEDIA"
End DoDot:1
GOTO OUT
+24 ; confirm
+25 SET ENDA=+$PIECE(ENHD(4),",",4)
DO ID^ENAR2
IF ENERR'=0
GOTO OUT
+26 WRITE !!!!,"Media written on: ",ENHD(1),!,"with header: ",ENHD(2),!
+27 SET DIR(0)="Y"
SET DIR("A")="Is this the media you want"
SET DIR("B")="YES"
+28 DO ^DIR
KILL DIR
IF 'Y
SET ENERR="RECALL RECORDS ABORT"
GOTO OUT
+29 ; ask type of recall
+30 SET DIR(0)="SB^A:ALL RECORDS;O:ONE RECORD"
+31 SET DIR("A")="Select type of recall to perform"
SET DIR("B")="ALL"
+32 SET DIR("?",1)="ALL RECORDS - Recall all records from archive media."
+33 SET DIR("?",2)="ONE RECORD - Search entire archive for a specific record"
+34 SET DIR("?",3)=" and recall it if found."
+35 SET DIR("?",4)=" "
+36 SET DIR("?")="Enter ALL or ONE"
+37 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENERR="RECALL TYPE NOT SPECIFIED"
GOTO OUT
+38 SET ENRCLT=Y
+39 ;
+40 ; select and open archive media
+41 WRITE !,"Please wait while I reopen the archive device."
+42 SET IOP=ENION
SET ENHFSM="R"
DO ARDEV^ENARGO
IF ENERR'=0
GOTO OUT
+43 IF IOT="MT"
DO MTCHECK^ENARGO
IF ENERR'=0
GOTO CLOUT
+44 ; skip first 2 header lines
USE IO
READ ENX:15,ENX(1):15
USE IO(0)
+45 IF ENRCLT="A"
DO RALL
IF ENERR'=0
GOTO CLOUT
+46 IF ENRCLT="O"
DO RONE
IF ENERR'=0
GOTO CLOUT
+47 DO CLOSE^ENARGO
+48 WRITE !,"Elapsed time: ",$JUSTIFY($PIECE($HOROLOG,",",2)-ENSTART/60,6,2)," minutes."
+49 ;
RINIT ; initialize data dictionary
+1 ; save variables
+2 FOR ENX="ENDA","ENERR","ENGBL","ENRT"
SET ^TMP("ENAR",$JOB,ENX)=@ENX
+3 ; perform init
+4 IF $DATA(^ENAR(ENGBL,-1,"INIT"))
XECUTE ^("INIT")
+5 ; restore variables
+6 FOR ENX="ENDA","ENERR","ENGBL","ENRT"
SET @ENX=^TMP("ENAR",$JOB,ENX)
+7 KILL ^TMP("ENAR",$JOB)
+8 ; check result
+9 IF $DATA(DIFQ)
Begin DoDot:1
+10 WRITE $CHAR(7),!,"But your file is not initialized properly",!
+11 SET DIR(0)="Y"
SET DIR("A")="Do you want to re-try"
SET DIR("B")="YES"
+12 SET DIR("?",1)="If you answer no the "_ENFN_" file will be cleaned out"
+13 SET DIR("?",2)=" "
+14 SET DIR("?")="Enter Y or N"
+15 DO ^DIR
KILL DIR
IF 'Y
DO GS^ENAR1
DO D2^ENAR1
SET ENERR="ARCHIVE RECALL ABORT"
End DoDot:1
if ENERR'=0
GOTO OUT
GOTO RINIT
+16 ;
+17 KILL ^ENAR(ENGBL,-1)
+18 WRITE !!,"O.K. Archive file is ready"
+19 GOTO OUT
+20 ;
RALL ; recall all records
+1 WRITE !,"Now fetching global"
+2 USE IO
+3 SET ENJ=0
SET ENSTART=$PIECE($HOROLOG,",",2)
+4 FOR
READ ENX:15,ENX(1):15
if ENX="**EOF**"!'$TEST
QUIT
if ENX'["LOCK"
Begin DoDot:1
+5 SET @ENX=ENX(1)
SET ENJ=ENJ+1
+6 IF '(ENJ#50)
USE IO(0)
WRITE "."
USE IO
End DoDot:1
+7 USE IO(0)
+8 IF ENX="**EOF**"
WRITE !!,"The global is now on the system disk"
+9 IF '$TEST
SET ENERR="COULD NOT RECALL ALL RECORDS"
+10 QUIT
+11 ;
RONE ; recall one record
+1 WRITE !,"Enter the exact "_ENFN_" record name. Remember to include"
+2 WRITE !,"your station number as a pre-fix! (e.g. 688-B970121-001)",!
+3 SET DIR(0)="F"
SET DIR("A")="Exact "_ENFN_" record name"
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENERR="SINGLE RECORD UNSPECIFIED"
QUIT
+5 SET ENR=Y
+6 ;
+7 ; read media and recall data dictionary nodes, stop if record located
+8 SET ENSTART=$PIECE($HOROLOG,",",2)
+9 USE IO
+10 SET ENJ=0
+11 FOR
READ ENX:15,ENX(1):15
if $PIECE(ENX(1),U,1)=ENR!(ENX="**EOF**")!'$TEST
QUIT
Begin DoDot:1
+12 ; only store data dictionary stuff
if $PIECE(ENX,",",2)="-1"
SET @ENX=ENX(1)
+13 SET ENJ=ENJ+1
+14 IF '(ENJ#50)
USE IO(0)
WRITE "."
USE IO
End DoDot:1
+15 USE IO(0)
+16 ;
+17 IF $PIECE(ENX(1),U,1)'=ENR
Begin DoDot:1
+18 ; recall didn't stop at desired record
+19 KILL ^ENAR(ENGBL,-1)
+20 WRITE !,"Sorry, that record doesn't appear to be on this archive."
+21 SET DIR(0)="Y"
SET DIR("A")="Try another record"
SET DIR("B")="NO"
+22 DO ^DIR
KILL DIR
IF 'Y
SET ENERR="DIDN'T FIND SINGLE RECORD"
QUIT
+23 ; rewind (or close and reopen) device for retry
+24 WRITE !,"Please wait while I rewind (or reopen) the archive device."
+25 SET Y=$SELECT("^MT^HFS^SDP^"[(U_IOT_U):$$REWIND^%ZIS(IO,IOT,IOPAR),1:0)
+26 IF 'Y
DO CLOSE^ENARGO
SET IOP=ENION
SET ENHFSM="R"
DO ARDEV^ENARGO
if ENERR'=0
QUIT
+27 IF IOT="MT"
DO MTCHECK^ENARGO
if ENERR'=0
QUIT
+28 ; skip first 2 header lines
USE IO
READ ENX:15,ENX(1):15
+29 USE IO(0)
End DoDot:1
if ENERR'=0
QUIT
GOTO RONE
+30 ;
+31 ; recall stopped at desired record
+32 WRITE !!,"Found record ",$PIECE(ENX(1),U,1),!
+33 SET ENJ=$PIECE(ENX,",",2)
+34 ; save data
+35 SET @ENX=ENX(1)
+36 SET ^ENAR(ENGBL,0)=ENFN_U_ENGBL_U_ENJ_"^1"
+37 SET ^ENAR(ENGBL,"B",$PIECE(ENX(1),U,1),ENJ)=""
+38 ; retrieve remaining nodes of record
+39 USE IO
+40 FOR
READ ENX:15,ENX(1):15
if $PIECE(ENX,",",2)'=ENJ!(ENX="**EOF**")!'$TEST
QUIT
Begin DoDot:1
+41 SET @ENX=ENX(1)
End DoDot:1
+42 QUIT
+43 ;
CLOUT ; Close Archive Media and Exit
+1 DO CLOSE^ENARGO
OUT ; Exit
+1 KILL ENA,ENBOT,ENEOT,ENFN,ENHD,ENHFSIO,ENHFSM,ENION,ENJ,ENMTERR
+2 KILL ENONLINE,ENR,ENRCLT,ENREW,ENSTART,ENWPROT,ENX
+3 KILL DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
+4 QUIT
+5 ;
+6 ;ENARGR
