- 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 Mar 13, 2025@21:17:01 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 ;
