DDBRZIS ;SFISC/DCL-BROWSER DEVICE UTILITIES ;4:50 AM 9 Apr 2006
;;22.0;VA FileMan;**145,148**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
OPEN ;
;DDBRZIS AND DDBDMSG ARE KILLED IN POST
S DDBRZIS=1,DDBDMSG=$G(DDBDMSG)
U IO(0)
I $G(DDBDMSG)="" D Q:DDBDMSG="$$DTOUT$$"
.N DIR,X,Y
.S DIR(0)="FUO^0:78",DIR("A")="BROWSER TITLE (optional)"
.S DIR("B")="VA FileMan Browser"
.S DIR("?")="Enter any free text, which will appear in the Title Bar"
.D ^DIR
.I $G(DTOUT) S DDBDMSG="$$DTOUT$$" K DTOUT,DUOUT,DIRUT,DIROUT Q
.S DDBDMSG=$S(Y="":DDBDMSG,1:Y)
.Q
W !,"...one moment..."
U IO
Q:DDBDMSG]""
I $G(DHD)="W """" D ^DIDH" S DDBDMSG="DATA DICTIONARY" Q
S DDBDMSG="VA FileMan Browser"
Q
;
CLOSE ;
Q:$G(DDBDMSG)="$$DTOUT$$"
S DDBRZIS=$G(DDBRZIS,1)
N C,CHAR,DDBROS,EOF,X
K ^TMP("DDB",$J)
S DDBROS=^%ZOSF("OS"),EOF="EOF-End Of File"
S CHAR="" F I=1:1:31 S CHAR=CHAR_$C(I)
U IO W !,EOF,!
S DDBRZIS("REWIND")=$$REWIND^%ZIS(IO,IOT,IOPAR)
I 'DDBRZIS("REWIND") S DDBRZIS=0 U IO(0) W $C(7),!!?5,"<< UNABLE TO REWIND FILE>>",! H 3 Q
U IO
S C=0
F R X:2 Q:X="EOF-End Of File" D
.S X=$TR(X,CHAR)
.S:X']"" X=" "
.S C=C+1,^TMP("DDB",$J,C)=$E(X,1,255) Q
.Q
Q
;
POST ;
I $G(DDBDMSG)="$$DTOUT$$" K DDBDMSG,DDBRZIS W $C(7) Q
I $G(DDBRZIS) D BROWSE^DDBR("^TMP(""DDB"",$J)","NR",$G(DDBDMSG))
; *148* Moved to POST-CLOSE EXECUTE of BROWSER device
;I ^%ZOSF("OS")["OpenM",$G(IO("CLOSE"))]"" S DDBRZIS=$ZF(-1,"del "_ IO("CLOSE")_";*")
K DDBRZIS,DDBDMSG
Q
;
DEVICE(MSG) ;TEST IF BROWSER IS BEING INVOKED VIA DEVICE HANDLER
;EXTRINSIC FUNCTION
I $D(DDBRZIS)#2,$G(MSG)]"" S DDBDMSG=MSG Q 1
Q 0
;
MSG(TXT) ;PASS TEXT FOR BROWSER TITLE WHEN BROWSER INVOKED VIA DEVICE HANDLER
;PROCEDURE CALL
S DDBDMSG=$G(TXT)
Q
STR(X) ; Remove windows
N I,Y
I $L(X,"|")'>2 Q X
I X["|WRAP|"!(X["| NO WRAP|")!(X["|NOWRAP|") S Y="" F I=1:1:$L(X,"|") S:(I#2) Y=Y_$P(X,"|",I)
Q $S(X'["|":X,1:$G(Y))
DDBRZIS ;SFISC/DCL-BROWSER DEVICE UTILITIES ;4:50 AM 9 Apr 2006
+1 ;;22.0;VA FileMan;**145,148**;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
OPEN ;
+1 ;DDBRZIS AND DDBDMSG ARE KILLED IN POST
+2 SET DDBRZIS=1
SET DDBDMSG=$GET(DDBDMSG)
+3 USE IO(0)
+4 IF $GET(DDBDMSG)=""
Begin DoDot:1
+5 NEW DIR,X,Y
+6 SET DIR(0)="FUO^0:78"
SET DIR("A")="BROWSER TITLE (optional)"
+7 SET DIR("B")="VA FileMan Browser"
+8 SET DIR("?")="Enter any free text, which will appear in the Title Bar"
+9 DO ^DIR
+10 IF $GET(DTOUT)
SET DDBDMSG="$$DTOUT$$"
KILL DTOUT,DUOUT,DIRUT,DIROUT
QUIT
+11 SET DDBDMSG=$SELECT(Y="":DDBDMSG,1:Y)
+12 QUIT
End DoDot:1
IF DDBDMSG="$$DTOUT$$"
QUIT
+13 WRITE !,"...one moment..."
+14 USE IO
+15 IF DDBDMSG]""
QUIT
+16 IF $GET(DHD)="W """" D ^DIDH"
SET DDBDMSG="DATA DICTIONARY"
QUIT
+17 SET DDBDMSG="VA FileMan Browser"
+18 QUIT
+19 ;
CLOSE ;
+1 IF $GET(DDBDMSG)="$$DTOUT$$"
QUIT
+2 SET DDBRZIS=$GET(DDBRZIS,1)
+3 NEW C,CHAR,DDBROS,EOF,X
+4 KILL ^TMP("DDB",$JOB)
+5 SET DDBROS=^%ZOSF("OS")
SET EOF="EOF-End Of File"
+6 SET CHAR=""
FOR I=1:1:31
SET CHAR=CHAR_$CHAR(I)
+7 USE IO
WRITE !,EOF,!
+8 SET DDBRZIS("REWIND")=$$REWIND^%ZIS(IO,IOT,IOPAR)
+9 IF 'DDBRZIS("REWIND")
SET DDBRZIS=0
USE IO(0)
WRITE $CHAR(7),!!?5,"<< UNABLE TO REWIND FILE>>",!
HANG 3
QUIT
+10 USE IO
+11 SET C=0
+12 FOR
READ X:2
IF X="EOF-End Of File"
QUIT
Begin DoDot:1
+13 SET X=$TRANSLATE(X,CHAR)
+14 IF X']""
SET X=" "
+15 SET C=C+1
SET ^TMP("DDB",$JOB,C)=$EXTRACT(X,1,255)
QUIT
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
POST ;
+1 IF $GET(DDBDMSG)="$$DTOUT$$"
KILL DDBDMSG,DDBRZIS
WRITE $CHAR(7)
QUIT
+2 IF $GET(DDBRZIS)
DO BROWSE^DDBR("^TMP(""DDB"",$J)","NR",$GET(DDBDMSG))
+3 ; *148* Moved to POST-CLOSE EXECUTE of BROWSER device
+4 ;I ^%ZOSF("OS")["OpenM",$G(IO("CLOSE"))]"" S DDBRZIS=$ZF(-1,"del "_ IO("CLOSE")_";*")
+5 KILL DDBRZIS,DDBDMSG
+6 QUIT
+7 ;
DEVICE(MSG) ;TEST IF BROWSER IS BEING INVOKED VIA DEVICE HANDLER
+1 ;EXTRINSIC FUNCTION
+2 IF $DATA(DDBRZIS)#2
IF $GET(MSG)]""
SET DDBDMSG=MSG
QUIT 1
+3 QUIT 0
+4 ;
MSG(TXT) ;PASS TEXT FOR BROWSER TITLE WHEN BROWSER INVOKED VIA DEVICE HANDLER
+1 ;PROCEDURE CALL
+2 SET DDBDMSG=$GET(TXT)
+3 QUIT
STR(X) ; Remove windows
+1 NEW I,Y
+2 IF $LENGTH(X,"|")'>2
QUIT X
+3 IF X["|WRAP|"!(X["| NO WRAP|")!(X["|NOWRAP|")
SET Y=""
FOR I=1:1:$LENGTH(X,"|")
IF (I#2)
SET Y=Y_$PIECE(X,"|",I)
+4 QUIT $SELECT(X'["|":X,1:$GET(Y))
