Return to DIARR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIARR1.m, revision 1.1

1.1     ! snw         1: DIARR1 ;SFISC/DCM-ARCHIVING FUNCTION, PROMPT FOR ARCHIVED RECORD ;7/1/93  8:43 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: PROC   D N Q:$D(DTOUT)!($D(DUOUT)&(DIARREQ'>0))!('$D(DIARR))
        !             5:        D PRINTDEV Q:POP
        !             6:        I '$D(IO("Q")) U IO(0) W !,"Searching archived file..."
        !             7:        Q
        !             8:        ;
        !             9: N      U IO(0) I '$D(DIARIDX) W !!,"Type ?? at any prompt to display sampled entries.",!
        !            10:        W !!,"Multiple requests may be made.",!,"One set of all prompts makes one request.",!
        !            11:        I $D(DIARIDX) D ASKIX Q:$D(DIRUT)
        !            12: N1     W !
        !            13:        K DIR S DIR("?",1)="Enter the "_DIAR01_" (.01) field.",DIR("?",2)="Answer to this prompt will retrieve all entries that match the ",DIR("?")=DIAR01_" field.",DIR("??")="^D HELP^DIARR1"
        !            14:        S DIR(0)="FO",DIR("A")="Enter "_DIAR01 D ^DIR
        !            15:        S:((X]"")&(X'="^")) DIARR(DIARREQ+1,".01")=X
        !            16:        Q:$D(DTOUT)!(DIAROUT&(X=""))!($D(DUOUT))!('$D(DIARID)&$D(DIRUT))
        !            17:        I $D(DIARID) D IDS Q:$D(DTOUT)
        !            18:        S:$D(DIARR(DIARREQ+1)) DIARREQ=DIARREQ+1 G N1
        !            19:        ;
        !            20: IDS    S DIAROUT=0
        !            21:        K DIR S DIR(0)="FO",DIR("?",1)="Enter identifier information.  Answer to this prompt, along with all",DIR("?",2)="previously answered prompts for this request, will be used in the matching",DIR("?")="process."
        !            22:        S DIR("??")="^D HELP^DIARR1"
        !            23:        F DIARZ=.019:0 S DIARZ=$O(DIARID(DIARZ)) Q:DIARZ'>0  S DIR("A")="Enter "_$P(DIARID(DIARZ),U)_" (id) " D ^DIR Q:$D(DTOUT)!$D(DUOUT)  S:((X]"")&(X'="^")) DIARR(DIARREQ+1,"ID",+$P(DIARID(DIARZ),U,2))=X
        !            24:        I '$D(DIARR(DIARREQ+1)) S DIAROUT=1 Q
        !            25:        Q
        !            26:        ;
        !            27: HELP   S DIARZHP="" W @DIOF
        !            28:        F DIARHLP=0:0 S DIARHLP=$O(^TMP("DIARHLP",$J,DIARHLP)) Q:DIARHLP'>0!$D(DTOUT)!$D(DIRUT)  W ! F  S DIARZHP=$O(^TMP("DIARHLP",$J,DIARHLP,DIARZHP)) Q:DIARZHP=""  W !,^(DIARZHP) I $Y>(DIOSL-3) D E Q:$D(DTOUT)!$D(DIRUT)
        !            29:        Q
        !            30:        ;
        !            31: E      ;
        !            32:        N DIR S DIR(0)="E" D ^DIR Q:$D(DTOUT)!$D(DIRUT)
        !            33:        W @DIOF
        !            34:        Q
        !            35:        ;
        !            36: PRINTDEV       Q:'$D(DIARR)
        !            37:        S %ZIS="QN",%ZIS("B")="",%ZIS("A")="PRINT FOUND ENTRIES TO DEVICE: " D ^%ZIS Q:POP
        !            38:        S DIARPDEV=$S($D(ION)#2:ION,1:IO)
        !            39:        I $D(IOST)#2,IOST]"" S DIARPDEV=DIARPDEV_";"_IOST
        !            40:        F DIARZ="IOM","IOSL" S:($D(@DIARZ)#2&DIARZ) DIARPDEV=DIARPDEV_";"_@DIARZ
        !            41:        I $D(IO("Q")) U IO(0) W !,"THE PRINTING OF REPORT WILL BE QUEUED.  PROCESSING CONTINUES..." S DIARQUED=""
        !            42:        Q
        !            43:        ;
        !            44: ASKIX  W !,"This archived file contains an index of all archived entries."
        !            45:        K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to see the index now" D ^DIR Q:'Y!($D(DIRUT))
        !            46:        W @DIOF,! S DIARTAB=0 F DIARXX=1:1:DIARCNT S DIARFLD=$P(DIARPC(DIARXX),U,2),DIARTAB=DIARTAB+25 W $E(DIARFLD,1,23),?DIARTAB
        !            47:        S DIARYY=""
        !            48:        W ! F DIARXX=1:1:DIARCTR W ! S DIARTAB=0 D  I $Y>(DIOSL-2) D E Q:$D(DTOUT)!$D(DIRUT)
        !            49:        . F  S DIARYY=$O(DIARPC(DIARYY)) Q:DIARYY'>0  S DIARFLD=+$G(DIARPC(DIARYY)),DIARTAB=DIARTAB+25 W $E($P($G(^TMP("DIARHLP",$J,DIARXX,DIARFLD)),"= ",2),1,23),?DIARTAB
        !            50:        . Q
        !            51:        K DTOUT,DIRUT
        !            52:        Q