Return to DDBR2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDBR2.m, revision 1.1

1.1     ! snw         1: DDBR2  ;SFISC/DCL-VA FILEMAN BROWSER ;09:34 AM  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:        Q
        !             5: SWITCH(DDBLST,DDBRET)  ;Switch to another document in list or FileMan Database
        !             6:        I DDBSA="^DI(.84,9201,2)" D EXIT^DDBR0 Q  ;!(DDBSA="^XTMP(""DDBDOC"")") Q
        !             7:        N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
        !             8:        S DILN=DDBRSA(DDBRSA,"DDBSRL")-2
        !             9:        S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
        !            10:        I DDBFLG["R",'$D(@DDBLST) D SFR() G PS
        !            11:        I $G(DDBRET)["R" D  G:$G(Y) PS Q
        !            12:        .Q:DDBPSA'>0
        !            13:        .Q:'$D(@DDBLST@("APSA",DDBPSA))  S X=^(DDBPSA) S:$D(@DDBLST@("A",X)) Y=^(X)
        !            14:        .I $G(Y) S DDBPSA=DDBPSA-1 N DDBPSA D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
        !            15:        .Q
        !            16: BRMC   D BRM
        !            17:        I $D(@DDBLST) D
        !            18:        .I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q
        !            19:        .;W "Current list: ",!
        !            20:        .S DDBZ=$G(@DDBLST@("A",DDBSA),0)
        !            21:        .;S X=0 F  S X=$O(@DDBLST@(X)) Q:X'>0  W:X'=DDBZ !,$J(X,3),"  ",$E(@DDBLST@(X,0),1,75)
        !            22:        .W !
        !            23:        .K DIR0
        !            24:        .S DIR(0)="Y",DIR("A")="Do you wish to select from current list? ",DIR("B")="YES" D ^DIR,SFR("to Current List"):Y=0&(DDBFLG["R") Q:$D(DIRUT)!(Y'>0)
        !            25:        .S DIC=$$OREF^DIQGU(DDBLST),DIC(0)="EMQ",DIC("S")="I +Y'=DDBZ",DIC("W")="W:$E(^(0))=U ^(0)",X="??" D ^DIC  ;K DIC("S") Q:Y'>0
        !            26:        .S DIC(0)="AEMQ"
        !            27:        .D ^DIC K DIC("S") Q:Y'>0
        !            28:        .D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
        !            29:        .S DIROUT=1
        !            30:        N DDBLNA
        !            31:        S:DDBFLG["R" DIROUT=1
        !            32:        I '$D(DIROUT) D LIST^DDBR3(.DDBLNA)
        !            33:        I $G(DDBLNA,-1)=-1 G PS
        !            34:        I $G(DDBLNA(6))=DDBSA G PS  ;if current document selected again
        !            35:        I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS  ;if already in list
        !            36:        I DDBLNA'>0 W $C(7),!!,"** NO TEXT** ",DDBLNA(5) H 3
        !            37:        D:DDBLNA>0 SAVEDDB(DDBLST,DDBLN),WP(.DDBLNA)
        !            38: PS     D PSR^DDBR0(1)
        !            39:        Q
        !            40:        ;
        !            41: WP(DDBX)       ;
        !            42:        S DDBSA=DDBX(6)
        !            43:        S DDBPMSG=DDBX(5)
        !            44:        S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
        !            45:        S DDBTL=$P(@DDBSA@(0),"^",3)
        !            46:        S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
        !            47:        S DDBZN=1
        !            48:        S DDBDM=0
        !            49:        S DDBSF=1
        !            50:        S DDBST=IOM
        !            51:        S DDBC="^TMP(""DDBC"",""DDBC"",$J)"
        !            52:        I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
        !            53:        S DDBL=0
        !            54:        Q
        !            55:        ;
        !            56: SAVEDDB(DDBLIST,IEN,NSAPSA)    ;Save local varialbes into ^TMP("DDBLIST",$J,IEN)
        !            57:        ;DDBS  array to save list
        !            58:        ;IEN   internal entry
        !            59:        ;NSAPSA Not Set "APSA" x-ref if undefined, pass 1 to not set NSAPSA (optional - default is to set "APSA")
        !            60:        S NSAPSA=+$G(NSAPSA)
        !            61:        N I,X
        !            62:        F I="HDR","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@DDBLIST@(IEN,X)=@X
        !            63:        ;I $D(DDBFNO) S @DDBLIST@(IEN,DDBFNO)=DDBFNO  ;decided to keep it the same throughout the browse session (Next Find String)
        !            64:        S @DDBLIST@(IEN,0)=DDBPMSG
        !            65:        S:'$D(@DDBLIST@(0)) ^(0)="CURRENT LIST^1"
        !            66:        S:'$D(@DDBLIST@("A",DDBSA)) @DDBLIST@("A",DDBSA)=IEN
        !            67:        S:'$D(@DDBLIST@("B",DDBPMSG,IEN)) @DDBLIST@("B",DDBPMSG,IEN)=""
        !            68:        I $G(DDBRET)["R",DDBRPE=DDBRE Q
        !            69:        Q:NSAPSA
        !            70:        S X=$O(@DDBLST@("APSA"," "),-1)+1
        !            71:        I $G(@DDBLIST@("APSA",X-1))=DDBSA S DDBPSA=X-1 Q
        !            72:        S @DDBLIST@("APSA",X)=DDBSA,DDBPSA=X
        !            73:        Q
        !            74:        ;
        !            75: USAVEDDB(DDBLIST,IEN)  ;Unsave varialbes in ^TMP("DDBLIST",$J,IEN) to locals
        !            76:        ;DDBS  array to save list
        !            77:        ;IEN   internal entry
        !            78:        N I,X
        !            79:        F I="HDR","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@X=@DDBLIST@(IEN,X)
        !            80:        S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
        !            81:        ;I $D(@DDBLIST@(IEN,"DDBFNO")) S DDBFNO=@DDBLIST@(IEN,"DDBFNO")
        !            82:        Q
        !            83:        ;
        !            84:        ;
        !            85: CTXT(X,T,W)    ;Center X in T which is W characters wide (usually spaces) and W for screen width
        !            86:        Q:X="" $G(T)
        !            87:        N HW
        !            88:        S W=$G(W,79),HW=W\2
        !            89:        S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q T
        !            90: OREF(X)        N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
        !            91: OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
        !            92:        ;
        !            93: BRM    ;BROWSE MANAGER SCREEN
        !            94:        N DX,DY,X
        !            95:        S DX=0,DY=$P(DDBSY,";"),X=$$CTXT^DDBR("BROWSE SWITCH MANAGER",$J("",IOM+1),IOM)
        !            96:        X IOXY
        !            97:        W $P(DDGLVID,DDGLDEL,6)  ;rvon
        !            98:        W $P(DDGLVID,DDGLDEL,4)  ;uon
        !            99:        W X
        !           100:        W $P(DDGLVID,DDGLDEL,10)  ;rvoff
        !           101:        F DY=$P(DDBSY,";",2):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
        !           102:        W $P(DDGLVID,DDGLDEL,6)  ;rvon
        !           103:        W $P(DDGLVID,DDGLDEL,4)  ;uon
        !           104:        W X
        !           105:        W $P(DDGLVID,DDGLDEL,10)  ;rvoff
        !           106:        W @IOSTBM
        !           107:        S DY=$P(DDBSY,";",2)
        !           108:        X IOXY
        !           109:        Q
        !           110:        ;
        !           111: SFR(Y) N X
        !           112:        S X(1)="",X(2)=$$CTXT^DDBR("<< SWITCH Function Restricted "_$G(Y)_" >>","",IOM)
        !           113:        W $$WS^DDBR1(.X),$C(7)
        !           114:        R X:3
        !           115:        Q