BLRLM ; cmi/anch/maw - LIST MANAGER API'S ;
;;5.2;LR;**1021**;Jul 27, 2006
;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
;cmi/flag/maw modified from XBLM for Reference Lab Project
;
; Documentation APIs for BLRLM Generic Display.
;
; This utility uses the Veterans Administration List Manager
; (VALM).
;
; APIs
;
; FILE^BLRLM("Directory","File Name")
; Displays file indicated.
;
; SFILE^BLRLM
; Selection of host file for display.
;
; VIEWR^BLRLM("TAG^ROUTINE","Header")
; Displays printout of the routine. (non - FM, using IO)
;
; VIEWD^BLRLM("Tag^Routine","Header")
; Displays printout of the routine. (FM - using EN1^DIP)
;
; DIQ^BLRLM("DIC","DA")
; Displays EN1^DIQ for the DIC,DA.
;
; ARRAY^BLRLM("array(","Header")
; Displays the array(..,n,0) (%RCR notation)
;
; >>GUI<<
;
; GUIR^BLRLM("TAG^ROUTINE","root(")
; Returns the hard coded output in the array specified.
; "(" not required.
;
; GUID^BLRLM("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(BLRPROT) ;EP -- main entry point for BLR VERIFY RESULT DISPLAY
D EN^VALM(BLRPROT)
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:($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^BLRLM("BLR REFLAB VERIFY RESULT DISP")
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 ; EP - Select a file (directory can be pre-loaded into XBDIR)
KILL DIR
FNAME1 ; EP
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^XBLM(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^BLRLM(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^XBLM(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^XBLM(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
D @XBROU
K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
D ^%ZISC,HOME^%ZIS
D FILE^XBLM(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^BLRLM("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
;
BLRLM ; cmi/anch/maw - LIST MANAGER API'S ;
+1 ;;5.2;LR;**1021**;Jul 27, 2006
+2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
+3 ;cmi/flag/maw modified from XBLM for Reference Lab Project
+4 ;
+5 ; Documentation APIs for BLRLM Generic Display.
+6 ;
+7 ; This utility uses the Veterans Administration List Manager
+8 ; (VALM).
+9 ;
+10 ; APIs
+11 ;
+12 ; FILE^BLRLM("Directory","File Name")
+13 ; Displays file indicated.
+14 ;
+15 ; SFILE^BLRLM
+16 ; Selection of host file for display.
+17 ;
+18 ; VIEWR^BLRLM("TAG^ROUTINE","Header")
+19 ; Displays printout of the routine. (non - FM, using IO)
+20 ;
+21 ; VIEWD^BLRLM("Tag^Routine","Header")
+22 ; Displays printout of the routine. (FM - using EN1^DIP)
+23 ;
+24 ; DIQ^BLRLM("DIC","DA")
+25 ; Displays EN1^DIQ for the DIC,DA.
+26 ;
+27 ; ARRAY^BLRLM("array(","Header")
+28 ; Displays the array(..,n,0) (%RCR notation)
+29 ;
+30 ; >>GUI<<
+31 ;
+32 ; GUIR^BLRLM("TAG^ROUTINE","root(")
+33 ; Returns the hard coded output in the array specified.
+34 ; "(" not required.
+35 ;
+36 ; GUID^BLRLM("TAG^ROUTINE","root(")
+37 ; Returns the output of the FM routine specified in the
+38 ; array specified. Most often the call is "EN1^DIP".
+39 ;
+40 ; S XBGUI=1,XBY="root(" D entry_point^XBLM
+41 ; The entry points sense these two variables and will
+42 ; put the output into the array specified.
+43 ;
EN(BLRPROT) ;EP -- main entry point for BLR VERIFY RESULT DISPLAY
+1 DO EN^VALM(BLRPROT)
+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
IF ($LENGTH(X)>250)
SET X=$EXTRACT(X,1,250)
SET X=$$STRIP(X)
SET ^TMP("XBLM",$JOB,XBNODE,I,0)=X
IF $$STATUS^%ZISH
QUIT
+18 DO ^%ZISC
+19 ; IHS/ADC/GTH XB*3*5 END of open HF change
+20 ;
+21 IF $GET(XBGUI)
Begin DoDot:1
+22 SET I=0
+23 SET XBY=$$OPENROOT(XBY)
+24 FOR
SET I=$ORDER(^TMP("XBLM",$JOB,XBNODE,I))
IF '+I
QUIT
SET XBZ=XBY_"I)"
SET @XBZ=^TMP("XBLM",$JOB,XBNODE,I,0)
+25 QUIT
End DoDot:1
KILL ^TMP("XBLM",$JOB,XBNODE)
QUIT
+26 DO EN^BLRLM("BLR REFLAB VERIFY RESULT DISP")
+27 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 ; EP - Select a file (directory can be pre-loaded into XBDIR)
+1 KILL DIR
FNAME1 ; EP
+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^XBLM(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^BLRLM(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^XBLM(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^XBLM(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 DO ^%ZIS
+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^XBLM(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^BLRLM("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 ;
