source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEQ2A.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1IBCEQ2A ;ALB/TMK - PROVIDER/BILLING ID WORKSHEET SOLUTIONS ;18-AUG-04
2 ;;2.0;INTEGRATED BILLING;**282**;21-MAR-94
3 ;
4WRTS(IBTYPE,IBOTYPE,IBTEXT,IBSTOP) ; Write the line
5 ; IBTYPE = type of current line
6 ; IBOTYPE = last type processed
7 ; IBTEXT(n) = array containing previously extracted text for output
8 ; IBTEXT = current line's text
9 ; IBSTOP = returned as 1 if passed by ref and user chooses to abort
10 N Q,Q1,Q2,Z,IBHOLD,IBP
11 I IBTYPE=IBOTYPE S IBTEXT(+$O(IBTEXT(" "),-1)+1)=IBTEXT,IBTEXT="" Q
12 S IBHOLD=IBTEXT
13 I IBOTYPE="Q"!(IBOTYPE="A") D Q
14 . S Z="",IBTEXT(0)="",IBP=$S(IBOTYPE="A":">>>>",1:"")
15 . F Q=1:1:$O(IBTEXT(" "),-1) D Q:IBSTOP
16 .. I $L(IBTEXT(Q-1)) D Q:IBSTOP
17 ... S Q1=$L(IBTEXT(Q-1))+$L(IBP)
18 ... S Z=IBP_IBTEXT(Q-1)_$E(IBTEXT(Q),1,IOM-Q1)
19 ... 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
20 ... 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
21 ... I Q2=0 D WRT($E(Z,1,IOM),.IBSTOP) Q:IBSTOP S IBTEXT(Q)=$E(IBTEXT(Q),IOM+1,$L(IBTEXT(Q)))
22 .. Q:'$L(IBTEXT(Q))
23 .. F D Q:($L(IBTEXT(Q))+$L(IBP))<IOM!(IBSTOP)
24 ... I ($L(IBTEXT(Q))+$L(IBP))'<IOM D Q
25 .... S Z=IBP_$E(IBTEXT(Q),1,IOM-$L(IBP))
26 .... 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
27 .... 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
28 . Q:IBSTOP
29 . I $L(IBTEXT(Q)) D WRT(IBP_IBTEXT(Q),.IBSTOP) Q:IBSTOP
30 . K IBTEXT S (IBTEXT,IBTEXT(1))=IBHOLD
31 ;
32 S IBTEXT(1)=IBHOLD
33 Q
34 ;
35HDR1(IBPG,IBSTOP) ; output solutions header
36 N X
37 I IBPG D ASK^IBCEQ2(.IBSTOP) Q:IBSTOP W @IOF
38 S IBPG=IBPG+1
39 W !,?(IOM-48\2),"INSURANCE COMPANY PROVIDER ID WORKSHEET SOLUTIONS" W ?(70+$S(IOM<132:0,1:52)),"PAGE: ",IBPG
40 S X="",$P(X,"-",IOM+1)=""
41 W !,X,!
42 Q
43 ;
44WRT(DATA,IBSTOP) ; Write data, new header if needed
45 ; DATA = text to print
46 ; IBSTOP = returned as 1 if passed by ref for user print abort
47 I ($Y+5)>IOSL D HDR1(.IBPG,.IBSTOP)
48 I 'IBSTOP W !,DATA
49 Q
50 ;
Note: See TracBrowser for help on using the repository browser.