- IBDF2A1 ;ALB/CJM - ENCOUNTER FORM (IBDF2A continued);NOV 16,1992
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- DEVSETUP(IBFORM,IBDEVICE) ;set up the device for the form
- ;pass IBFORM, IBDEVICE by reference
- ;sets device to no wrap
- ;sets "ROW_HT" and "COL_WIDTH" in IBDEVICE
- ;
- S X=0 X $G(^%ZOSF("RM")) K X ;sets device to no wrapping
- ;
- I $G(IBDEVICE("PCL")) D
- .S IOSL=IBFORM("PAGE_HT")
- .W $C(27),"E"
- .I $G(IBDEVICE("RESET"))'="" W @IBDEVICE("RESET")
- .S IOINHI=$C(27)_"(s3B",IOINORM=$C(27)_"(s0B"
- .S IBDEVICE("DUPLEX_SHORT")=$C(27)_"&l2S",IBDEVICE("SIMPLEX")=$C(27)_"&l0S",IBDEVICE("DUPLEX_LONG")=$C(27)_"&l1S"
- .S IORVON=$C(27)_"*v0n1o1T",IORVOFF=$C(27)_"*v0T"
- .S IOXY="W $C(27)_""&a""_DX_""c""_DY_""R"""
- .;set to paper to letter size, portrait mode
- .W $C(27),"&l2a0O"
- .D
- ..I IBFORM("WIDTH")>96 W $C(27)_"(s0p16.67h8.5v0s0b0T" S IBDEVICE("COL_WIDTH")=720/16.67,(IOINHI,IOINORM)="" Q
- ..I IBFORM("WIDTH")>80 W $C(27)_"(s0p12h10v0s0b0T" S IBDEVICE("COL_WIDTH")=720/12 Q
- ..W $C(27)_"(s0p10h12v0s0b0T" S IBDEVICE("COL_WIDTH")=720/10
- .D
- ..;!!!!!!!!!!Make the VMI a bit bigger? Seems to look good at VMI=6, and getting too cramped
- ..;!!!!!!I IBFORM("PAGE_HT")>72 W $C(27),"&l5.6667C" S IBDEVICE("ROW_HT")=85.0005 Q ;sets the VMI=5.6667, to get 8 lines per inch Q
- ..I IBFORM("PAGE_HT")>72 W $C(27),"&l6C" S IBDEVICE("ROW_HT")=90 Q ;sets the VMI=5.6667, to get 8 lines per inch Q
- ..I IBFORM("PAGE_HT")>60 W $C(27),"&l6.6667C" S IBDEVICE("ROW_HT")=100.0005 Q ;sets the VMI=6.6667, to get 7.2 lines per inch
- ..W $C(27),"&l8C" S IBDEVICE("ROW_HT")=120 ;sets the VMI=8, to get 6 lines per inch
- ;
- I '$G(IBDEVICE("PCL")) D
- .S (DX,DY)=0 X $G(^%ZOSF("XY")) K DX,DY ;make sure $X,$Y=0
- Q
- ;
- DRWBLOCK(IBBLK,NOOFFSET) ;IBBLK should be passed by reference, is an array containing the block description
- ;NOOFFSET=1 means don't offset the block on the form
- ;
- N IBFIELD,IBLIST,IBLINE,IBTEXT,IBWRTCNT,HDROS,BOX,OPTIONS,WIDTH,SUB,NODE,STRING,IBLINES,TYPE
- ;
- ;IBPRINT parameters may be altered durring this routine - make sure the original is restored after execution
- D SAVE^IBDF2A2(.IBPRINT,.IBPRINT)
- ;
- Q:$$BLKDESCR^IBDFU1B(.IBBLK)
- I $G(NOOFFSET) S (IBBLK("X"),IBBLK("Y"))=0
- I (IBBLK("X")'=+IBBLK("X"))!(IBBLK("Y")'=+IBBLK("Y")) G EXIT ;location not known
- ;
- I 'IBPRINT("COMPILING_BLOCKS"),('$D(^IBE(357.1,IBBLK,"S"))!'$D(^IBE(357.1,IBBLK,"V"))!'$D(^IBE(357.1,IBBLK,"B"))!'$D(^IBE(357.1,IBBLK,"H"))) S IBPRINT("COMPILING_BLOCKS")=1,IBPRINT("WRITE_IF_COMPILING")=1
- I IBPRINT("COMPILING_BLOCKS") S (IBWRTCNT("S"),IBWRTCNT("V"),IBWRTCNT("B"),IBWRTCNT("H"))=0 D UNCMPBLK^IBDF19(IBBLK)
- I 'IBPRINT("COMPILING_BLOCKS") D WCMP^IBDF2A2
- I IBPRINT("COMPILING_BLOCKS") D G:'IBPRINT("WRITE_IF_COMPILING") EXIT
- .N TEMP S TEMP=IBPRINT("WITH_DATA"),IBPRINT("WITH_DATA")=0
- .S IBLIST="" F S IBLIST=$O(^IBE(357.2,"C",IBBLK,IBLIST)) Q:'IBLIST D PRINTLST^IBDF2D(IBLIST)
- .S IBFIELD="" F S IBFIELD=$O(^IBE(357.93,"C",IBBLK,IBFIELD)) Q:'IBFIELD D MFLD^IBDF2G(IBFIELD)
- .S IBFIELD="" F S IBFIELD=$O(^IBE(359.94,"C",IBBLK,IBFIELD)) Q:'IBFIELD D HFLD^IBDF2H(IBFIELD)
- .S ^IBE(357.1,IBBLK,"S",0)="^357.11A^"_IBWRTCNT("S")_"^"_IBWRTCNT("S")
- .S ^IBE(357.1,IBBLK,"V",0)="^357.12A^"_IBWRTCNT("V")_"^"_IBWRTCNT("V")
- .S ^IBE(357.1,IBBLK,"B",0)="^357.13A^"_IBWRTCNT("B")_"^"_IBWRTCNT("B")
- .S ^IBE(357.1,IBBLK,"H",0)="^357.14A^"_IBWRTCNT("H")_"^"_IBWRTCNT("H")
- .S IBPRINT("WITH_DATA")=TEMP
- ;
- ;now write the uncompiled part of the block
- S IBPRINT("COMPILING_BLOCKS")=0
- K IBWRTCNT
- I IBDEVICE("LISTMAN") N IBWARN S IBWARN=0 ;flag set to 1 if a warning is already displayed - don't want to display multiple warnings, users find it aggravating
- S BOX=$S(IBBLK("BOX")=1:1,1:0)
- D:BOX DRWBOX^IBDFU(0,0,IBBLK("W"),IBBLK("H"))
- I IBBLK("HDR")'="" D
- .S HDROS=0
- .S WIDTH=IBBLK("W")-(2*BOX)
- .S OPTIONS=$TR(IBBLK("HDISP"),"C","")
- .S OPTIONS=$TR(OPTIONS,"R","r")
- .I IBBLK("HDISP")["C",$L(IBBLK("HDR"))<WIDTH S HDROS=(WIDTH-$L(IBBLK("HDR")))\2
- .I BOX D DRWSTR^IBDFU(1,1,$J("",HDROS)_$E(IBBLK("HDR"),1,WIDTH),OPTIONS,WIDTH)
- .I 'BOX D DRWSTR^IBDFU(0,0+HDROS,$E(IBBLK("HDR"),1,WIDTH),OPTIONS)
- S IBLINE="" F S IBLINE=$O(^IBE(357.7,"C",IBBLK,IBLINE)) Q:'IBLINE D PRNTLINE^IBDF2E(IBLINE)
- S IBTEXT="" F S IBTEXT=$O(^IBE(357.8,"C",IBBLK,IBTEXT)) Q:'IBTEXT D PRNTTEXT^IBDF2E(IBTEXT)
- S IBFIELD="" F S IBFIELD=$O(^IBE(357.5,"C",IBBLK,IBFIELD)) Q:'IBFIELD D DATAFLD^IBDF2B(IBFIELD)
- I IBPRINT("WITH_DATA") S IBPRINT("ENTIRE")=0,IBLIST="" F S IBLIST=$O(^IBE(357.2,"AD",IBBLK,IBLIST)) Q:'IBLIST D PRINTLST^IBDF2D(IBLIST)
- ;
- ;NOTE: bubbles & hand print fields have been written to file, but not to the array for list processor
- ;
- G:'IBDEVICE("LISTMAN") EXIT
- S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"B",SUB)) Q:'SUB S NODE=$G(^IBE(357.1,IBBLK,"B",SUB,0)) D DRWSTR^IBDFU(+$P(NODE,"^")\1,+$P(NODE,"^",2),"[ ]")
- S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"H",SUB)) Q:'SUB S NODE=$G(^IBE(357.1,IBBLK,"H",SUB,0)) S TYPE=$P(NODE,"^",14),WIDTH=+$P(NODE,"^",3) I TYPE,WIDTH D
- .N UNIT,PRINT,REPLACE,A,I,TYPENODE
- .S IBLINES=$P(NODE,"^",6) S:IBLINES'>0 IBLINES=1
- .S STRING="",ROW=+NODE
- .;
- .;replace the hand print fields - overlay with print format and label for units
- .;TYPE=2 means use ICR, may have a print format and datatype
- .I TYPE=2 D
- ..S TYPENODE=$P(NODE,"^",17) I TYPENODE S TYPENODE=$G(^IBE(359.1,TYPENODE,0))
- ..S UNIT=$P(TYPENODE,"^",11),PRINT=$P(TYPENODE,"^",5)
- ..F Q:IBLINES'>0 D S IBLINES=IBLINES-1,ROW=ROW+2
- ...I IBFORM("WIDTH")>96 S $P(STRING,"___|",WIDTH+1)="",REPLACE("_")=" " F I=1:1:$L(PRINT) S A=$E(PRINT,I) S:A'="_" REPLACE(A)=" "_A_" "
- ...I IBFORM("WIDTH")'>96 S $P(STRING,"__|",WIDTH+1)="",REPLACE("_")=" " F I=1:1:$L(PRINT) S A=$E(PRINT,I) S:A'="_" REPLACE(A)=" "_A_" "
- ...S:$L(UNIT) STRING=STRING_" "_UNIT
- ...I $L(PRINT) S PRINT=$$REPLACE^XLFSTR(PRINT,.REPLACE)
- ...D DRWSTR^IBDFU(ROW,+$P(NODE,"^",2),PRINT,"R",$L(STRING))
- ...D DRWSTR^IBDFU(ROW+1,+$P(NODE,"^",2),STRING,"R",$L(STRING))
- .;
- .I TYPE=1 D CNVRTLEN^IBDF2D1(WIDTH,.WIDTH),CNVRTHT^IBDF2D1(IBLINES,.IBLINES) F Q:IBLINES'>0 D S IBLINES=IBLINES-1,ROW=ROW+1
- ..D DRWSTR^IBDFU(ROW,+$P(NODE,"^",2),"","R",WIDTH)
- ;
- EXIT ;
- D RESTORE^IBDF2A2(.IBPRINT,.IBPRINT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF2A1 6260 printed Apr 23, 2025@19:05:40 Page 2
- IBDF2A1 ;ALB/CJM - ENCOUNTER FORM (IBDF2A continued);NOV 16,1992
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- DEVSETUP(IBFORM,IBDEVICE) ;set up the device for the form
- +1 ;pass IBFORM, IBDEVICE by reference
- +2 ;sets device to no wrap
- +3 ;sets "ROW_HT" and "COL_WIDTH" in IBDEVICE
- +4 ;
- +5 ;sets device to no wrapping
- SET X=0
- XECUTE $GET(^%ZOSF("RM"))
- KILL X
- +6 ;
- +7 IF $GET(IBDEVICE("PCL"))
- Begin DoDot:1
- +8 SET IOSL=IBFORM("PAGE_HT")
- +9 WRITE $CHAR(27),"E"
- +10 IF $GET(IBDEVICE("RESET"))'=""
- WRITE @IBDEVICE("RESET")
- +11 SET IOINHI=$CHAR(27)_"(s3B"
- SET IOINORM=$CHAR(27)_"(s0B"
- +12 SET IBDEVICE("DUPLEX_SHORT")=$CHAR(27)_"&l2S"
- SET IBDEVICE("SIMPLEX")=$CHAR(27)_"&l0S"
- SET IBDEVICE("DUPLEX_LONG")=$CHAR(27)_"&l1S"
- +13 SET IORVON=$CHAR(27)_"*v0n1o1T"
- SET IORVOFF=$CHAR(27)_"*v0T"
- +14 SET IOXY="W $C(27)_""&a""_DX_""c""_DY_""R"""
- +15 ;set to paper to letter size, portrait mode
- +16 WRITE $CHAR(27),"&l2a0O"
- +17 Begin DoDot:2
- +18 IF IBFORM("WIDTH")>96
- WRITE $CHAR(27)_"(s0p16.67h8.5v0s0b0T"
- SET IBDEVICE("COL_WIDTH")=720/16.67
- SET (IOINHI,IOINORM)=""
- QUIT
- +19 IF IBFORM("WIDTH")>80
- WRITE $CHAR(27)_"(s0p12h10v0s0b0T"
- SET IBDEVICE("COL_WIDTH")=720/12
- QUIT
- +20 WRITE $CHAR(27)_"(s0p10h12v0s0b0T"
- SET IBDEVICE("COL_WIDTH")=720/10
- End DoDot:2
- +21 Begin DoDot:2
- +22 ;!!!!!!!!!!Make the VMI a bit bigger? Seems to look good at VMI=6, and getting too cramped
- +23 ;!!!!!!I IBFORM("PAGE_HT")>72 W $C(27),"&l5.6667C" S IBDEVICE("ROW_HT")=85.0005 Q ;sets the VMI=5.6667, to get 8 lines per inch Q
- +24 ;sets the VMI=5.6667, to get 8 lines per inch Q
- IF IBFORM("PAGE_HT")>72
- WRITE $CHAR(27),"&l6C"
- SET IBDEVICE("ROW_HT")=90
- QUIT
- +25 ;sets the VMI=6.6667, to get 7.2 lines per inch
- IF IBFORM("PAGE_HT")>60
- WRITE $CHAR(27),"&l6.6667C"
- SET IBDEVICE("ROW_HT")=100.0005
- QUIT
- +26 ;sets the VMI=8, to get 6 lines per inch
- WRITE $CHAR(27),"&l8C"
- SET IBDEVICE("ROW_HT")=120
- End DoDot:2
- End DoDot:1
- +27 ;
- +28 IF '$GET(IBDEVICE("PCL"))
- Begin DoDot:1
- +29 ;make sure $X,$Y=0
- SET (DX,DY)=0
- XECUTE $GET(^%ZOSF("XY"))
- KILL DX,DY
- End DoDot:1
- +30 QUIT
- +31 ;
- DRWBLOCK(IBBLK,NOOFFSET) ;IBBLK should be passed by reference, is an array containing the block description
- +1 ;NOOFFSET=1 means don't offset the block on the form
- +2 ;
- +3 NEW IBFIELD,IBLIST,IBLINE,IBTEXT,IBWRTCNT,HDROS,BOX,OPTIONS,WIDTH,SUB,NODE,STRING,IBLINES,TYPE
- +4 ;
- +5 ;IBPRINT parameters may be altered durring this routine - make sure the original is restored after execution
- +6 DO SAVE^IBDF2A2(.IBPRINT,.IBPRINT)
- +7 ;
- +8 if $$BLKDESCR^IBDFU1B(.IBBLK)
- QUIT
- +9 IF $GET(NOOFFSET)
- SET (IBBLK("X"),IBBLK("Y"))=0
- +10 ;location not known
- IF (IBBLK("X")'=+IBBLK("X"))!(IBBLK("Y")'=+IBBLK("Y"))
- GOTO EXIT
- +11 ;
- +12 IF 'IBPRINT("COMPILING_BLOCKS")
- IF ('$DATA(^IBE(357.1,IBBLK,"S"))!'$DATA(^IBE(357.1,IBBLK,"V"))!'$DATA(^IBE(357.1,IBBLK,"B"))!'$DATA(^IBE(357.1,IBBLK,"H")))
- SET IBPRINT("COMPILING_BLOCKS")=1
- SET IBPRINT("WRITE_IF_COMPILING")=1
- +13 IF IBPRINT("COMPILING_BLOCKS")
- SET (IBWRTCNT("S"),IBWRTCNT("V"),IBWRTCNT("B"),IBWRTCNT("H"))=0
- DO UNCMPBLK^IBDF19(IBBLK)
- +14 IF 'IBPRINT("COMPILING_BLOCKS")
- DO WCMP^IBDF2A2
- +15 IF IBPRINT("COMPILING_BLOCKS")
- Begin DoDot:1
- +16 NEW TEMP
- SET TEMP=IBPRINT("WITH_DATA")
- SET IBPRINT("WITH_DATA")=0
- +17 SET IBLIST=""
- FOR
- SET IBLIST=$ORDER(^IBE(357.2,"C",IBBLK,IBLIST))
- if 'IBLIST
- QUIT
- DO PRINTLST^IBDF2D(IBLIST)
- +18 SET IBFIELD=""
- FOR
- SET IBFIELD=$ORDER(^IBE(357.93,"C",IBBLK,IBFIELD))
- if 'IBFIELD
- QUIT
- DO MFLD^IBDF2G(IBFIELD)
- +19 SET IBFIELD=""
- FOR
- SET IBFIELD=$ORDER(^IBE(359.94,"C",IBBLK,IBFIELD))
- if 'IBFIELD
- QUIT
- DO HFLD^IBDF2H(IBFIELD)
- +20 SET ^IBE(357.1,IBBLK,"S",0)="^357.11A^"_IBWRTCNT("S")_"^"_IBWRTCNT("S")
- +21 SET ^IBE(357.1,IBBLK,"V",0)="^357.12A^"_IBWRTCNT("V")_"^"_IBWRTCNT("V")
- +22 SET ^IBE(357.1,IBBLK,"B",0)="^357.13A^"_IBWRTCNT("B")_"^"_IBWRTCNT("B")
- +23 SET ^IBE(357.1,IBBLK,"H",0)="^357.14A^"_IBWRTCNT("H")_"^"_IBWRTCNT("H")
- +24 SET IBPRINT("WITH_DATA")=TEMP
- End DoDot:1
- if 'IBPRINT("WRITE_IF_COMPILING")
- GOTO EXIT
- +25 ;
- +26 ;now write the uncompiled part of the block
- +27 SET IBPRINT("COMPILING_BLOCKS")=0
- +28 KILL IBWRTCNT
- +29 ;flag set to 1 if a warning is already displayed - don't want to display multiple warnings, users find it aggravating
- IF IBDEVICE("LISTMAN")
- NEW IBWARN
- SET IBWARN=0
- +30 SET BOX=$SELECT(IBBLK("BOX")=1:1,1:0)
- +31 if BOX
- DO DRWBOX^IBDFU(0,0,IBBLK("W"),IBBLK("H"))
- +32 IF IBBLK("HDR")'=""
- Begin DoDot:1
- +33 SET HDROS=0
- +34 SET WIDTH=IBBLK("W")-(2*BOX)
- +35 SET OPTIONS=$TRANSLATE(IBBLK("HDISP"),"C","")
- +36 SET OPTIONS=$TRANSLATE(OPTIONS,"R","r")
- +37 IF IBBLK("HDISP")["C"
- IF $LENGTH(IBBLK("HDR"))<WIDTH
- SET HDROS=(WIDTH-$LENGTH(IBBLK("HDR")))\2
- +38 IF BOX
- DO DRWSTR^IBDFU(1,1,$JUSTIFY("",HDROS)_$EXTRACT(IBBLK("HDR"),1,WIDTH),OPTIONS,WIDTH)
- +39 IF 'BOX
- DO DRWSTR^IBDFU(0,0+HDROS,$EXTRACT(IBBLK("HDR"),1,WIDTH),OPTIONS)
- End DoDot:1
- +40 SET IBLINE=""
- FOR
- SET IBLINE=$ORDER(^IBE(357.7,"C",IBBLK,IBLINE))
- if 'IBLINE
- QUIT
- DO PRNTLINE^IBDF2E(IBLINE)
- +41 SET IBTEXT=""
- FOR
- SET IBTEXT=$ORDER(^IBE(357.8,"C",IBBLK,IBTEXT))
- if 'IBTEXT
- QUIT
- DO PRNTTEXT^IBDF2E(IBTEXT)
- +42 SET IBFIELD=""
- FOR
- SET IBFIELD=$ORDER(^IBE(357.5,"C",IBBLK,IBFIELD))
- if 'IBFIELD
- QUIT
- DO DATAFLD^IBDF2B(IBFIELD)
- +43 IF IBPRINT("WITH_DATA")
- SET IBPRINT("ENTIRE")=0
- SET IBLIST=""
- FOR
- SET IBLIST=$ORDER(^IBE(357.2,"AD",IBBLK,IBLIST))
- if 'IBLIST
- QUIT
- DO PRINTLST^IBDF2D(IBLIST)
- +44 ;
- +45 ;NOTE: bubbles & hand print fields have been written to file, but not to the array for list processor
- +46 ;
- +47 if 'IBDEVICE("LISTMAN")
- GOTO EXIT
- +48 SET SUB=0
- FOR
- SET SUB=$ORDER(^IBE(357.1,IBBLK,"B",SUB))
- if 'SUB
- QUIT
- SET NODE=$GET(^IBE(357.1,IBBLK,"B",SUB,0))
- DO DRWSTR^IBDFU(+$PIECE(NODE,"^")\1,+$PIECE(NODE,"^",2),"[ ]")
- +49 SET SUB=0
- FOR
- SET SUB=$ORDER(^IBE(357.1,IBBLK,"H",SUB))
- if 'SUB
- QUIT
- SET NODE=$GET(^IBE(357.1,IBBLK,"H",SUB,0))
- SET TYPE=$PIECE(NODE,"^",14)
- SET WIDTH=+$PIECE(NODE,"^",3)
- IF TYPE
- IF WIDTH
- Begin DoDot:1
- +50 NEW UNIT,PRINT,REPLACE,A,I,TYPENODE
- +51 SET IBLINES=$PIECE(NODE,"^",6)
- if IBLINES'>0
- SET IBLINES=1
- +52 SET STRING=""
- SET ROW=+NODE
- +53 ;
- +54 ;replace the hand print fields - overlay with print format and label for units
- +55 ;TYPE=2 means use ICR, may have a print format and datatype
- +56 IF TYPE=2
- Begin DoDot:2
- +57 SET TYPENODE=$PIECE(NODE,"^",17)
- IF TYPENODE
- SET TYPENODE=$GET(^IBE(359.1,TYPENODE,0))
- +58 SET UNIT=$PIECE(TYPENODE,"^",11)
- SET PRINT=$PIECE(TYPENODE,"^",5)
- +59 FOR
- if IBLINES'>0
- QUIT
- Begin DoDot:3
- +60 IF IBFORM("WIDTH")>96
- SET $PIECE(STRING,"___|",WIDTH+1)=""
- SET REPLACE("_")=" "
- FOR I=1:1:$LENGTH(PRINT)
- SET A=$EXTRACT(PRINT,I)
- if A'="_"
- SET REPLACE(A)=" "_A_" "
- +61 IF IBFORM("WIDTH")'>96
- SET $PIECE(STRING,"__|",WIDTH+1)=""
- SET REPLACE("_")=" "
- FOR I=1:1:$LENGTH(PRINT)
- SET A=$EXTRACT(PRINT,I)
- if A'="_"
- SET REPLACE(A)=" "_A_" "
- +62 if $LENGTH(UNIT)
- SET STRING=STRING_" "_UNIT
- +63 IF $LENGTH(PRINT)
- SET PRINT=$$REPLACE^XLFSTR(PRINT,.REPLACE)
- +64 DO DRWSTR^IBDFU(ROW,+$PIECE(NODE,"^",2),PRINT,"R",$LENGTH(STRING))
- +65 DO DRWSTR^IBDFU(ROW+1,+$PIECE(NODE,"^",2),STRING,"R",$LENGTH(STRING))
- End DoDot:3
- SET IBLINES=IBLINES-1
- SET ROW=ROW+2
- End DoDot:2
- +66 ;
- +67 IF TYPE=1
- DO CNVRTLEN^IBDF2D1(WIDTH,.WIDTH)
- DO CNVRTHT^IBDF2D1(IBLINES,.IBLINES)
- FOR
- if IBLINES'>0
- QUIT
- Begin DoDot:2
- +68 DO DRWSTR^IBDFU(ROW,+$PIECE(NODE,"^",2),"","R",WIDTH)
- End DoDot:2
- SET IBLINES=IBLINES-1
- SET ROW=ROW+1
- End DoDot:1
- +69 ;
- EXIT ;
- +1 DO RESTORE^IBDF2A2(.IBPRINT,.IBPRINT)
- +2 QUIT
