Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDBR1

DDBR1.m

Go to the documentation of this file.
  1. DDBR1 ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;06:01 PM 31 Aug 2002
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q
  1. GOTO N X
  1. GTR S X(1)=$G(X(1)),X(2)=$$EZBLD^DIALOG(1408)_" >" W $$WS(.X) D G:X=""!(X=U) OUT ;**
  1. .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,"","","KPW",.X)
  1. .K DIR0
  1. .Q
  1. I $E(X)="?" S X(1)="* "_$$EZBLD^DIALOG($S(DDBRHTF:1409,1:1409.1))_" *" G GTR ;**
  1. I X S X=X*DDBSRL G LINE
  1. S $E(X)=$TR($E(X),"bclst","BCLST")
  1. I X["S",$TR($P(X,"S",2)," ") S X=$TR($P(X,"S",2)," ")*DDBSRL G LINE
  1. I X["L",$TR($P(X,"L",2)," ") S X=$TR($P(X,"L",2)," ") G LINE
  1. I X["C",'DDBRHTF,$TR($P(X,"C",2)," ") S X=$TR($P(X,"C",2)," ") I X>0&(X<256) S DDBSF=X G COLENT^DDBR0
  1. I $E(X)="T" G TOP^DDBR0
  1. I $E(X)="B" G BOT^DDBR0
  1. G OUT
  1. LINE S DDBL=$S(X'>DDBSRL:0,X>DDBTL:DDBTL,1:X) D PSR^DDBR0()
  1. Q
  1. NOOF N N
  1. S N=1 I $D(DDBFNO) N D,X G FNO
  1. S X(1)=" * ["_$$EZBLD^DIALOG(1406)_"] *" ;**'NO PREVIOUS FIND STRING AVAILABLE'
  1. N Q S N=0 G BPR
  1. FIND N D,Q,X
  1. N N
  1. S N=0
  1. BPR S X(1)=$G(X(1)),X(2)=$$EZBLD^DIALOG(8126) W $$WS(.X) D G:X="" OUT ;**
  1. .N Y
  1. .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,$P($G(DDBFNO),U,3,255),100,"","","KPW",.X,.Y)
  1. .K DIR0
  1. .S:$P($G(Y),U)="U" X=X_"/U"
  1. .Q
  1. S Q=$TR($E(X,$L(X)-1,$L(X)),"u","U")
  1. S D=$S(Q="/U":-1,1:1)
  1. S:D=-1 X=$E(X,1,$L(X)-2)
  1. Q:X=""
  1. I $E(X)="?" S X(1)=" * [ "_$$EZBLD^DIALOG(1407)_" ] *" G BPR ;**
  1. FNO N I,MATCHI,MATCHX
  1. I N S D=$P(DDBFNO,"^",2),X=$P(DDBFNO,"^",3,255)
  1. S X(1)="",X(2)=" * ["_$$EZBLD^DIALOG(1405,X)_"] *" W $$WS(.X) ;**'SEARCHING'
  1. D S:I<0 I=0
  1. .I N&(D=1) S I=DDBL Q
  1. .I N S I=DDBL-(DDBSRL-1) Q
  1. .I D=1 S I=DDBL-DDBSRL Q
  1. .S I=DDBL+1
  1. .Q
  1. D
  1. .N XUC
  1. .S XUC=$$U(X)
  1. .I DDBDM D Q
  1. ..I DDBZN D Q
  1. ...F S I=$O(^TMP("DDB",$J,I),D) Q:I'>0 I $$U($G(^(I,0)))[XUC S MATCHI=I,MATCHX=^(0) Q
  1. ...Q
  1. ..F S I=$O(^TMP("DDB",$J,I),D) Q:I'>0 I $$U(^(I))[XUC S MATCHI=I,MATCHX=^(I) Q
  1. ..Q
  1. .I DDBZN D Q
  1. ..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
  1. ..Q
  1. .F S I=$O(@DDBSA@(I),D) Q:I'>0 I $$U(@DDBSA@(I))[XUC S MATCHI=I,MATCHX=@DDBSA@(I) Q
  1. .Q
  1. I $G(MATCHI) D S DDBFNO=DDBL_"^"_D_"^"_X Q
  1. .S DDBSF=1,DDBST=IOM F Q:$F(MATCHX,X)'>DDBST D
  1. ..S DDBSF=$O(@DDBC@(DDBSF)) S:DDBSF="" DDBSF=$O(@DDBC@(""))
  1. ..S DDBST=DDBSF+(IOM-1)
  1. ..Q
  1. .I I+(DDBSRL)>DDBTL S I=DDBTL-(DDBSRL-1)
  1. .I DDBTL'>DDBSRL S I=1
  1. .S DDBL=I-1 D SDLRH(I,X),RCLSI^DDBR0
  1. .Q
  1. NO S X(1)="",X(2)=" * ["_$$EZBLD^DIALOG($S(N:8006.11,1:8006.1))_" ] *" W $C(7),$$WS(.X) H 3 ;**'NO MATCH FOUND'
  1. D PSRH
  1. Q
  1. OUT D PSR^DDBR0()
  1. Q
  1. PSRH S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
  1. D SDLRH(DDBL+1,X)
  1. Q
  1. SDL ;
  1. SDLRH(L,HLS) N I,J,SFR,STO
  1. S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
  1. S DY=SFR X IOXY
  1. I DDBZN F I=SFR:1:STO D
  1. .W:I'=SFR !
  1. .W $P(DDGLCLR,DDGLDEL)
  1. .I J=L,$D(@DDBSA@(L)) W $$HL($$HTD^DDBR0(@DDBSA@(L,0),L),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,7)) S DDBL=DDBL+1,L=L+1
  1. .S J=J+1
  1. .Q
  1. I 'DDBZN F I=SFR:1:STO D
  1. .W:I'=SFR !
  1. .W $P(DDGLCLR,DDGLDEL)
  1. .I J=L,$D(@DDBSA@(L)) W $$HL($$HTD^DDBR0(@DDBSA@(L),L),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,7)) S DDBL=DDBL+1,L=L+1
  1. .S J=J+1
  1. .Q
  1. Q
  1. HL(X,S,ON,RS,F) S X=$G(X),S=$G(S),F=$G(F)=1
  1. G:F CS
  1. N C,I,P,T,XU,SU,SL,TL,XL
  1. S XU=$$U(X),SU=$$U(S),SL=$L(S),C=$L(XU,SU)-1,T="",XL=0
  1. Q:'C X
  1. 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
  1. S T=T_$E(X,XL,255)
  1. Q T
  1. U(X) Q $$UP^DILIBF(X) ;**CCO/NI UPPER-CASE
  1. CS Q:$L(X,S)'>1 X
  1. N C,I,P,T
  1. S T="",C=$L(X,S)
  1. F I=1:1:C S P=$P(X,S,I),T=T_P_$S(I'=C:ON_S_RS,1:"")
  1. Q T
  1. HELPS N DDBHELPS
  1. S DDBHELPS=$S(DDBFLG["A":83,1:71)+DDBSRL
  1. HELP I $E(DDBSA,1,11)="^DI(.84,920" S DDBL=0 D SDLR^DDBR0(1),RLPIR^DDBR0 Q
  1. N DDBHA S DDBHA=$S(DDBFLG["A":9202,1:9201) Q:'$D(^DI(.84,DDBHA,2)) S DDBHA=$NA(^(2)) I $G(DUZ("LANG"))>1,$D(^(4,DUZ("LANG"),1)) S DDBHA=$NA(^(1)) ;**CCO/NI
  1. I $D(^TMP("DDBLST",$J,"J")) D
  1. .K ^TMP("DDBLST",$J,"JS")
  1. .M ^TMP("DDBLST",$J,"JS")=^TMP("DDBLST",$J,"J")
  1. .K ^TMP("DDBLST",$J,"J")
  1. .Q
  1. D BROWSE^DDBR(DDBHA,"PNH"_$S(DDBFLG["A":"A",1:""),"VA FileMan Help Document",$G(DDBHELPS),"",IOTM-1,IOBM+1)
  1. K ^TMP("DDBLST",$J,"J")
  1. I $D(^TMP("DDBLST",$J,"JS")) M ^TMP("DDBLST",$J,"J")=^TMP("DDBLST",$J,"JS") K ^TMP("DDBLST",$J,"JS")
  1. W @IOSTBM
  1. D PSR^DDBR0(1)
  1. Q
  1. LC(L,C) Q:$G(L)'>0 ""
  1. S C=$G(C,"-")
  1. Q $TR($J("",L)," ",C)
  1. WS(X) S DX=0,DY=$P(DDBSY,";",3)-3 X IOXY
  1. W $P(DDGLGRA,DDGLDEL)
  1. W $TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))
  1. W $P(DDGLGRA,DDGLDEL,2)
  1. W !,$P(DDGLCLR,DDGLDEL),$G(X(1))
  1. W !,$P(DDGLCLR,DDGLDEL),$G(X(2))
  1. W !,$P(DDGLCLR,DDGLDEL),$G(X(3))
  1. S DY=$P(DDBSY,";",3),DX=$L($G(X(2)))+2 X IOXY
  1. Q ""