source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIARR.m@ 1742

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1DIARR ;SFISC/DCM-ARCHIVING FUNCTION, RETRIEVAL OF ARCHIVED RECORD ;8/11/98 13:19
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START W !!,"This option will scan your archived file and will attempt to retrieve entries"
5 W !,"that match the name (.01) field and",!,"either Primary KEY or identifier field(s) of the archived file."
6 W !!,"Magnetic tapes should be opened with variable length records."
7 ;
8INIT S DIARX="F U DIARIO R DIARL Q:DIARL]""""&($A(DIARL)'=13) "
9 D HOME^%ZIS S DIOF=IOF,DIOSL=IOSL
10 D DT^DICRW
11 K ^TMP("DIAR",$J)
12 S (DIARREQ,DIAROUT,DIARZ,DIAREOF,DIARMTCH,DIARFGEN,DIARPG,DIARRCT,DIARZID,DIARZL,DIARZ1,DIARZ2,DIARX1,DIARY,DIARNM,DIARRCT,DIARFND,DIARRHP)=0,DIARLINE=""
13 ;
14SEQDEV S %ZIS("A")="SEQUENTIAL ARCHIVE DEVICE: ",%ZIS("HFSMODE")="R" D ^%ZIS G EOJ:POP
15 I IOT'["MT",IOT'["SDP",IOT'["HFS" D ^%ZISC W !,$C(7),"This has to be a sequential device." G SEQDEV
16 I IOT["MT",IOPAR'["V" D ^%ZISC W !,$C(7),"Open this device with variable length records." G SEQDEV
17 S DIARIO=IO
18 ;
19RC X DIARX I $E(DIARL,1,4)'["$IND",$E(DIARL,1,4)'["$DAT" D ^%ZISC W !,$C(7),"Archive information is not in filegram format" G SEQDEV
20 I $E(DIARL,1,6)="$INDEX" S DIARIDX=1 D ^DIARR6 G RC3
21 U IO(0) W !!,"Sampling archived file...",!
22RC2 I $P(DIARL,U)="$DAT" S DIARFILE=$P(DIARL,U,2),DIARFN=+$P(DIARL,U,3)
23 X DIARX S DIARNAME=$P(DIARL,"=",2) X DIARX
24 F X DIARX Q:(($P(DIARL,":")="END")&(+$P(DIARL,U,2)=DIARFN)) D RC1:$P(DIARL,":")="BEGIN" I ($P($P(DIARL,U),":")="IDENTIFIER")!($P($P(DIARL,U),":")="SPECIFIER") D ID
25 F X DIARX Q:$P(DIARL,U)["$END DAT" I +$P(DIARL,U,2)=".01" S DIAR01=$P(DIARL,U) S ^TMP("DIARHLP",$J,DIARRCT+1,.01)=DIAR01_" = "_$P(DIARL,"=",2) Q
26 I '$D(DIAR01) S DIARNM=1,^TMP("DIARHLP",$J,DIARRCT+1,.01)="NAME = "_DIARNAME
27 S DIARRCT=DIARRCT+1
28 F X DIARX Q:((DIARL["#$#")!(DIARRCT>5)) G RC2:((DIARRCT'>5)&($P(DIARL,U)["$DAT"))
29 ;
30RC3 I DIARNM,'$D(DIAR01) S DIAR01="NAME"
31 S DIARXXX=$$REWIND^%ZIS(IO,IOT,IOPAR)
32 ;
33FILE U IO(0) W !,"You are reading archived information from the "_DIARFILE_" file."
34 K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to continue"
35 D ^DIR G EOJ:'Y!($D(DIRUT))
36 ;
37 D ^DIARR1 G EOJ:$D(DTOUT)!($D(DUOUT)&(DIARREQ'>0))!('$D(DIARR))!POP K DIRUT,DUOUT
38 D ^DIARR2
39 D ^DIARR3
40 D ^DIARR5
41 D EOJ
42 Q
43 ;
44ID S DIARID(+$P(DIARL,U,2))=$P($P(DIARL,U),":",2)_U_+$P(DIARL,U,2)
45 S ^TMP("DIARHLP",$J,DIARRCT+1,$P($P(DIARL,U),":",2))=$P($P(DIARL,U),":",2)_" = "_$P(DIARL,"=",2)
46 Q
47 ;
48RC1 S DIARFN1=+$P(DIARL,U,2)
49 F X DIARX Q:(($P(DIARL,":")="END")&(+$P(DIARL,U,2)=DIARFN1))
50 Q
51 ;
52EOJ D ^%ZISC
53 K POP,DIARX,DIARFILE,DIARFN,DIARIO,DIARID,DIAR01,DIARZ,DIARREQ,DIARR,DIR,DIRUT,DTOUT,DUOUT,%MT,DIAROUT,DIARPDEV
54 K DIARL,DIARA,DIAREOF,DIARF2,DIARFGEN,DIARFGL,DIARMTCH,DIARNM,DIARY,DIARIDDN,DIARMTID,DIARMT01,DIARZID
55 K ^TMP("DIAR",$J),DIARRF,DIARZ1,DIARZ2,DIARRCT,DIARPG,DIARZL,DIARX1,DIARLINE,DIARIDS,DIARQUED,DIARFN1
56 K DIARHLP,DIARRHP,DIARZHP,DIARNAME,DIAROFLD,DIAROIDF,DIAROAT,DIAROFLD,DIAROIDF,DIAROLVL,DIAROSTK,DIAROVAL,DIAROXPL
57 K DIAROLNE,DIAROLUP,DIAROM,DIAROREQ,DIAROSUB,DIAROTAB,DIAROX,DIAROX1,DIAROZ,DIARZZ,DIARTAB,DIAROBPT,^TMP("DIARO",$J)
58 K DIAROBCK,DIAROBF,DIAROBFN,DIAROBF1,DIAROSF,DIAROSFN,DIAROXX,DIARCNT,DIARCTR,DIARFLD,DIARFLGT,DIARFNA,DIARFNO,DIARIDX
59 K DIARIXCT,DIARIXX,DIARPC,DIARREC,DIARVAL,DIARXX,DIARFND,DIARYY,DIARXXX,^TMP("DIARHLP",$J),DIAROX2,DIOF,DIOSL
60 Q
Note: See TracBrowser for help on using the repository browser.