source: FOIAVistA/tag/r/ENGINEERING-EN/ENARGR.m@ 719

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1ENARGR ;(WIRMFO)/JED,SAB-RECALL ARCHIVED DATA ;2.14.97
2 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
3 Q
4R ; Recall Global from archive media
5 ; called from ENAR1
6 ; input
7 ; ENGBL - global subscript in ^ENAR to be recalled (e.g. 6919.1)
8 ; ENRT - number associated with type of archive (e.g. 1 for W.O.)
9 ; ENERR - error message text (should be 0 for no error)
10 ; output
11 ; ENDA - ien of ENG ARCHIVE LOG entry
12 ; ENERR - error message text or 0 when no error
13 ;
14 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")
15 ; select and open archive media
16 S ENHFSM="R",ENHFSIO="" D ARDEV^ENARGO I ENERR'=0 G OUT
17 I IOT="MT" D MTSETUP^ENARGO I ENERR'=0 G CLOUT
18 I IOT="MT" D MTCHECK^ENARGO I ENERR'=0 G CLOUT
19 ; get header info from archive media
20 U IO R ENHD(1):15,ENHD(2):15,ENHD(3):15,ENHD(4):15
21 D CLOSE^ENARGO
22 I ENHD(3)'=("^ENAR("_ENGBL_",-1)") D G OUT
23 . W $C(7),!!,"Expected: ","^ENAR("_ENGBL_",-1)"
24 . W !,"Found: ",ENHD(3)
25 . W !,"Sorry, this media is unacceptable!"
26 . W !,"Press <RETURN> to continue" R ENR:DTIME
27 . S ENERR="BOGUS MEDIA"
28 ; confirm
29 S ENDA=+$P(ENHD(4),",",4) D ID^ENAR2 I ENERR'=0 G OUT
30 W !!!!,"Media written on: ",ENHD(1),!,"with header: ",ENHD(2),!
31 S DIR(0)="Y",DIR("A")="Is this the media you want",DIR("B")="YES"
32 D ^DIR K DIR I 'Y S ENERR="RECALL RECORDS ABORT" G OUT
33 ; ask type of recall
34 S DIR(0)="SB^A:ALL RECORDS;O:ONE RECORD"
35 S DIR("A")="Select type of recall to perform",DIR("B")="ALL"
36 S DIR("?",1)="ALL RECORDS - Recall all records from archive media."
37 S DIR("?",2)="ONE RECORD - Search entire archive for a specific record"
38 S DIR("?",3)=" and recall it if found."
39 S DIR("?",4)=" "
40 S DIR("?")="Enter ALL or ONE"
41 D ^DIR K DIR I $D(DIRUT) S ENERR="RECALL TYPE NOT SPECIFIED" G OUT
42 S ENRCLT=Y
43 ;
44 ; select and open archive media
45 W !,"Please wait while I reopen the archive device."
46 S IOP=ENION,ENHFSM="R" D ARDEV^ENARGO I ENERR'=0 G OUT
47 I IOT="MT" D MTCHECK^ENARGO I ENERR'=0 G CLOUT
48 U IO R ENX:15,ENX(1):15 U IO(0) ; skip first 2 header lines
49 I ENRCLT="A" D RALL I ENERR'=0 G CLOUT
50 I ENRCLT="O" D RONE I ENERR'=0 G CLOUT
51 D CLOSE^ENARGO
52 W !,"Elapsed time: ",$J($P($H,",",2)-ENSTART/60,6,2)," minutes."
53 ;
54RINIT ; initialize data dictionary
55 ; save variables
56 F ENX="ENDA","ENERR","ENGBL","ENRT" S ^TMP("ENAR",$J,ENX)=@ENX
57 ; perform init
58 I $D(^ENAR(ENGBL,-1,"INIT")) X ^("INIT")
59 ; restore variables
60 F ENX="ENDA","ENERR","ENGBL","ENRT" S @ENX=^TMP("ENAR",$J,ENX)
61 K ^TMP("ENAR",$J)
62 ; check result
63 I $D(DIFQ) D G:ENERR'=0 OUT G RINIT
64 . W $C(7),!,"But your file is not initialized properly",!
65 . S DIR(0)="Y",DIR("A")="Do you want to re-try",DIR("B")="YES"
66 . S DIR("?",1)="If you answer no the "_ENFN_" file will be cleaned out"
67 . S DIR("?",2)=" "
68 . S DIR("?")="Enter Y or N"
69 . D ^DIR K DIR I 'Y D GS^ENAR1,D2^ENAR1 S ENERR="ARCHIVE RECALL ABORT"
70 ;
71 K ^ENAR(ENGBL,-1)
72 W !!,"O.K. Archive file is ready"
73 G OUT
74 ;
75RALL ; recall all records
76 W !,"Now fetching global"
77 U IO
78 S ENJ=0,ENSTART=$P($H,",",2)
79 F R ENX:15,ENX(1):15 Q:ENX="**EOF**"!'$T D:ENX'["LOCK"
80 . S @ENX=ENX(1),ENJ=ENJ+1
81 . I '(ENJ#50) U IO(0) W "." U IO
82 U IO(0)
83 I ENX="**EOF**" W !!,"The global is now on the system disk"
84 E S ENERR="COULD NOT RECALL ALL RECORDS"
85 Q
86 ;
87RONE ; recall one record
88 W !,"Enter the exact "_ENFN_" record name. Remember to include"
89 W !,"your station number as a pre-fix! (e.g. 688-B970121-001)",!
90 S DIR(0)="F",DIR("A")="Exact "_ENFN_" record name"
91 D ^DIR K DIR I $D(DIRUT) S ENERR="SINGLE RECORD UNSPECIFIED" Q
92 S ENR=Y
93 ;
94 ; read media and recall data dictionary nodes, stop if record located
95 S ENSTART=$P($H,",",2)
96 U IO
97 S ENJ=0
98 F R ENX:15,ENX(1):15 Q:$P(ENX(1),U,1)=ENR!(ENX="**EOF**")!'$T D
99 . S:$P(ENX,",",2)="-1" @ENX=ENX(1) ; only store data dictionary stuff
100 . S ENJ=ENJ+1
101 . I '(ENJ#50) U IO(0) W "." U IO
102 U IO(0)
103 ;
104 I $P(ENX(1),U,1)'=ENR D Q:ENERR'=0 G RONE
105 . ; recall didn't stop at desired record
106 . K ^ENAR(ENGBL,-1)
107 . W !,"Sorry, that record doesn't appear to be on this archive."
108 . S DIR(0)="Y",DIR("A")="Try another record",DIR("B")="NO"
109 . D ^DIR K DIR I 'Y S ENERR="DIDN'T FIND SINGLE RECORD" Q
110 . ; rewind (or close and reopen) device for retry
111 . W !,"Please wait while I rewind (or reopen) the archive device."
112 . S Y=$S("^MT^HFS^SDP^"[(U_IOT_U):$$REWIND^%ZIS(IO,IOT,IOPAR),1:0)
113 . I 'Y D CLOSE^ENARGO S IOP=ENION,ENHFSM="R" D ARDEV^ENARGO Q:ENERR'=0
114 . I IOT="MT" D MTCHECK^ENARGO Q:ENERR'=0
115 . U IO R ENX:15,ENX(1):15 ; skip first 2 header lines
116 . U IO(0)
117 ;
118 ; recall stopped at desired record
119 W !!,"Found record ",$P(ENX(1),U,1),!
120 S ENJ=$P(ENX,",",2)
121 ; save data
122 S @ENX=ENX(1)
123 S ^ENAR(ENGBL,0)=ENFN_U_ENGBL_U_ENJ_"^1"
124 S ^ENAR(ENGBL,"B",$P(ENX(1),U,1),ENJ)=""
125 ; retrieve remaining nodes of record
126 U IO
127 F R ENX:15,ENX(1):15 Q:$P(ENX,",",2)'=ENJ!(ENX="**EOF**")!'$T D
128 . S @ENX=ENX(1)
129 Q
130 ;
131CLOUT ; Close Archive Media and Exit
132 D CLOSE^ENARGO
133OUT ; Exit
134 K ENA,ENBOT,ENEOT,ENFN,ENHD,ENHFSIO,ENHFSM,ENION,ENJ,ENMTERR
135 K ENONLINE,ENR,ENRCLT,ENREW,ENSTART,ENWPROT,ENX
136 K DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
137 Q
138 ;
139 ;ENARGR
Note: See TracBrowser for help on using the repository browser.