Return to DDBR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDBR1	;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS;04:22 PM  20 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: GOTO	N X
    6: GTR	S X(1)=$G(X(1)),X(2)="GoTo >" W $$WS(.X) D  G:X=""!(X=U) OUT
    7: 	.D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
    8: 	.K DIR0
    9: 	.Q
   10: 	I $E(X)="?" S X(1)="* Screen (default), line or column number preceeded by 'S', 'L' or 'C' *" G GTR
   11: 	I X S X=X*DDBSRL G LINE
   12: 	S $E(X)=$TR($E(X),"bclst","BCLST")
   13: 	I X["S",$TR($P(X,"S",2)," ") S X=$TR($P(X,"S",2)," ")*DDBSRL G LINE
   14: 	I X["L",$TR($P(X,"L",2)," ") S X=$TR($P(X,"L",2)," ") G LINE
   15: 	I X["C",$TR($P(X,"C",2)," ") S X=$TR($P(X,"C",2)," ") I X>0&(X<256) S DDBSF=X G COLENT^DDBR0
   16: 	I $E(X)="T" G TOP^DDBR0
   17: 	I $E(X)="B" G BOT^DDBR0
   18: 	G OUT
   19: LINE	S DDBL=$S(X'>DDBSRL:0,X>DDBTL:DDBTL,1:X) D PSR^DDBR0()
   20: 	Q
   21: NOOF	N N
   22: 	S N=1 I $D(DDBFNO) N D,X G FNO
   23: 	S X(1)="    * [ NO PREVIOUS FIND STRING AVAILABLE ] *"
   24: 	N Q S N=0 G BPR
   25: FIND	N D,Q,X
   26: 	N N
   27: 	S N=0
   28: BPR	S X(1)=$G(X(1)),X(2)="Find What:  " W $$WS(.X) D  G:X="" OUT
   29: 	.N Y
   30: 	.D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,$P($G(DDBFNO),U,3,255),100,1,"","KPW",.X,.Y)
   31: 	.K DIR0
   32: 	.S:$P($G(Y),U)="U" X=X_"/U"
   33: 	.Q
   34: 	S Q=$TR($E(X,$L(X)-1,$L(X)),"u","U")
   35: 	S D=$S(Q="/U":-1,1:1)
   36: 	S:D=-1 X=$E(X,1,$L(X)-2)
   37: 	Q:X=""
   38: 	I $E(X)="?" S X(1)="    * [ Please enter any characters <cr>, '^' <cr> (exit) ] *" G BPR
   39: FNO	N I,MATCHI,MATCHX
   40: 	I N S D=$P(DDBFNO,"^",2),X=$P(DDBFNO,"^",3,255)
   41: 	S X(1)="",X(2)="    * [ ...Searching "_$S(D=1:"'DOWN'",1:"'UP'")_" for "_X_"... ] *" W $$WS(.X)
   42: 	D  S:I<0 I=0
   43: 	.I N&(D=1) S I=DDBL Q
   44: 	.I N S I=DDBL-(DDBSRL-1) Q
   45: 	.I D=1 S I=DDBL-DDBSRL Q
   46: 	.S I=DDBL+1
   47: 	.Q
   48: 	D
   49: 	.N XUC
   50: 	.S XUC=$$U(X)
   51: 	.I DDBDM D  Q
   52: 	..I DDBZN D  Q
   53: 	...F  S I=$O(^TMP("DDB",$J,I),D) Q:I'>0  I $$U($G(^(I,0)))[XUC S MATCHI=I,MATCHX=^(0) Q
   54: 	...Q
   55: 	..F  S I=$O(^TMP("DDB",$J,I),D) Q:I'>0  I $$U(^(I))[XUC S MATCHI=I,MATCHX=^(I) Q
   56: 	..Q
   57: 	.I DDBZN D  Q
   58: 	..F  S I=$O(@DDBSA@(I),D) Q:I'>0  I $$U($G(@DDBSA@(I,0)))[XUC S MATCHI=I,MATCHX=@DDBSA@(I,0) Q
   59: 	..Q
   60: 	.F  S I=$O(@DDBSA@(I),D) Q:I'>0  I $$U(@DDBSA@(I))[XUC S MATCHI=I,MATCHX=@DDBSA@(I) Q
   61: 	.Q
   62: 	I $G(MATCHI) D  S DDBFNO=DDBL_"^"_D_"^"_X Q
   63: 	.S DDBSF=1,DDBST=IOM F  Q:$F(MATCHX,X)'>DDBST  D
   64: 	..S DDBSF=$O(@DDBC@(DDBSF)) S:DDBSF="" DDBSF=$O(@DDBC@(""))
   65: 	..S DDBST=DDBSF+(IOM-1)
   66: 	..Q
   67: 	.I I+(DDBSRL)>DDBTL S I=DDBTL-(DDBSRL-1)
   68: 	.I DDBTL'>DDBSRL S I=1
   69: 	.S DDBL=I-1 D SDLRH(I,X),RCLSI^DDBR0
   70: 	.Q
   71: 	S X(1)="",X(2)="    * [ NO"_$S(N:" OTHER ",1:" ")_"MATCH FOUND ] *" W $C(7),$$WS(.X) H 3
   72: 	D PSRH
   73: 	Q
   74: OUT	D PSR^DDBR0()
   75: 	Q
   76: PSRH	S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
   77: 	D SDLRH(DDBL+1,X)
   78: 	Q
   79: SDL	;
   80: SDLRH(L,HLS)	N I,J,SFR,STO
   81: 	S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
   82: 	S DY=SFR X IOXY
   83: 	I DDBZN F I=SFR:1:STO D
   84: 	.W:I'=SFR !
   85: 	.W $P(DDGLCLR,DDGLDEL)
   86: 	.I J=L,$D(@DDBSA@(L)) W $$HL($E(@DDBSA@(L,0),DDBSF,DDBST),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,10)) S DDBL=DDBL+1,L=L+1
   87: 	.S J=J+1
   88: 	.Q
   89: 	I 'DDBZN F I=SFR:1:STO D
   90: 	.W:I'=SFR !
   91: 	.W $P(DDGLCLR,DDGLDEL)
   92: 	.I J=L,$D(@DDBSA@(L)) W $$HL($E(@DDBSA@(L),DDBSF,DDBST),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,10)) S DDBL=DDBL+1,L=L+1
   93: 	.S J=J+1
   94: 	.Q
   95: 	Q
   96: HL(X,S,ON,RS,F)	S X=$G(X),S=$G(S),F=$G(F)=1
   97: 	G:F CS
   98: 	N C,I,P,T,XU,SU,SL,TL,XL
   99: 	S XU=$$U(X),SU=$$U(S),SL=$L(S),C=$L(XU,SU)-1,T="",XL=0
  100: 	Q:'C X
  101: 	F I=1:1:C S P=$F(XU,SU,XL),T=T_$E(X,XL,P-SL-1)_ON_$E(X,P-SL,P-1)_RS,XL=P
  102: 	S T=T_$E(X,XL,255)
  103: 	Q T
  104: U(X)	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  105: CS	Q:$L(X,S)'>1 X
  106: 	N C,I,P,T
  107: 	S T="",C=$L(X,S)
  108: 	F I=1:1:C S P=$P(X,S,I),T=T_P_$S(I'=C:ON_S_RS,1:"")
  109: 	Q T
  110: HELP(DDBHELP)	N I,J
  111: 	I DDBSA="^DI(.84,9201,2)" S DDBL=0 D SDLR^DDBR0(1),RCLSI^DDBR0 Q
  112: 	N DDBHA S DDBHA="^DI(.84,9201,2)"
  113: 	D BROWSE^DDBR(DDBHA,"PNH","VA FileMan Help Document","","",IOTM,IOBM,DDBHELP),PSR^DDBR0(1)
  114: 	Q
  115: LC(L,C)	Q:$G(L)'>0 ""
  116: 	S C=$G(C,"-")
  117: 	Q $TR($J("",L)," ",C)
  118: WS(X)	S DX=0,DY=$P(DDBSY,";",3)-3 X IOXY
  119: 	W $P(DDGLGRA,DDGLDEL)
  120: 	W $TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))
  121: 	W $P(DDGLGRA,DDGLDEL,2)
  122: 	W !,$P(DDGLCLR,DDGLDEL),$G(X(1))
  123: 	W !,$P(DDGLCLR,DDGLDEL),$G(X(2))
  124: 	W !,$P(DDGLCLR,DDGLDEL),$G(X(3))
  125: 	S DY=$P(DDBSY,";",3),DX=$L($G(X(2)))+2 X IOXY
  126: 	Q ""