IBCEQ2A ;ALB/TMK - PROVIDER/BILLING ID WORKSHEET SOLUTIONS ;18-AUG-04
;;2.0;INTEGRATED BILLING;**282**;21-MAR-94
;
WRTS(IBTYPE,IBOTYPE,IBTEXT,IBSTOP) ; Write the line
; IBTYPE = type of current line
; IBOTYPE = last type processed
; IBTEXT(n) = array containing previously extracted text for output
; IBTEXT = current line's text
; IBSTOP = returned as 1 if passed by ref and user chooses to abort
N Q,Q1,Q2,Z,IBHOLD,IBP
I IBTYPE=IBOTYPE S IBTEXT(+$O(IBTEXT(" "),-1)+1)=IBTEXT,IBTEXT="" Q
S IBHOLD=IBTEXT
I IBOTYPE="Q"!(IBOTYPE="A") D Q
. S Z="",IBTEXT(0)="",IBP=$S(IBOTYPE="A":">>>>",1:"")
. F Q=1:1:$O(IBTEXT(" "),-1) D Q:IBSTOP
.. I $L(IBTEXT(Q-1)) D Q:IBSTOP
... S Q1=$L(IBTEXT(Q-1))+$L(IBP)
... S Z=IBP_IBTEXT(Q-1)_$E(IBTEXT(Q),1,IOM-Q1)
... I $E(Z,$L(Z))=" "!($E(Z,$L(Z))?1P) D WRT(Z,.IBSTOP) Q:IBSTOP S IBP=$J("",4),IBTEXT(Q)=$E(IBTEXT(Q),IOM-Q1+1,$L(IBTEXT(Q))) S:$E(IBTEXT(Q))=" " $E(IBTEXT(Q))="" Q
... F Q2=$L(Z):-1:0 I $E(Z,Q2)=" "!($E(Z,Q2)?1P) D WRT($E(Z,1,Q2),.IBSTOP) Q:IBSTOP S IBTEXT(Q)=$E(Z,Q2+1,$L(Z))_$E(IBTEXT(Q),IOM-Q1+1,$L(IBTEXT(Q))),IBP=$J("",4) S:$E(IBTEXT(Q))=" " $E(IBTEXT(Q))="" Q
... I Q2=0 D WRT($E(Z,1,IOM),.IBSTOP) Q:IBSTOP S IBTEXT(Q)=$E(IBTEXT(Q),IOM+1,$L(IBTEXT(Q)))
.. Q:'$L(IBTEXT(Q))
.. F D Q:($L(IBTEXT(Q))+$L(IBP))<IOM!(IBSTOP)
... I ($L(IBTEXT(Q))+$L(IBP))'<IOM D Q
.... S Z=IBP_$E(IBTEXT(Q),1,IOM-$L(IBP))
.... I $E(Z,$L(Z))=" "!($E(Z,$L(Z))?1P)!($E(IBTEXT(Q),IOM-$L(IBP)+1)=" ") W !,Z S IBTEXT(Q)=$E(IBTEXT(Q),IOM-$L(IBP)+1,$L(IBTEXT(Q))) S IBP=$J("",4) S:$E(IBTEXT(Q))=" " $E(IBTEXT(Q))="" Q
.... F Q2=$L(Z):-1:0 I $E(Z,Q2)=" "!($E(Z,Q2)?1P) W !,$E(Z,1,Q2) S IBTEXT(Q)=$E(IBTEXT(Q),Q2-$L(IBP),$L(IBTEXT(Q))),IBP=$J("",4) S:$E(IBTEXT(Q))=" " $E(IBTEXT(Q))="" Q
. Q:IBSTOP
. I $L(IBTEXT(Q)) D WRT(IBP_IBTEXT(Q),.IBSTOP) Q:IBSTOP
. K IBTEXT S (IBTEXT,IBTEXT(1))=IBHOLD
;
S IBTEXT(1)=IBHOLD
Q
;
HDR1(IBPG,IBSTOP) ; output solutions header
N X
I IBPG D ASK^IBCEQ2(.IBSTOP) Q:IBSTOP W @IOF
S IBPG=IBPG+1
W !,?(IOM-48\2),"INSURANCE COMPANY PROVIDER ID WORKSHEET SOLUTIONS" W ?(70+$S(IOM<132:0,1:52)),"PAGE: ",IBPG
S X="",$P(X,"-",IOM+1)=""
W !,X,!
Q
;
WRT(DATA,IBSTOP) ; Write data, new header if needed
; DATA = text to print
; IBSTOP = returned as 1 if passed by ref for user print abort
I ($Y+5)>IOSL D HDR1(.IBPG,.IBSTOP)
I 'IBSTOP W !,DATA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEQ2A 2394 printed Oct 16, 2024@18:12:53 Page 2
IBCEQ2A ;ALB/TMK - PROVIDER/BILLING ID WORKSHEET SOLUTIONS ;18-AUG-04
+1 ;;2.0;INTEGRATED BILLING;**282**;21-MAR-94
+2 ;
WRTS(IBTYPE,IBOTYPE,IBTEXT,IBSTOP) ; Write the line
+1 ; IBTYPE = type of current line
+2 ; IBOTYPE = last type processed
+3 ; IBTEXT(n) = array containing previously extracted text for output
+4 ; IBTEXT = current line's text
+5 ; IBSTOP = returned as 1 if passed by ref and user chooses to abort
+6 NEW Q,Q1,Q2,Z,IBHOLD,IBP
+7 IF IBTYPE=IBOTYPE
SET IBTEXT(+$ORDER(IBTEXT(" "),-1)+1)=IBTEXT
SET IBTEXT=""
QUIT
+8 SET IBHOLD=IBTEXT
+9 IF IBOTYPE="Q"!(IBOTYPE="A")
Begin DoDot:1
+10 SET Z=""
SET IBTEXT(0)=""
SET IBP=$SELECT(IBOTYPE="A":">>>>",1:"")
+11 FOR Q=1:1:$ORDER(IBTEXT(" "),-1)
Begin DoDot:2
+12 IF $LENGTH(IBTEXT(Q-1))
Begin DoDot:3
+13 SET Q1=$LENGTH(IBTEXT(Q-1))+$LENGTH(IBP)
+14 SET Z=IBP_IBTEXT(Q-1)_$EXTRACT(IBTEXT(Q),1,IOM-Q1)
+15 IF $EXTRACT(Z,$LENGTH(Z))=" "!($EXTRACT(Z,$LENGTH(Z))?1P)
DO WRT(Z,.IBSTOP)
if IBSTOP
QUIT
SET IBP=$JUSTIFY("",4)
SET IBTEXT(Q)=$EXTRACT(IBTEXT(Q),IOM-Q1+1,$LENGTH(IBTEXT(Q)))
if $EXTRACT(IBTEXT(Q))=" "
SET $EXTRACT(IBTEXT(Q))=""
QUIT
+16 FOR Q2=$LENGTH(Z):-1:0
IF $EXTRACT(Z,Q2)=" "!($EXTRACT(Z,Q2)?1P)
DO WRT($EXTRACT(Z,1,Q2),.IBSTOP)
if IBSTOP
QUIT
SET IBTEXT(Q)=$EXTRACT(Z,Q2+1,$LENGTH(Z))_$EXTRACT(IBTEXT(Q),IOM-Q1+1,$LENGTH(IBTEXT(Q)))
SET IBP=$JUSTIFY("",4)
if $EXTRACT(IBTEXT(Q))=" "
SET $EXTRACT(IBTEXT(Q))=""
QUIT
+17 IF Q2=0
DO WRT($EXTRACT(Z,1,IOM),.IBSTOP)
if IBSTOP
QUIT
SET IBTEXT(Q)=$EXTRACT(IBTEXT(Q),IOM+1,$LENGTH(IBTEXT(Q)))
End DoDot:3
if IBSTOP
QUIT
+18 if '$LENGTH(IBTEXT(Q))
QUIT
+19 FOR
Begin DoDot:3
+20 IF ($LENGTH(IBTEXT(Q))+$LENGTH(IBP))'<IOM
Begin DoDot:4
+21 SET Z=IBP_$EXTRACT(IBTEXT(Q),1,IOM-$LENGTH(IBP))
+22 IF $EXTRACT(Z,$LENGTH(Z))=" "!($EXTRACT(Z,$LENGTH(Z))?1P)!($EXTRACT(IBTEXT(Q),IOM-$LENGTH(IBP)+1)=" ")
WRITE !,Z
SET IBTEXT(Q)=$EXTRACT(IBTEXT(Q),IOM-$LENGTH(IBP)+1,$LENGTH(IBTEXT(Q)))
SET IBP=$JUSTIFY("",4)
if $EXTRACT(IBTEXT(Q))=" "
SET $EXTRACT(IBTEXT(Q))=""
QUIT
+23 FOR Q2=$LENGTH(Z):-1:0
IF $EXTRACT(Z,Q2)=" "!($EXTRACT(Z,Q2)?1P)
WRITE !,$EXTRACT(Z,1,Q2)
SET IBTEXT(Q)=$EXTRACT(IBTEXT(Q),Q2-$LENGTH(IBP),$LENGTH(IBTEXT(Q)))
SET IBP=$JUSTIFY("",4)
if $EXTRACT(IBTEXT(Q))=" "
SET $EXTRACT(IBTEXT(Q))=""
QUIT
End DoDot:4
QUIT
End DoDot:3
if ($LENGTH(IBTEXT(Q))+$LENGTH(IBP))<IOM!(IBSTOP)
QUIT
End DoDot:2
if IBSTOP
QUIT
+24 if IBSTOP
QUIT
+25 IF $LENGTH(IBTEXT(Q))
DO WRT(IBP_IBTEXT(Q),.IBSTOP)
if IBSTOP
QUIT
+26 KILL IBTEXT
SET (IBTEXT,IBTEXT(1))=IBHOLD
End DoDot:1
QUIT
+27 ;
+28 SET IBTEXT(1)=IBHOLD
+29 QUIT
+30 ;
HDR1(IBPG,IBSTOP) ; output solutions header
+1 NEW X
+2 IF IBPG
DO ASK^IBCEQ2(.IBSTOP)
if IBSTOP
QUIT
WRITE @IOF
+3 SET IBPG=IBPG+1
+4 WRITE !,?(IOM-48\2),"INSURANCE COMPANY PROVIDER ID WORKSHEET SOLUTIONS"
WRITE ?(70+$SELECT(IOM<132:0,1:52)),"PAGE: ",IBPG
+5 SET X=""
SET $PIECE(X,"-",IOM+1)=""
+6 WRITE !,X,!
+7 QUIT
+8 ;
WRT(DATA,IBSTOP) ; Write data, new header if needed
+1 ; DATA = text to print
+2 ; IBSTOP = returned as 1 if passed by ref for user print abort
+3 IF ($Y+5)>IOSL
DO HDR1(.IBPG,.IBSTOP)
+4 IF 'IBSTOP
WRITE !,DATA
+5 QUIT
+6 ;
