BGPXBLM ; IHS/ADC/GTH - LIST MANAGER API'S ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
; Documentation APIs for XBLM Generic Display.
;
; This utility uses the Veterans Administration List Manager
; (VALM).
;
; APIs
;
; FILE^XBLM("Directory","File Name")
; Displays file indicated.
;
; SFILE^XBLM
; Selection of host file for display.
;
; VIEWR^XBLM("TAG^ROUTINE","Header")
; Displays printout of the routine. (non - FM, using IO)
;
; VIEWD^XBLM("Tag^Routine","Header")
; Displays printout of the routine. (FM - using EN1^DIP)
;
; DIQ^XBLM("DIC","DA")
; Displays EN1^DIQ for the DIC,DA.
;
; ARRAY^XBLM("array(","Header")
; Displays the array(..,n,0) (%RCR notation)
;
; >>GUI<<
;
; GUIR^XBLM("TAG^ROUTINE","root(")
; Returns the hard coded output in the array specified.
; "(" not required.
;
; GUID^XBLM("TAG^ROUTINE","root(")
; Returns the output of the FM routine specified in the
; array specified. Most often the call is "EN1^DIP".
;
; S XBGUI=1,XBY="root(" D entry_point^XBLM
; The entry points sense these two variables and will
; put the output into the array specified.
;
EN ;EP -- main entry point for XB DISPLAY
D EN^VALM("XB DISPLAY")
Q
;
HDR ;EP -- header code
I XBHDR]"" S VALMHDR(1)=XBHDR
Q
;
INIT ;EP -- init variables and list array
MARKERS ;
I $G(XBLMMARK) F I=10:10 Q:'$D(@VALMAR@(I)) D
. F J=10:10:80 D CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
.Q
KILL XBLMMARK
S VALMCNT=$O(^TMP("XBLM",$J,XBNODE,""),-1)
Q
;
HELP ;EP -- help code
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ;EP -- exit code
KILL ^TMP("XBLM",$J,XBNODE)
K ;
KILL XBAR,XBDIR,XBFL,XBFN,XBHDR,XBI,XBROU,XBDIR
I '$G(XQORS) D CLEAR^VALM1
K IOPAR,IOUPAR
Q
;
EXPND ;EP -- expand code
Q
;
FILE(XBDIR,XBFN) ;PEP - pull up a file into the TMP global for display
; or into an array for GUI (see GUIR and GUID entry points)
I '$D(XBHDR) S XBHDR=""
NEW Y,X,I,XBNODE
S XBNODE=$G(XQORS)+1
;S Y=$$OPEN^%ZISH(XBDIR,XBFN,"M")
;open hfs with zis
D DF^%ZISH(.XBDIR)
;
; IHS/ADC/GTH XB*3*5 start of open HF change
KILL %ZIS
I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
D ^%ZIS
I POP W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'." S Y=$$DIR^XBDIR("E") G EFILE
KILL ^TMP("XBLM",$J,XBNODE)
; F I=1:1 U IO R X:DTIME S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8
F I=1:1 U IO R X S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
;F I=1:1 U IO R X S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
D ^%ZISC
; IHS/ADC/GTH XB*3*5 END of open HF change
;
I $G(XBGUI) D KILL ^TMP("XBLM",$J,XBNODE) Q
. S I=0
. S XBY=$$OPENROOT(XBY)
. F S I=$O(^TMP("XBLM",$J,XBNODE,I)) Q:'+I S XBZ=XBY_"I)",@XBZ=^TMP("XBLM",$J,XBNODE,I,0)
.Q
D EN^BGPXBLM
KILL ^TMP("XBLM",$J,XBNODE)
EFILE ;
Q
;
SFILE ;PEP - Select a host file for display.
OPEN ;
S IOP="HOME"
D ^%ZIS,DT^DICRW,^XBCLS
W !!,"Select a Directory and File",!!
S Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
KILL DIR
S DIR(0)="F^1:30",DIR("A")="Directory ",DIR("B")=XBDIR
K XBDIR
D ^DIR
KILL DIR
Q:$G(DTOUT)
Q:Y["^"
S XBDIR=Y
FNAME ;PEP - Select a file (directory can be pre-loaded into XBDIR)
KILL DIR
FNAME1 ;
S DIR(0)="FO^1:15",DIR("A")="File Name "
D ^DIR
KILL DIR
Q:$G(DTOUT)
G:Y["^" OPEN
G:Y="" OPEN
I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
I Y["*" K XBFL S X=$$LIST^%ZISH(XBDIR,Y,.XBFL) D G FNAME
. F XBI=1:1 Q:'$D(XBFL(XBI)) W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME
.Q
S XBFN=Y
;S X=$$OPEN^%ZISH(XBDIR,XBFN,"M")
;open hfs with zis
D DF^%ZISH(.XBDIR)
;
; IHS/ADC/GTH XB*3*5 start of open HF change
KILL %ZIS
I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
D ^%ZIS
ES ;
I POP W !,"error on open of file ",XBDIR,XBFN,! S Y=$$DIR^XBDIR("E") Q:Y=1 G FNAME
D ^%ZISC
D FILE^BGPXBLM(XBDIR,XBFN)
K XBFN
ESFILE ;
G FNAME
Q
;
VIEWR(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
I '$D(XBHDR) S XBHDR=""
I +$G(IO(0)) U IO(0) D:'$G(XBGUI) WAIT^DICD
S Y=$$PWD^%ZISH(.XBDIR)
S XBDIR=XBDIR(1),XBFN="XB"_$J
;open hfs with zis
D DF^%ZISH(.XBDIR)
K %ZIS
S XBIOM=IOM
I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
S IOP="XBLM HF DEVICE;"_IOM_";6000"
S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
D ^%ZIS
U IO
K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
D @XBROU
D ^%ZISC,HOME^%ZIS
D FILE^BGPXBLM(XBDIR,XBFN)
S X=$$DEL^%ZISH(XBDIR,XBFN)
S IOM=XBIOM
KILL XBDIR,XBFN,XBHDR,XBNODE,XBDIR,XBFN,XBIOM
; IHS/ADC/GTH XB*3*5 END of open HF change
;
Q
;
GUIR(XBROU,XBY) ;PEP - give routine and target array
Q:$L(XBY)=0
;
S XBGUI=1
D VIEWR^BGPXBLM(XBROU,"")
KILL XBGUI,XBY
Q
;
GUID(XBROU,XBY) ;PEP give routine and target array for FM prints
Q:$L(XBY)=0
S:XBY["(" XBY=$P(XBY,"(")
S XBGUI=1
D VIEWD^BGPXBLM(XBROU,"")
KILL XBGUI,XBY
Q
;
VIEWD(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
S:'$D(XBHDR) XBHDR=""
I +$G(IO(0)) I '$G(XBGUI) U IO(0) D WAIT^DICD
S XBFN="XB"_$J,Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
;S X=$$OPEN^%ZISH(XBDIR,XBFN,"W"),IOP=IO_";P-OTHER;"_IOM_";"_IOSL
;open hfs with zis
D DF^%ZISH(.XBDIR)
;
; IHS/ADC/GTH XB*3*5 start of open HF change
KILL %ZIS
S XBIOM=IOM
I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
S IOP="XBLM HF DEVICE;"_IOM_";6000"
S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
;D ^%ZIS ;XBROU must open device, XB*3*10, dmj
D @XBROU
K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
D ^%ZISC,HOME^%ZIS
D FILE^BGPXBLM(XBDIR,XBFN)
S X=$$DEL^%ZISH(XBDIR,XBFN)
S IOM=XBIOM
KILL XBDIR,XBFN,XBNODE,XBDIR,XBFN,XBIOM
; IHS/ADC/GTH XB*3*5 END of open HF change
;
Q
;
DIQ(DIC,DA) ;PEP - Display DIC and DA after call to EN^DIQ
S IOSTO=IOST,IOST="P-DEC",IOSLO=IOSL,IOSL=6000
I DIC=+DIC S DIC=$$DIC^XBDIQ1(DIC)
I DA'=+DA D PARSE^XBDIQ1(DA)
NEW DIQ,DR
S DIQ(0)="C"
D VIEWR^BGPXBLM("EN^DIQ")
S IOST=IOSTO
KILL IOSTO
S IOSL=IOSLO
KILL IOSLO,XBNODE,XBDIR,XBFN
Q
;
ARRAY(XBAR,XBHDR) ;PEP Display an array that has (...,n,0) structure
I '$D(XBHDR) S XBHDR=""
NEW Y,X,I,XBNODE
S XBNODE=$G(XQORS)+1
KILL ^TMP("XBLM",$J,XBNODE)
S %X=XBAR,%Y="^TMP(""XBLM"","_$J_","_XBNODE_","
D %XY^%RCR,EN^XBLM
KILL ^TMP("XBLM",$J,XBNODE),XBNODE,XBDIR,XBFN
ARRAYE ;
Q
;
STRIP(Z) ;REMOVE CONTROLL CHARACTERS
NEW I
F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
Q Z
;
OPENROOT(XBY) ;EP - return OPen RooT form of XBY .. for %RCR use
NEW L
S L=$L(XBY)
I XBY["(",$E(XBY,L)="," G CONT
I XBY'["(" S XBY=XBY_"(" G CONT
I XBY["(",$E(XBY,L)=")" S XBY=$E(XBY,1,L-1)_"," G CONT
CONT ;
Q XBY
;
BGPXBLM ; IHS/ADC/GTH - LIST MANAGER API'S ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ; Documentation APIs for XBLM Generic Display.
+4 ;
+5 ; This utility uses the Veterans Administration List Manager
+6 ; (VALM).
+7 ;
+8 ; APIs
+9 ;
+10 ; FILE^XBLM("Directory","File Name")
+11 ; Displays file indicated.
+12 ;
+13 ; SFILE^XBLM
+14 ; Selection of host file for display.
+15 ;
+16 ; VIEWR^XBLM("TAG^ROUTINE","Header")
+17 ; Displays printout of the routine. (non - FM, using IO)
+18 ;
+19 ; VIEWD^XBLM("Tag^Routine","Header")
+20 ; Displays printout of the routine. (FM - using EN1^DIP)
+21 ;
+22 ; DIQ^XBLM("DIC","DA")
+23 ; Displays EN1^DIQ for the DIC,DA.
+24 ;
+25 ; ARRAY^XBLM("array(","Header")
+26 ; Displays the array(..,n,0) (%RCR notation)
+27 ;
+28 ; >>GUI<<
+29 ;
+30 ; GUIR^XBLM("TAG^ROUTINE","root(")
+31 ; Returns the hard coded output in the array specified.
+32 ; "(" not required.
+33 ;
+34 ; GUID^XBLM("TAG^ROUTINE","root(")
+35 ; Returns the output of the FM routine specified in the
+36 ; array specified. Most often the call is "EN1^DIP".
+37 ;
+38 ; S XBGUI=1,XBY="root(" D entry_point^XBLM
+39 ; The entry points sense these two variables and will
+40 ; put the output into the array specified.
+41 ;
EN ;EP -- main entry point for XB DISPLAY
+1 DO EN^VALM("XB DISPLAY")
+2 QUIT
+3 ;
HDR ;EP -- header code
+1 IF XBHDR]""
SET VALMHDR(1)=XBHDR
+2 QUIT
+3 ;
INIT ;EP -- init variables and list array
MARKERS ;
+1 IF $GET(XBLMMARK)
FOR I=10:10
IF '$DATA(@VALMAR@(I))
QUIT
Begin DoDot:1
+2 FOR J=10:10:80
DO CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
+3 QUIT
End DoDot:1
+4 KILL XBLMMARK
+5 SET VALMCNT=$ORDER(^TMP("XBLM",$JOB,XBNODE,""),-1)
+6 QUIT
+7 ;
HELP ;EP -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 WRITE !!
+4 QUIT
+5 ;
EXIT ;EP -- exit code
+1 KILL ^TMP("XBLM",$JOB,XBNODE)
K ;
+1 KILL XBAR,XBDIR,XBFL,XBFN,XBHDR,XBI,XBROU,XBDIR
+2 IF '$GET(XQORS)
DO CLEAR^VALM1
+3 KILL IOPAR,IOUPAR
+4 QUIT
+5 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ;
FILE(XBDIR,XBFN) ;PEP - pull up a file into the TMP global for display
+1 ; or into an array for GUI (see GUIR and GUID entry points)
+2 IF '$DATA(XBHDR)
SET XBHDR=""
+3 NEW Y,X,I,XBNODE
+4 SET XBNODE=$GET(XQORS)+1
+5 ;S Y=$$OPEN^%ZISH(XBDIR,XBFN,"M")
+6 ;open hfs with zis
+7 DO DF^%ZISH(.XBDIR)
+8 ;
+9 ; IHS/ADC/GTH XB*3*5 start of open HF change
+10 KILL %ZIS
+11 IF ('$DATA(^%ZIS(1,"B","XBLM HF DEVICE")))!('$DATA(^%ZIS(2,"B","P-XBLM")))
DO ^XBLMSET
+12 SET IOP="XBLM HF DEVICE"
SET %ZIS("HFSMODE")="R"
SET %ZIS("HFSNAME")=XBDIR_XBFN
+13 DO ^%ZIS
+14 IF POP
WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'."
SET Y=$$DIR^XBDIR("E")
GOTO EFILE
+15 KILL ^TMP("XBLM",$JOB,XBNODE)
+16 ; F I=1:1 U IO R X:DTIME S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8
+17 ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
FOR I=1:1
USE IO
READ X
SET X=$$STRIP(X)
SET ^TMP("XBLM",$JOB,XBNODE,I,0)=X
IF $$STATUS^%ZISH
QUIT
+18 ;F I=1:1 U IO R X S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
+19 DO ^%ZISC
+20 ; IHS/ADC/GTH XB*3*5 END of open HF change
+21 ;
+22 IF $GET(XBGUI)
Begin DoDot:1
+23 SET I=0
+24 SET XBY=$$OPENROOT(XBY)
+25 FOR
SET I=$ORDER(^TMP("XBLM",$JOB,XBNODE,I))
IF '+I
QUIT
SET XBZ=XBY_"I)"
SET @XBZ=^TMP("XBLM",$JOB,XBNODE,I,0)
+26 QUIT
End DoDot:1
KILL ^TMP("XBLM",$JOB,XBNODE)
QUIT
+27 DO EN^BGPXBLM
+28 KILL ^TMP("XBLM",$JOB,XBNODE)
EFILE ;
+1 QUIT
+2 ;
SFILE ;PEP - Select a host file for display.
OPEN ;
+1 SET IOP="HOME"
+2 DO ^%ZIS
DO DT^DICRW
DO ^XBCLS
+3 WRITE !!,"Select a Directory and File",!!
+4 SET Y=$$PWD^%ZISH(.XBDIR)
SET XBDIR=XBDIR(1)
+5 KILL DIR
+6 SET DIR(0)="F^1:30"
SET DIR("A")="Directory "
SET DIR("B")=XBDIR
+7 KILL XBDIR
+8 DO ^DIR
+9 KILL DIR
+10 IF $GET(DTOUT)
QUIT
+11 IF Y["^"
QUIT
+12 SET XBDIR=Y
FNAME ;PEP - Select a file (directory can be pre-loaded into XBDIR)
+1 KILL DIR
FNAME1 ;
+1 SET DIR(0)="FO^1:15"
SET DIR("A")="File Name "
+2 DO ^DIR
+3 KILL DIR
+4 IF $GET(DTOUT)
QUIT
+5 IF Y["^"
GOTO OPEN
+6 IF Y=""
GOTO OPEN
+7 IF Y?.N
IF $DATA(XBFL(Y))
SET DIR("B")=XBFL(Y)
GOTO FNAME1
+8 IF Y["*"
KILL XBFL
SET X=$$LIST^%ZISH(XBDIR,Y,.XBFL)
Begin DoDot:1
+9 FOR XBI=1:1
IF '$DATA(XBFL(XBI))
QUIT
WRITE !?5,XBI,?10,XBFL(XBI)
IF '(XBI#20)
READ X:DTIME
+10 QUIT
End DoDot:1
GOTO FNAME
+11 SET XBFN=Y
+12 ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"M")
+13 ;open hfs with zis
+14 DO DF^%ZISH(.XBDIR)
+15 ;
+16 ; IHS/ADC/GTH XB*3*5 start of open HF change
+17 KILL %ZIS
+18 IF ('$DATA(^%ZIS(1,"B","XBLM HF DEVICE")))!('$DATA(^%ZIS(2,"B","P-XBLM")))
DO ^XBLMSET
+19 SET IOP="XBLM HF DEVICE"
SET %ZIS("HFSMODE")="R"
SET %ZIS("HFSNAME")=XBDIR_XBFN
+20 DO ^%ZIS
ES ;
+1 IF POP
WRITE !,"error on open of file ",XBDIR,XBFN,!
SET Y=$$DIR^XBDIR("E")
IF Y=1
QUIT
GOTO FNAME
+2 DO ^%ZISC
+3 DO FILE^BGPXBLM(XBDIR,XBFN)
+4 KILL XBFN
ESFILE ;
+1 GOTO FNAME
+2 QUIT
+3 ;
VIEWR(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
+1 IF '$DATA(XBHDR)
SET XBHDR=""
+2 IF +$GET(IO(0))
USE IO(0)
IF '$GET(XBGUI)
DO WAIT^DICD
+3 SET Y=$$PWD^%ZISH(.XBDIR)
+4 SET XBDIR=XBDIR(1)
SET XBFN="XB"_$JOB
+5 ;open hfs with zis
+6 DO DF^%ZISH(.XBDIR)
+7 KILL %ZIS
+8 SET XBIOM=IOM
+9 IF ('$DATA(^%ZIS(1,"B","XBLM HF DEVICE")))!('$DATA(^%ZIS(2,"B","P-XBLM")))
DO ^XBLMSET
+10 SET IOP="XBLM HF DEVICE;"_IOM_";6000"
+11 SET %ZIS("HFSMODE")="W"
SET %ZIS("HFSNAME")=XBDIR_XBFN
+12 DO ^%ZIS
+13 USE IO
+14 ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
KILL DX
+15 DO @XBROU
+16 DO ^%ZISC
DO HOME^%ZIS
+17 DO FILE^BGPXBLM(XBDIR,XBFN)
+18 SET X=$$DEL^%ZISH(XBDIR,XBFN)
+19 SET IOM=XBIOM
+20 KILL XBDIR,XBFN,XBHDR,XBNODE,XBDIR,XBFN,XBIOM
+21 ; IHS/ADC/GTH XB*3*5 END of open HF change
+22 ;
+23 QUIT
+24 ;
GUIR(XBROU,XBY) ;PEP - give routine and target array
+1 IF $LENGTH(XBY)=0
QUIT
+2 ;
+3 SET XBGUI=1
+4 DO VIEWR^BGPXBLM(XBROU,"")
+5 KILL XBGUI,XBY
+6 QUIT
+7 ;
GUID(XBROU,XBY) ;PEP give routine and target array for FM prints
+1 IF $LENGTH(XBY)=0
QUIT
+2 IF XBY["("
SET XBY=$PIECE(XBY,"(")
+3 SET XBGUI=1
+4 DO VIEWD^BGPXBLM(XBROU,"")
+5 KILL XBGUI,XBY
+6 QUIT
+7 ;
VIEWD(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
+1 IF '$DATA(XBHDR)
SET XBHDR=""
+2 IF +$GET(IO(0))
IF '$GET(XBGUI)
USE IO(0)
DO WAIT^DICD
+3 SET XBFN="XB"_$JOB
SET Y=$$PWD^%ZISH(.XBDIR)
SET XBDIR=XBDIR(1)
+4 ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"W"),IOP=IO_";P-OTHER;"_IOM_";"_IOSL
+5 ;open hfs with zis
+6 DO DF^%ZISH(.XBDIR)
+7 ;
+8 ; IHS/ADC/GTH XB*3*5 start of open HF change
+9 KILL %ZIS
+10 SET XBIOM=IOM
+11 IF ('$DATA(^%ZIS(1,"B","XBLM HF DEVICE")))!('$DATA(^%ZIS(2,"B","P-XBLM")))
DO ^XBLMSET
+12 SET IOP="XBLM HF DEVICE;"_IOM_";6000"
+13 SET %ZIS("HFSMODE")="W"
SET %ZIS("HFSNAME")=XBDIR_XBFN
+14 ;D ^%ZIS ;XBROU must open device, XB*3*10, dmj
+15 DO @XBROU
+16 ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
KILL DX
+17 DO ^%ZISC
DO HOME^%ZIS
+18 DO FILE^BGPXBLM(XBDIR,XBFN)
+19 SET X=$$DEL^%ZISH(XBDIR,XBFN)
+20 SET IOM=XBIOM
+21 KILL XBDIR,XBFN,XBNODE,XBDIR,XBFN,XBIOM
+22 ; IHS/ADC/GTH XB*3*5 END of open HF change
+23 ;
+24 QUIT
+25 ;
DIQ(DIC,DA) ;PEP - Display DIC and DA after call to EN^DIQ
+1 SET IOSTO=IOST
SET IOST="P-DEC"
SET IOSLO=IOSL
SET IOSL=6000
+2 IF DIC=+DIC
SET DIC=$$DIC^XBDIQ1(DIC)
+3 IF DA'=+DA
DO PARSE^XBDIQ1(DA)
+4 NEW DIQ,DR
+5 SET DIQ(0)="C"
+6 DO VIEWR^BGPXBLM("EN^DIQ")
+7 SET IOST=IOSTO
+8 KILL IOSTO
+9 SET IOSL=IOSLO
+10 KILL IOSLO,XBNODE,XBDIR,XBFN
+11 QUIT
+12 ;
ARRAY(XBAR,XBHDR) ;PEP Display an array that has (...,n,0) structure
+1 IF '$DATA(XBHDR)
SET XBHDR=""
+2 NEW Y,X,I,XBNODE
+3 SET XBNODE=$GET(XQORS)+1
+4 KILL ^TMP("XBLM",$JOB,XBNODE)
+5 SET %X=XBAR
SET %Y="^TMP(""XBLM"","_$JOB_","_XBNODE_","
+6 DO %XY^%RCR
DO EN^XBLM
+7 KILL ^TMP("XBLM",$JOB,XBNODE),XBNODE,XBDIR,XBFN
ARRAYE ;
+1 QUIT
+2 ;
STRIP(Z) ;REMOVE CONTROLL CHARACTERS
+1 NEW I
+2 FOR I=1:1:$LENGTH(Z)
IF (32>$ASCII($EXTRACT(Z,I)))
SET Z=$EXTRACT(Z,1,I-1)_" "_$EXTRACT(Z,I+1,999)
+3 QUIT Z
+4 ;
OPENROOT(XBY) ;EP - return OPen RooT form of XBY .. for %RCR use
+1 NEW L
+2 SET L=$LENGTH(XBY)
+3 IF XBY["("
IF $EXTRACT(XBY,L)=","
GOTO CONT
+4 IF XBY'["("
SET XBY=XBY_"("
GOTO CONT
+5 IF XBY["("
IF $EXTRACT(XBY,L)=")"
SET XBY=$EXTRACT(XBY,1,L-1)_","
GOTO CONT
CONT ;
+1 QUIT XBY
+2 ;
