- DDBR2 ;SFISC/DCL-VA FILEMAN BROWSER ;26AUG2009
- ;;22.0;VA FileMan;**162**;Mar 30, 1999;Build 21
- ;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- SWITCH(DDBLST,DDBRET) ;Switch to another document in list or FileMan Database
- I $E(DDBSA,1,11)="^DI(.84,920" D EXIT^DDBR0 Q ;!(DDBSA="^XTMP(""DDBDOC"")") Q
- I DDBSA=$NA(^TMP("DDWB",$J)) G EXIT^DDBR0:$G(DDBRET)["R",SWITCH^DDBRWB Q
- N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
- S DILN=DDBRSA(DDBRSA,"DDBSRL")-2
- S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
- I DDBFLG["R",'$D(@DDBLST) D SFR() G PS
- I DDBFLG["A" D SFR() G PS
- I $G(DDBRET)["R" D G:$G(Y) PS Q
- .Q:DDBPSA'>0
- .Q:'$D(@DDBLST@("APSA",DDBPSA)) S X=^(DDBPSA) S:$D(@DDBLST@("A",X)) Y=^(X)
- .I $G(Y) S DDBPSA=DDBPSA-1 N DDBPSA D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
- .Q
- BRMC D BRM
- I $D(@DDBLST) D
- .I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q
- .;W "Current list: ",!
- .S DDBZ=$G(@DDBLST@("A",DDBSA),0)
- .;S X=0 F S X=$O(@DDBLST@(X)) Q:X'>0 W:X'=DDBZ !,$J(X,3)," ",$E(@DDBLST@(X,0),1,75)
- .W !
- .K DIR0
- .;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)
- .I DDBFLG'["R" S DIR(0)="Y",DIR("A")="Do you wish to select from current list",DIR("B")="YES" D ^DIR Q:$D(DIRUT)!(Y'>0)
- .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
- .S DIC(0)="AEMQ"
- .D ^DIC K DIC("S") Q:Y'>0
- .D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
- .S DIROUT=1
- N DDBLNA
- S:DDBFLG["R" DIROUT=1
- I '$D(DIROUT) D LIST^DDBR3(.DDBLNA)
- I $G(DDBLNA,-1)=-1 G PS
- I $G(DDBLNA(6))=DDBSA G PS ;if current document selected again
- I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS ;if already in list
- I DDBLNA'>0 W $C(7),!!,"** NO TEXT** ",DDBLNA(5) H 3
- D:DDBLNA>0 SAVEDDB(DDBLST,DDBLN),WP(.DDBLNA)
- PS D PSR^DDBR0(1)
- Q
- ;
- WP(DDBX) ;
- S DDBSA=DDBX(6)
- S DDBPMSG=DDBX(5)
- S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
- S DDBTL=$P(@DDBSA@(0),"^",3)
- S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- S DDBZN=1
- S DDBDM=0
- S DDBSF=1
- S DDBST=IOM
- S DDBC="^TMP(""DDBC"",""DDBC"",$J)"
- I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
- S DDBL=0
- Q
- ;
- SAVEDDB(DDBLIST,IEN,NSAPSA) ;Save local varialbes into ^TMP("DDBLIST",$J,IEN)
- ;DDBS array to save list
- ;IEN internal entry
- ;NSAPSA Not Set "APSA" x-ref if undefined, pass 1 to not set NSAPSA (optional - default is to set "APSA")
- S NSAPSA=+$G(NSAPSA)
- N I,X
- F I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@DDBLIST@(IEN,X)=@X
- ;I $D(DDBFNO) S @DDBLIST@(IEN,DDBFNO)=DDBFNO ;decided to keep it the same throughout the browse session (Next Find String)
- S @DDBLIST@(IEN,0)=DDBPMSG
- S:'$D(@DDBLIST@(0)) ^(0)="CURRENT LIST^1"
- S:'$D(@DDBLIST@("A",DDBSA)) @DDBLIST@("A",DDBSA)=IEN
- S:'$D(@DDBLIST@("B",DDBPMSG,IEN)) @DDBLIST@("B",DDBPMSG,IEN)=""
- I $G(DDBRET)["R",DDBRPE=DDBRE Q
- Q:NSAPSA
- S X=$O(@DDBLST@("APSA"," "),-1)+1
- I $G(@DDBLIST@("APSA",X-1))=DDBSA S DDBPSA=X-1 Q
- S @DDBLIST@("APSA",X)=DDBSA,DDBPSA=X
- Q
- ;
- USAVEDDB(DDBLIST,IEN) ;Unsave varialbes in ^TMP("DDBLIST",$J,IEN) to locals
- ;DDBS array to save list
- ;IEN internal entry
- N I,X
- F I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@X=@DDBLIST@(IEN,X)
- S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- ;I $D(@DDBLIST@(IEN,"DDBFNO")) S DDBFNO=@DDBLIST@(IEN,"DDBFNO")
- Q
- ;
- ;
- CTXT(X,T,W) ;Center X in T which is W characters wide (usually spaces) and W for screen width
- Q:X="" $G(T)
- N HW
- S W=$G(W,79),HW=W\2
- S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q T
- OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
- OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
- ;
- BRM ;BROWSE MANAGER SCREEN
- N DX,DY,X
- S DX=0,DY=$P(DDBSY,";"),X=$$CTXT^DDBR("BROWSE SWITCH MANAGER",$J("",IOM+1),IOM)
- X IOXY
- W $P(DDGLVID,DDGLDEL,6) ;rvon
- W $P(DDGLVID,DDGLDEL,4) ;uon
- W X
- W $P(DDGLVID,DDGLDEL,10) ;rvoff
- F DY=$P(DDBSY,";",2):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
- W $P(DDGLVID,DDGLDEL,6) ;rvon
- W $P(DDGLVID,DDGLDEL,4) ;uon
- W X
- W $P(DDGLVID,DDGLDEL,10) ;rvoff
- W @IOSTBM
- S DY=$P(DDBSY,";",2)
- X IOXY
- Q
- ;
- SFR(Y) N X
- S X(1)="",X(2)=$$CTXT^DDBR("<< SWITCH Function Restricted "_$G(Y)_" >>","",IOM)
- W $$WS^DDBR1(.X),$C(7)
- R X:3
- Q
- DDBR2 ;SFISC/DCL-VA FILEMAN BROWSER ;26AUG2009
- +1 ;;22.0;VA FileMan;**162**;Mar 30, 1999;Build 21
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- SWITCH(DDBLST,DDBRET) ;Switch to another document in list or FileMan Database
- +1 ;!(DDBSA="^XTMP(""DDBDOC"")") Q
- IF $EXTRACT(DDBSA,1,11)="^DI(.84,920"
- DO EXIT^DDBR0
- QUIT
- +2 IF DDBSA=$NAME(^TMP("DDWB",$JOB))
- IF $GET(DDBRET)["R"
- GOTO EXIT^DDBR0
- GOTO SWITCH^DDBRWB
- QUIT
- +3 NEW DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
- +4 SET DILN=DDBRSA(DDBRSA,"DDBSRL")-2
- +5 IF $GET(DDBLST)=""
- SET DDBLST="^TMP(""DDBLST"",$J)"
- SET DDBLN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)
- +6 IF DDBFLG["R"
- IF '$DATA(@DDBLST)
- DO SFR()
- GOTO PS
- +7 IF DDBFLG["A"
- DO SFR()
- GOTO PS
- +8 IF $GET(DDBRET)["R"
- Begin DoDot:1
- +9 IF DDBPSA'>0
- QUIT
- +10 IF '$DATA(@DDBLST@("APSA",DDBPSA))
- QUIT
- SET X=^(DDBPSA)
- IF $DATA(@DDBLST@("A",X))
- SET Y=^(X)
- +11 IF $GET(Y)
- SET DDBPSA=DDBPSA-1
- NEW DDBPSA
- DO SAVEDDB(DDBLST,DDBLN)
- DO USAVEDDB(DDBLST,+Y)
- +12 QUIT
- End DoDot:1
- IF $GET(Y)
- GOTO PS
- QUIT
- BRMC DO BRM
- +1 IF $DATA(@DDBLST)
- Begin DoDot:1
- +2 IF $ORDER(@DDBLST@(" "),-1)=1
- IF $GET(@DDBLST@(1,"DDBSA"))=DDBSA
- QUIT
- +3 ;W "Current list: ",!
- +4 SET DDBZ=$GET(@DDBLST@("A",DDBSA),0)
- +5 ;S X=0 F S X=$O(@DDBLST@(X)) Q:X'>0 W:X'=DDBZ !,$J(X,3)," ",$E(@DDBLST@(X,0),1,75)
- +6 WRITE !
- +7 KILL DIR0
- +8 ;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)
- +9 IF DDBFLG'["R"
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to select from current list"
- SET DIR("B")="YES"
- DO ^DIR
- IF $DATA(DIRUT)!(Y'>0)
- QUIT
- +10 ;K DIC("S") Q:Y'>0
- SET DIC=$$OREF^DIQGU(DDBLST)
- SET DIC(0)="EMQ"
- SET DIC("S")="I +Y'=DDBZ"
- SET DIC("W")="W:$E(^(0))=U ^(0)"
- SET X="??"
- DO ^DIC
- +11 SET DIC(0)="AEMQ"
- +12 DO ^DIC
- KILL DIC("S")
- IF Y'>0
- QUIT
- +13 DO SAVEDDB(DDBLST,DDBLN)
- DO USAVEDDB(DDBLST,+Y)
- +14 SET DIROUT=1
- End DoDot:1
- +15 NEW DDBLNA
- +16 IF DDBFLG["R"
- SET DIROUT=1
- +17 IF '$DATA(DIROUT)
- DO LIST^DDBR3(.DDBLNA)
- +18 IF $GET(DDBLNA,-1)=-1
- GOTO PS
- +19 ;if current document selected again
- IF $GET(DDBLNA(6))=DDBSA
- GOTO PS
- +20 ;if already in list
- IF $GET(DDBLNA(6))]""
- IF $DATA(@DDBLST@("APSA",DDBSA))
- GOTO PS
- +21 IF DDBLNA'>0
- WRITE $CHAR(7),!!,"** NO TEXT** ",DDBLNA(5)
- HANG 3
- +22 IF DDBLNA>0
- DO SAVEDDB(DDBLST,DDBLN)
- DO WP(.DDBLNA)
- PS DO PSR^DDBR0(1)
- +1 QUIT
- +2 ;
- WP(DDBX) ;
- +1 SET DDBSA=DDBX(6)
- +2 SET DDBPMSG=DDBX(5)
- +3 SET DDBHDR=$$CTXT^DDBR(DDBPMSG,$JUSTIFY("",IOM+1),IOM)
- +4 SET DDBTL=$PIECE(@DDBSA@(0),"^",3)
- +5 SET DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- +6 SET DDBZN=1
- +7 SET DDBDM=0
- +8 SET DDBSF=1
- +9 SET DDBST=IOM
- +10 SET DDBC="^TMP(""DDBC"",""DDBC"",$J)"
- +11 IF '$DATA(@DDBC)
- FOR I=1,22:22:176
- SET @DDBC@(I)=""
- +12 SET DDBL=0
- +13 QUIT
- +14 ;
- SAVEDDB(DDBLIST,IEN,NSAPSA) ;Save local varialbes into ^TMP("DDBLIST",$J,IEN)
- +1 ;DDBS array to save list
- +2 ;IEN internal entry
- +3 ;NSAPSA Not Set "APSA" x-ref if undefined, pass 1 to not set NSAPSA (optional - default is to set "APSA")
- +4 SET NSAPSA=+$GET(NSAPSA)
- +5 NEW I,X
- +6 FOR I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE"
- SET X="DDB"_I
- SET @DDBLIST@(IEN,X)=@X
- +7 ;I $D(DDBFNO) S @DDBLIST@(IEN,DDBFNO)=DDBFNO ;decided to keep it the same throughout the browse session (Next Find String)
- +8 SET @DDBLIST@(IEN,0)=DDBPMSG
- +9 IF '$DATA(@DDBLIST@(0))
- SET ^(0)="CURRENT LIST^1"
- +10 IF '$DATA(@DDBLIST@("A",DDBSA))
- SET @DDBLIST@("A",DDBSA)=IEN
- +11 IF '$DATA(@DDBLIST@("B",DDBPMSG,IEN))
- SET @DDBLIST@("B",DDBPMSG,IEN)=""
- +12 IF $GET(DDBRET)["R"
- IF DDBRPE=DDBRE
- QUIT
- +13 IF NSAPSA
- QUIT
- +14 SET X=$ORDER(@DDBLST@("APSA"," "),-1)+1
- +15 IF $GET(@DDBLIST@("APSA",X-1))=DDBSA
- SET DDBPSA=X-1
- QUIT
- +16 SET @DDBLIST@("APSA",X)=DDBSA
- SET DDBPSA=X
- +17 QUIT
- +18 ;
- USAVEDDB(DDBLIST,IEN) ;Unsave varialbes in ^TMP("DDBLIST",$J,IEN) to locals
- +1 ;DDBS array to save list
- +2 ;IEN internal entry
- +3 NEW I,X
- +4 FOR I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE"
- SET X="DDB"_I
- SET @X=@DDBLIST@(IEN,X)
- +5 SET DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- +6 ;I $D(@DDBLIST@(IEN,"DDBFNO")) S DDBFNO=@DDBLIST@(IEN,"DDBFNO")
- +7 QUIT
- +8 ;
- +9 ;
- CTXT(X,T,W) ;Center X in T which is W characters wide (usually spaces) and W for screen width
- +1 IF X=""
- QUIT $GET(T)
- +2 NEW HW
- +3 SET W=$GET(W,79)
- SET HW=W\2
- +4 SET $EXTRACT(T,HW-($LENGTH(X)\2),HW-($LENGTH(X)\2)+$LENGTH(X))=X
- QUIT T
- OREF(X) NEW X1,X2
- SET X1=$PIECE(X,"(")_"("
- SET X2=$$OR2($PIECE(X,"(",2))
- IF X2=""
- QUIT X1
- QUIT X1_X2_","
- OR2(%) IF %=")"!(%=",")
- QUIT ""
- IF $LENGTH(%)=1
- QUIT %
- IF "),"[$EXTRACT(%,$LENGTH(%))
- SET %=$EXTRACT(%,1,$LENGTH(%)-1)
- QUIT %
- +1 ;
- BRM ;BROWSE MANAGER SCREEN
- +1 NEW DX,DY,X
- +2 SET DX=0
- SET DY=$PIECE(DDBSY,";")
- SET X=$$CTXT^DDBR("BROWSE SWITCH MANAGER",$JUSTIFY("",IOM+1),IOM)
- +3 XECUTE IOXY
- +4 ;rvon
- WRITE $PIECE(DDGLVID,DDGLDEL,6)
- +5 ;uon
- WRITE $PIECE(DDGLVID,DDGLDEL,4)
- +6 WRITE X
- +7 ;rvoff
- WRITE $PIECE(DDGLVID,DDGLDEL,10)
- +8 FOR DY=$PIECE(DDBSY,";",2):1:$PIECE(DDBSY,";",4)
- XECUTE IOXY
- WRITE $PIECE(DDGLCLR,DDGLDEL)
- +9 ;rvon
- WRITE $PIECE(DDGLVID,DDGLDEL,6)
- +10 ;uon
- WRITE $PIECE(DDGLVID,DDGLDEL,4)
- +11 WRITE X
- +12 ;rvoff
- WRITE $PIECE(DDGLVID,DDGLDEL,10)
- +13 WRITE @IOSTBM
- +14 SET DY=$PIECE(DDBSY,";",2)
- +15 XECUTE IOXY
- +16 QUIT
- +17 ;
- SFR(Y) NEW X
- +1 SET X(1)=""
- SET X(2)=$$CTXT^DDBR("<< SWITCH Function Restricted "_$GET(Y)_" >>","",IOM)
- +2 WRITE $$WS^DDBR1(.X),$CHAR(7)
- +3 READ X:3
- +4 QUIT
