Return to DDBR2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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