Return to DDBR3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDBR3.m, revision 1.1

1.1     ! snw         1: DDBR3  ;SFISC/DCL-SELECT FILE & WP FIELD TO BROWSE ;02:27 PM  24 Oct 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: LIST(DDBLIST)  ;DDBLIST=Target array for file number,ien,field,...
        !             5:        S DDBLIST=-1  ;no selection
        !             6: EN     ;
        !             7:        N %,%H,%ZISOS,A,D,D0,D1,DA,DDBB,DDBDDF,DDBDIC,DDBFRCD,DDBIEN,DDBRCR,DDBX,DIC,DICS,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL,DN,DX,I,POP,S,X,Y
        !             8:        ;S DIC=1,DIC(0)="AEMQ" D ^DIC Q:+Y'>0  ;Select file
        !             9:        D ^DICRW Q:Y'>0
        !            10:        S DIC="^DD("_+Y_",",DIC(0)="AEMQ"
        !            11: M      S DIC("W")="I $P(^(0),U,2) W $S($P(^DD(+$P(^(0),U,2),.01,0),U,2)[""W"":""  (word-processing)"",1:""  (multiple)"")"
        !            12:        S DIC("S")="I $P(^(0),U,2)"
        !            13:        D ^DIC I +Y'>0,$D(@(DIC_"0,""UP"")")) S DIC="^DD("_+^("UP")_"," G M ;Select field/back out of multiples
        !            14:        Q:+Y'>0
        !            15:        I $P(@(DIC_+Y_",0)"),U,2) S DIC="^DD("_+$P(^(0),U,2)_",",Y=.01 G D:$P(^DD(+$P(^(0),U,2),.01,0),U,2)["W",M
        !            16: D      ;
        !            17:        K DIC("S")
        !            18:        S DDBDIC=$$UP^DIQGU(+$P(DIC,"^DD(",2),.DDBDIC),(DDBX,DDBIEN)=""
        !            19:        S DDBFRCD=$$GET^DIQGDD(DDBDIC,"","NAME")_":[",DDBB=0
        !            20:        F  S DDBX=$O(DDBDIC(DDBX)) Q:DDBX'<0  D  Q:$G(Y)'>0
        !            21:        .K DA D IEN(","_DDBIEN,.DA)
        !            22:        .S DIC=$$ROOT^DIQGU(+DDBDIC(DDBX),","_DDBIEN),DIC(0)="AEMQ" Q:DIC']""
        !            23:        .S DDBRCR=$$CREF^DILF(DIC)
        !            24:        .I $P($G(@DDBRCR@(0)),U,4)'>0 D  K DDBIEN Q
        !            25:        ..W $C(7),!!,"No Records at "_$S(DDBDIC=+DDBDIC(DDBX):"FILE",1:$P(^DD(+DDBDIC(DDBX),.01,0),U))_" Level.",!
        !            26:        ..Q
        !            27:        .D ^DIC I Y'>0 K DDBIEN Q
        !            28:        .S DDBIEN=+Y_","_DDBIEN
        !            29:        .S DDBFRCD=DDBFRCD_$S(DDBB:"\",1:"")_$$GET^DIQG(+DDBDIC(DDBX),DDBIEN,.01),DDBB=1
        !            30:        .K DA D IEN(DDBIEN,.DA)
        !            31:        .Q
        !            32: DISP   ;
        !            33:        S DDBDDF=$O(^DD(+DDBDIC(-1),"SB",+DDBDIC(0),"")) Q:'DDBDDF
        !            34:        S DDBFRCD=DDBFRCD_"] (wp): "_$P(^DD(DDBDIC(0),.01,0),"^")
        !            35:        I $D(DDBIEN) D  Q
        !            36:        .N DDBX S DDBX=$P($$GET^DIQG(+DDBDIC(-1),DDBIEN,DDBDDF,"B"),"$CREF$",2)
        !            37:        .S DDBLIST=$D(@DDBX)
        !            38:        .S DDBLIST(1)=+DDBDIC(-1)
        !            39:        .S DDBLIST(2)=DDBIEN
        !            40:        .S DDBLIST(3)=DDBDDF
        !            41:        .S DDBLIST(4)="N"
        !            42:        .S DDBLIST(5)=DDBFRCD
        !            43:        .S DDBLIST(6)=DDBX
        !            44:        .Q
        !            45:        Q
        !            46: IEN(IEN,DA)    S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)=""  S DA(I-1)=$P(IEN,",",I)
        !            47:        Q