Return to DDBR.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDBR.m, revision 1.1

1.1     ! snw         1: DDBR   ;SFISC/DCL-VA FILEMAN BROWSER ;12/28/94  11:23
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: EN     N DDBC,DDBFLG,DDBL,DDBPMSG,DDBSA,DDBX,IOTM,IOBM
        !             5:        I '$$TEST^DDBRT W $C(7),!!,"This terminal does not support scroll region or reverse index",!! Q
        !             6:        D LIST^DDBR3(.DDBX)
        !             7:        I DDBX'>0 W:DDBX=0 $C(7),!!,"No Text",!! Q
        !             8:        S DDBSA=DDBX(6)
        !             9:        S DDBFLG=DDBX(4)
        !            10:        S DDBPMSG=DDBX(5)
        !            11:        D CONTNU
        !            12:        D KTMP^DDBRU
        !            13:        Q
        !            14: WP(DDBFN,DDBRN,DDBFLD,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM)      N DDBSA
        !            15:        S DDBSA=$$GET^DIQG($G(DDBFN),$G(DDBRN),$G(DDBFLD),"B")
        !            16:        I $G(DIERR) D CLEAN Q
        !            17:        S DDBSA=$P(DDBSA,"$CREF$",2)
        !            18:        I DDBSA']"" D ERR("FILE, RECORD and/or FIELD") Q
        !            19:        I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
        !            20:        S DDBPMSG=$G(DDBPMSG,"VA FileMan Browser (wp) DOCUMENT 1")
        !            21:        D CONTNU
        !            22:        D:$G(DDBFLG)'["P" KTMP^DDBRU
        !            23:        Q
        !            24: BROWSE(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM)       N DDBRLIST
        !            25: CONTNU I $G(U)'="^" N U S U="^"
        !            26:        S DDBPMSG=$G(DDBPMSG,"VA FileMan Browser DOCUMENT 1")
        !            27:        N %,D,DX,IOP,XY,X,Y
        !            28:        D:$G(DDBFLG)'["H" INIT I $G(DIERR) D CLEAN Q
        !            29:        I $G(DDBSA)']"" D ERR("SOURCE ARRAY") Q
        !            30:        I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
        !            31:        I $G(DDBFLG)'["N",DDBSA'="^TMP(""DDB"",$J)" D
        !            32:        .I $NA(@DDBSA)=$NA(^TMP("DDB",$J)) S DDBSA="^TMP(""DDB"",$J)" Q
        !            33:        .K ^TMP("DDB",$J)
        !            34:        .D XY^%RCR($$OREF(DDBSA),"^TMP(""DDB"",$J,")
        !            35:        .;M ^TMP("DDB",$J)=@DDBSA
        !            36:        .S DDBSA="^TMP(""DDB"",$J)"
        !            37:        .Q
        !            38:        N DDBRE,DDBRPE,DDBPSA,DDBTO,DDBDM,DDBFNO,I,DDBFLGS
        !            39:        N DDBHDR,DDBFTR,DDBSP,DDBSF,DDBST,DDBTL,DDBTPG,DDBZN
        !            40:        I '$G(DDBRLIST) N DDBSRL,DDBSX,DDBSY,DDBRSA
        !            41:        S DDBFTR=$E("Col>     |<PF1>H=Help <PF1>E=Exit| Line>                 Screen>"_$J("",IOM),1,IOM)
        !            42:        I '$G(DDBRLIST) S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
        !            43:        S DDBRSA=0
        !            44:        D TB^DDBRS(.IOTM,.IOBM,.DDBRSA)
        !            45:        S DDBSX="0;4;40;65"
        !            46:        S DDBSY=DDBRSA(0,"DDBSY")
        !            47:        I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
        !            48:        I IOTM<2 D ERR("TOP MARGIN") Q
        !            49:        I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
        !            50:        S DDBSRL=DDBRSA(0,"DDBSRL")
        !            51:        I DDBSRL'>4 D ERR("SCROLL REGION (TOO SMALL)") Q
        !            52:        I DDBRSA(1,"DDBSRL")'>4 K DDBRSA(1),DDBRSA(2)
        !            53:        S DDBHDR=$$CTXT(DDBPMSG,$J("",IOM+1),IOM)
        !            54:        S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
        !            55:        I DDBTL'>0 D  I DDBTL'>0 D BLD^DIALOG(1700,"*NO TEXT*"_DDBSA) D CLEAN Q
        !            56:        .N I S I=0 F  S I=$O(@DDBSA@(I)) Q:I'>0  S DDBTL=I
        !            57:        .Q
        !            58:        S DDBZN=$D(@DDBSA@(DDBTL,0))#2,DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1),DDBSF=1,DDBST=IOM
        !            59:        S DDBDM=DDBSA="^TMP(""DDB"",$J)"
        !            60:        I $G(DDBC)=+$G(DDBC) D ERR("TAB (Closed Array Root)") Q
        !            61:        S:$G(DDBC)="" DDBC="^TMP(""DDBC"",$J)"
        !            62:        I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
        !            63:        I $D(@DDBC@(1))'>9 N DDBC0,DDBC1 S @DDBC@(1)="",DDBC1=1,DDBC0=DDBC
        !            64:        S DDBPSA=0,DDBFLG=$G(DDBFLG)
        !            65:        S DDBFLGS=DDBFLG["S"
        !            66:        G EN^DDBRGE
        !            67: DOCLIST(DDBDSA,DDBFLG,IOTM,IOBM)       S IOP="HOME" D ^%ZIS
        !            68:        N DDBPMSG,DDBL,DDBC,DDBSA,DDBSRL,DDBSX,DDBSY,DDBRSA,DDBRLIST
        !            69:        S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
        !            70:        S DDBSX="0;4;40;65"
        !            71:        S DDBSY=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM)  ;hdr,txttop,txtbot,ftr
        !            72:        I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
        !            73:        I IOTM<2 D ERR("TOP MARGIN") Q
        !            74:        I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
        !            75:        S DDBSRL=(IOBM-IOTM)+1  ;scroll region lines
        !            76:        I '$D(@DDBDSA) D ERR("DOCUMENT ARRAY INVALID") Q
        !            77:        S DDBFLG=$TR($G(DDBFLG),"P")_"N"
        !            78:        S DDBPMSG=$O(@DDBDSA@("")) S:DDBPMSG]"" DDBSA=@DDBDSA@(DDBPMSG)
        !            79:        I DDBPMSG']""!(DDBSA']"") D ERR("DOCUMENT ARRAY INVALID") Q
        !            80:        D  I $G(DIERR) K ^TMP("DDBLST",$J) D CLEAN Q
        !            81:        .N DOC,DOCSA
        !            82:        .S DOC=""
        !            83:        .K ^TMP("DDBLST",$J)
        !            84:        .F  S DOC=$O(@DDBDSA@(DOC)) Q:DOC=""  D
        !            85:        ..S DOCSA=@DDBDSA@(DOC)
        !            86:        ..D LOADCL^DDBR4(DOCSA,"",DOC)
        !            87:        ..Q
        !            88:        .Q
        !            89:        Q:$G(DDBENDR)
        !            90:        S DDBRLIST=1
        !            91:        G CONTNU
        !            92: RTN    G DR^DDBRU
        !            93: ROOT   G EN^DDBRU2
        !            94: CTXT(X,T,W)    Q:X="" $G(T)
        !            95:        N HW
        !            96:        S W=$G(W,79),HW=W\2
        !            97:        S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q $E(T,1,W)
        !            98: OREF(X)        N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
        !            99: OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
        !           100: INIT   I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !           101:        D INIT^DDGLIB0()
        !           102:        I $G(DIERR) Q
        !           103:        I '$D(IOSTBM)!('$D(IOIL)) S X="IOSTBM;IORI" D ENDR^%ZISS
        !           104:        D:$G(IOSTBM)="" TRMERR^DDGLIB0("Set top and bottom margins")
        !           105:        D:$G(IORI)="" TRMERR^DDGLIB0("Reverse index")
        !           106:        Q
        !           107: ERR(DDBERR)    N P S P(1)=DDBERR
        !           108:        I $G(U)="^" N U S U="^"
        !           109:        D BLD^DIALOG(202,.P),OUT^DDBRU:$D(DDGLDEL)
        !           110: CLEAN  D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
        !           111:        Q