Routine: IBCEF81

IBCEF81 ;ALB/BI - PROVIDER ADJUSTMENTS ;11-OCT-2010

 ;;2.0;INTEGRATED BILLING;**432,473,592**;21-MAR-94;Build 58

 ;;Per VA Directive 6402, this routine should not be modified.

EN(INPUT)  ; FIRST ENTRY POINT

 N INSLEVEL,PRTYPE,OUTPUT,IBIEN,CMODE,CPRNUM,STATUS

 S STATUS=1

 I $D(INPUT)=0 S STATUS=0 Q STATUS

 I (($G(IBXFORM)=2)!($G(IBXFORM)=3)) D EN^IBCEF82(.INPUT) Q STATUS    ; PERFORM LOCAL PRINT BUSINESS RULES

 K OUTPUT M OUTPUT=INPUT

 D CINIT1 Q:IBIEN="" STATUS

 F INSLEVEL="P","S","T" D    ; P=PRIMARY, S=SECONDARY, T=TERTIARY

 . D CINIT2

 . ;JWS;IB*2.0*592; 6 assistant surgeon for dental

 . F PRTYPE=1,2,3,5,6,9 D    ; 1=REFERRING, 2=OPERATING, 3=RENDERING, 5=SUPERVISING, 6=ASSISTANT SURGEON, 9=OTHER OPERATING

 .. D START(INSLEVEL,PRTYPE,.OUTPUT)

 K INPUT M INPUT=OUTPUT

 Q STATUS

START(INSLEVEL,PRTYPE,OUTPUT)  ; START PROCESSING

 N INTERM,PROVINFO,MAXAINFO,FIRSTINF

 S INTERM="A"

 S INTERM=INTERM_$$TEST1  ; Does Claim Level Provider Exist, 0=NO, 1=YES

 S INTERM=INTERM_$$TEST2  ; All procedures have a line level provider, 0=NO, 1=YES

 S INTERM=INTERM_$$TEST3  ; One Line Level provider is most significant, 0=NO, 1=YES

 S INTERM=INTERM_$$TEST4  ; At least one line level provider matches the claim level provider, 0=NO, 1=YES

 S INTERM=INTERM_$$TEST5  ; There is only one procedure without a line level provider, 0=NO, 1=YES

 D @INTERM

TEST1()  ; Does Claim Level Provider Exist, 0=NO, 1=YES

 N PROVX,PROVY

 I $D(CMODE(INSLEVEL))#10=0 Q 0

 I $D(CPRNUM(INSLEVEL))#10=0 Q 0

 S (PROVX,PROVY)=$G(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)) Q:PROVX="" 0

 S PROVX="^"_$P(PROVX,";",2)_$P(PROVX,";",1)_")"

 I $D(@PROVX) D  Q 1    ;CLAIM PROVIDER EXISTS, RETURN TRUE.

 . ; LOAD CLAIM LEVEL PROVIDER INFORMATION

 . S PROVINFO=PROVY

 . S PROVINFO("PROVINF",IBIEN)=IBIEN

 . S PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL))=""

 . S PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL))=INSLEVEL

 . M PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)=INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)

Q 0

TEST2()  ; All procedures have a line level provider, 0=NO, 1=YES

 N SLC,RESULT,LMODE,LPRNUM,PROVX,LINECNT

 S SLC=0,RESULT=1,LINECNT=0

 F  S SLC=$$LINIT1(SLC) Q:+SLC=0  D

 . S LINECNT=LINECNT+1

 . D LINIT2

 . I $D(LMODE(INSLEVEL))#10=0 S RESULT=0 Q

 . I $D(LPRNUM(INSLEVEL))#10=0 S RESULT=0 Q

 . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 . I PROVX="" D  Q

 .. S RESULT=RESULT*0

 . S PROVX="^"_$P(PROVX,";",2)_$P(PROVX,";",1)_")"

 . S RESULT=RESULT*($D(@PROVX)'=0)

 I +$G(INPUT("SLC"))'=0,INPUT("SLC")>LINECNT S RESULT=0

 Q RESULT

TEST3()  ; One Line Level provider is most significant, 0=NO, 1=YES

 N SLC,RESULT,LMODE,LPRNUM,PCOUNT,PCOUNTF,PCOUNTL,PROVX,TEMPNODE

 S SLC=0,RESULT=0

 F  S SLC=$$LINIT1(SLC) Q:+SLC=0  D

 . D LINIT2

 . I $D(LMODE(INSLEVEL))#10=0 Q

 . I $D(LPRNUM(INSLEVEL))#10=0 Q

 . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)) Q:PROVX=""

 . I $D(FIRSTINF)=0 D

 .. ; LOAD FIRST AVAILABLE PROVIDER INFORMATION

 .. S FIRSTINF=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 .. S FIRSTINF("L-PROV",IBIEN)=IBIEN

 .. S FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL))=INSLEVEL

 .. M FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)=INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)

 . S PCOUNT(PROVX)=$P($G(PCOUNT(PROVX)),"^",1)+1_"^"_SLC_"^"_LMODE(INSLEVEL)_"^"_LPRNUM(INSLEVEL)_"^"_PRTYPE

 S PROVX="" F  S PROVX=$O(PCOUNT(PROVX)) Q:PROVX=""  D

 . S PCOUNTF($P(PCOUNT(PROVX),"^",1),PROVX)=$P(PCOUNT(PROVX),"^",2,5)

 S PCOUNTL(1)=$O(PCOUNTF(""),-1) Q:PCOUNTL(1)="" RESULT

 S PCOUNTL(2,1)=$O(PCOUNTF(PCOUNTL(1),""),-1) Q:PCOUNTL(2,1)="" RESULT

 S PCOUNTL(2,2)=$O(PCOUNTF(PCOUNTL(1),PCOUNTL(2,1)),-1)

 I PCOUNTL(2,2)="" D

 . S RESULT=1

 . ; LOAD MOST SIGNIFICANT LINE LEVEL PROVIDER INFORMATION

 . S MAXAINFO=PCOUNTL(2,1)

 . S TEMPNODE=PCOUNTF(PCOUNTL(1),PCOUNTL(2,1))

 . S MAXAINFO("L-PROV",IBIEN)=IBIEN

 . S MAXAINFO("L-PROV",IBIEN,$P(TEMPNODE,"^",2),$P(TEMPNODE,"^",3))=INSLEVEL

 . M MAXAINFO("L-PROV",IBIEN,$P(TEMPNODE,"^",2),$P(TEMPNODE,"^",3),$P(TEMPNODE,"^",4))=INPUT("L-PROV",IBIEN,$P(TEMPNODE,"^",1),$P(TEMPNODE,"^",2),$P(TEMPNODE,"^",3),$P(TEMPNODE,"^",4))

 Q RESULT

TEST4()  ; At least one line level provider matches the claim level provider, 0=NO, 1=YES

 N CPROV,RESULT,LMODE,LPRNUM,LPROV,SLC

 I $D(CMODE(INSLEVEL))#10=0 Q 0

 I $D(CPRNUM(INSLEVEL))#10=0 Q 0

 S CPROV=$G(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)) Q:CPROV="" 0

 S SLC=0,RESULT=0

 F  S SLC=$$LINIT1(SLC) Q:+SLC=0  D

 . D LINIT2

 . I $D(LMODE(INSLEVEL))#10=0 Q

 . I $D(LPRNUM(INSLEVEL))#10=0 Q

 . S LPROV=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))  Q:LPROV=""

 . I LPROV=CPROV S RESULT=1

 Q RESULT

TEST5()  ; There is only one procedure without a line level provider, 0=NO, 1=YES

 N SLC,LMODE,LPRNUM,PROVCNT,RESULT

 S SLC=0,PROVCNT=0,RESULT=0

 F  S SLC=$$LINIT1(SLC) Q:+SLC=0  D

 . D LINIT2

 . I $D(LMODE(INSLEVEL))#10=0 Q

 . I $D(LPRNUM(INSLEVEL))#10=0 Q

 . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 . S:PROVX'="" PROVCNT=PROVCNT+1

 I +$G(INPUT("SLC"))'=0,INPUT("SLC")=(PROVCNT+1) S RESULT=1

 Q RESULT

A00000  ;  Case 1

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; Move the first available line level provider to the claim level.

 I $G(FIRSTINF)="" Q

 M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=FIRSTINF

 D REMOVELN

A00001  ;  Case 2

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 1=YES

 ; Move the first available line level provider to the claim level.

 I $G(FIRSTINF)="" Q

 M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=FIRSTINF

 D REMOVELN

A00010  ;  Case 3 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A00011  ;  Case 4 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A00100  ;  Case 5

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; Set the claim level provider equal to the most significant line level provider.

 I $G(MAXAINFO)="" Q

 M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=MAXAINFO

 D REMOVELN

A00101  ;  Case 6

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 1=YES

 ; Set the claim level provider equal to the most significant line level provider.

 I $G(MAXAINFO)="" Q

 M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=MAXAINFO

 D REMOVELN

A00110  ;  Case 7 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A00111  ;  Case 8 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01000  ;  Case 9

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; Move the first available line level provider to the claim level.

 ; Set the claim level provider equal to the most significant line level provider.

 I $G(FIRSTINF)="" Q

 M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=FIRSTINF

 D REMOVELN

A01001  ; Case 10 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01010  ; Case 11 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01011  ; Case 12 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01100  ; Case 13

 ; TESTS: Does Claim Level Provider Exist: 0=NO

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; Set the claim level provider equal to the most significant line level provider.

 I $G(MAXAINFO)="" Q

 M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 ; Remove the claim lines associated with the primary provider.

 S PROVINFO=MAXAINFO

 D REMOVELN

A01101  ; Case 14 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01110  ; Case 15 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A01111  ; Case 16 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A10000  ; Case 17

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; ACTIONS: Transmit as is.

A10001   ; Case 18

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 1=YES

 ; ACTIONS: Transmit as is.

A10010   ; Case 19

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 0=NO

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A10011   ; Case 20

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 1=YES

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A10100   ; Case 21

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 ; ACTIONS: Transmit as is.

A10101   ; Case 22

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 1=YES

 ; ACTIONS: Transmit as is.

A10110   ; Case 23

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 0=NO

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A10111   ; Case 24

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 0=NO

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 1=YES

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A11000   ; Case 25

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 S STATUS="0^CASE 25 ERROR"

A11001   ; Case 26 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A11010   ; Case 27

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 0=NO

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 0=NO

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A11011   ; Case 28 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A11100   ; Case 29

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 0=NO

 ;        There is only one procedure without a line level provider: 0=NO

 S STATUS="0^CASE 29 ERROR"

A11101   ; Case 30 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

A11110   ; Case 31

 ; TESTS: Does Claim Level Provider Exist: 1=YES

 ;        All procedures have a line level provider: 1=YES

 ;        One Line Level provider is most significant: 1=YES

 ; At least one line level provider matches the claim level provider: 1=YES

 ;        There is only one procedure without a line level provider: 0=NO

 ; Remove the claim lines associated with the claim level provider.

 D REMOVELN

A11111   ; Case 32 - This case can never happen!

 ; ACTIONS: N/A - Transmit as is.

CINIT1    ; Claim level initiation

 S IBIEN=$O(INPUT("L-PROV",0))

 I IBIEN="" S IBIEN=$O(INPUT("PROVINF",0))

 I IBIEN="" S IBIEN=$O(INPUT("LAB/FAC",0))

CINIT2    ; Claim level initiation

 N MODEX,PRNUMX,PROVX

 F MODEX="C","O" D

 . S PRNUMX=0 F  S PRNUMX=$O(INPUT("PROVINF",IBIEN,MODEX,PRNUMX)) Q:+PRNUMX=0  D

 .. I $G(INPUT("PROVINF",IBIEN,MODEX,PRNUMX))="" Q

 .. I INPUT("PROVINF",IBIEN,MODEX,PRNUMX)=INSLEVEL S CMODE(INSLEVEL)=MODEX,CPRNUM(INSLEVEL)=PRNUMX

LINIT1(SLC)    ; Line level initiation

 Q $O(INPUT("L-PROV",IBIEN,SLC))

LINIT2    ; Line level initiation

 N MODEX,PRNUMX,PROVX

 F MODEX="C","O" D

 . S PRNUMX=0 F  S PRNUMX=$O(INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)) Q:+PRNUMX=0  D

 .. I INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)=INSLEVEL S LMODE(INSLEVEL)=MODEX,LPRNUM(INSLEVEL)=PRNUMX

REMOVELN    ; Remove the claim lines associated with the claim level provider.

 N MODEX,PRNUMX,PROVX

 S SLC=0 F  S SLC=$O(OUTPUT("L-PROV",IBIEN,SLC)) Q:+SLC=0  D

 . F MODEX="C","O" D

 .. S PRNUMX=0 F  S PRNUMX=$O(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)) Q:+PRNUMX=0  D

 ... Q:$G(PROVINFO)=""

 ... I $G(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE))=PROVINFO D

 .... K OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE)

 .... I $D(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX))=1 K OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)

 .... I $D(OUTPUT("L-PROV",IBIEN,SLC,MODEX))=1 K OUTPUT("L-PROV",IBIEN,SLC,MODEX)

 .... I $D(OUTPUT("L-PROV",IBIEN,SLC))=1 K OUTPUT("L-PROV",IBIEN,SLC)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF81   16927     printed  Apr 09, 2024@21:30:33                                                                                                                                                                                                    Page 2

IBCEF81   ;ALB/BI - PROVIDER ADJUSTMENTS ;11-OCT-2010

 +1       ;;2.0;INTEGRATED BILLING;**432,473,592**;21-MAR-94;Build 58

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        QUIT

 +5       ;

EN(INPUT) ; FIRST ENTRY POINT

 +1        NEW INSLEVEL,PRTYPE,OUTPUT,IBIEN,CMODE,CPRNUM,STATUS

 +2        SET STATUS=1

 +3        IF $DATA(INPUT)=0

               SET STATUS=0

               QUIT STATUS

 +4       ; PERFORM LOCAL PRINT BUSINESS RULES

           IF (($GET(IBXFORM)=2)!($GET(IBXFORM)=3))

               DO EN^IBCEF82(.INPUT)

               QUIT STATUS

 +5        KILL OUTPUT

           MERGE OUTPUT=INPUT

 +6        DO CINIT1

           if IBIEN=""

               QUIT STATUS

 +7       ; P=PRIMARY, S=SECONDARY, T=TERTIARY

           FOR INSLEVEL="P","S","T"

               Begin DoDot:1

 +8                DO CINIT2

 +9       ;JWS;IB*2.0*592; 6 assistant surgeon for dental

 +10      ; 1=REFERRING, 2=OPERATING, 3=RENDERING, 5=SUPERVISING, 6=ASSISTANT SURGEON, 9=OTHER OPERATING

                   FOR PRTYPE=1,2,3,5,6,9

                       Begin DoDot:2

 +11                       DO START(INSLEVEL,PRTYPE,.OUTPUT)

                       End DoDot:2

               End DoDot:1

 +12       KILL INPUT

           MERGE INPUT=OUTPUT

 +13       QUIT STATUS

START(INSLEVEL,PRTYPE,OUTPUT) ; START PROCESSING

 +1        NEW INTERM,PROVINFO,MAXAINFO,FIRSTINF

 +2        SET INTERM="A"

 +3       ; Does Claim Level Provider Exist, 0=NO, 1=YES

           SET INTERM=INTERM_$$TEST1

 +4       ; All procedures have a line level provider, 0=NO, 1=YES

           SET INTERM=INTERM_$$TEST2

 +5       ; One Line Level provider is most significant, 0=NO, 1=YES

           SET INTERM=INTERM_$$TEST3

 +6       ; At least one line level provider matches the claim level provider, 0=NO, 1=YES

           SET INTERM=INTERM_$$TEST4

 +7       ; There is only one procedure without a line level provider, 0=NO, 1=YES

           SET INTERM=INTERM_$$TEST5

 +8        DO @INTERM

 +9        QUIT

 +10      ;

TEST1()   ; Does Claim Level Provider Exist, 0=NO, 1=YES

 +1        NEW PROVX,PROVY

 +2        IF $DATA(CMODE(INSLEVEL))#10=0

               QUIT 0

 +3        IF $DATA(CPRNUM(INSLEVEL))#10=0

               QUIT 0

 +4        SET (PROVX,PROVY)=$GET(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE))

           if PROVX=""

               QUIT 0

 +5        SET PROVX="^"_$PIECE(PROVX,";",2)_$PIECE(PROVX,";",1)_")"

 +6       ;CLAIM PROVIDER EXISTS, RETURN TRUE.

           IF $DATA(@PROVX)

               Begin DoDot:1

 +7       ; LOAD CLAIM LEVEL PROVIDER INFORMATION

 +8                SET PROVINFO=PROVY

 +9                SET PROVINFO("PROVINF",IBIEN)=IBIEN

 +10               SET PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL))=""

 +11               SET PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL))=INSLEVEL

 +12               MERGE PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)=INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)

               End DoDot:1

               QUIT 1

 +13       QUIT 0

 +14      ;

TEST2()   ; All procedures have a line level provider, 0=NO, 1=YES

 +1        NEW SLC,RESULT,LMODE,LPRNUM,PROVX,LINECNT

 +2        SET SLC=0

           SET RESULT=1

           SET LINECNT=0

 +3        FOR

               SET SLC=$$LINIT1(SLC)

               if +SLC=0

                   QUIT

               Begin DoDot:1

 +4                SET LINECNT=LINECNT+1

 +5                DO LINIT2

 +6                IF $DATA(LMODE(INSLEVEL))#10=0

                       SET RESULT=0

                       QUIT

 +7                IF $DATA(LPRNUM(INSLEVEL))#10=0

                       SET RESULT=0

                       QUIT

 +8                SET PROVX=$GET(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 +9                IF PROVX=""

                       Begin DoDot:2

 +10                       SET RESULT=RESULT*0

                       End DoDot:2

                       QUIT

 +11               SET PROVX="^"_$PIECE(PROVX,";",2)_$PIECE(PROVX,";",1)_")"

 +12               SET RESULT=RESULT*($DATA(@PROVX)'=0)

               End DoDot:1

 +13       IF +$GET(INPUT("SLC"))'=0

               IF INPUT("SLC")>LINECNT

                   SET RESULT=0

 +14       QUIT RESULT

 +15      ;

TEST3()   ; One Line Level provider is most significant, 0=NO, 1=YES

 +1        NEW SLC,RESULT,LMODE,LPRNUM,PCOUNT,PCOUNTF,PCOUNTL,PROVX,TEMPNODE

 +2        SET SLC=0

           SET RESULT=0

 +3        FOR

               SET SLC=$$LINIT1(SLC)

               if +SLC=0

                   QUIT

               Begin DoDot:1

 +4                DO LINIT2

 +5                IF $DATA(LMODE(INSLEVEL))#10=0

                       QUIT

 +6                IF $DATA(LPRNUM(INSLEVEL))#10=0

                       QUIT

 +7                SET PROVX=$GET(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

                   if PROVX=""

                       QUIT

 +8                IF $DATA(FIRSTINF)=0

                       Begin DoDot:2

 +9       ; LOAD FIRST AVAILABLE PROVIDER INFORMATION

 +10                       SET FIRSTINF=$GET(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 +11                       SET FIRSTINF("L-PROV",IBIEN)=IBIEN

 +12                       SET FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL))=INSLEVEL

 +13                       MERGE FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)=INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)

                       End DoDot:2

 +14               SET PCOUNT(PROVX)=$PIECE($GET(PCOUNT(PROVX)),"^",1)+1_"^"_SLC_"^"_LMODE(INSLEVEL)_"^"_LPRNUM(INSLEVEL)_"^"_PRTYPE

               End DoDot:1

 +15       SET PROVX=""

FOR

               SET PROVX=$ORDER(PCOUNT(PROVX))

               if PROVX=""

                   QUIT

               Begin DoDot:1

 +16               SET PCOUNTF($PIECE(PCOUNT(PROVX),"^",1),PROVX)=$PIECE(PCOUNT(PROVX),"^",2,5)

               End DoDot:1

 +17       SET PCOUNTL(1)=$ORDER(PCOUNTF(""),-1)

           if PCOUNTL(1)=""

               QUIT RESULT

 +18       SET PCOUNTL(2,1)=$ORDER(PCOUNTF(PCOUNTL(1),""),-1)

           if PCOUNTL(2,1)=""

               QUIT RESULT

 +19       SET PCOUNTL(2,2)=$ORDER(PCOUNTF(PCOUNTL(1),PCOUNTL(2,1)),-1)

 +20       IF PCOUNTL(2,2)=""

               Begin DoDot:1

 +21               SET RESULT=1

 +22      ; LOAD MOST SIGNIFICANT LINE LEVEL PROVIDER INFORMATION

 +23               SET MAXAINFO=PCOUNTL(2,1)

 +24               SET TEMPNODE=PCOUNTF(PCOUNTL(1),PCOUNTL(2,1))

 +25               SET MAXAINFO("L-PROV",IBIEN)=IBIEN

 +26               SET MAXAINFO("L-PROV",IBIEN,$PIECE(TEMPNODE,"^",2),$PIECE(TEMPNODE,"^",3))=INSLEVEL

 +27               MERGE MAXAINFO("L-PROV",IBIEN,$PIECE(TEMPNODE,"^",2),$PIECE(TEMPNODE,"^",3),$PIECE(TEMPNODE,"^",4))=INPUT("L-PROV",IBIEN,$PIECE(TEMPNODE,"^",1),$PIECE(TEMPNODE,"^",2),$PIECE(TEMPNODE,"^",3),$PIECE(TEMPNODE,"^",4))

               End DoDot:1

 +28       QUIT RESULT

 +29      ;

TEST4()   ; At least one line level provider matches the claim level provider, 0=NO, 1=YES

 +1        NEW CPROV,RESULT,LMODE,LPRNUM,LPROV,SLC

 +2        IF $DATA(CMODE(INSLEVEL))#10=0

               QUIT 0

 +3        IF $DATA(CPRNUM(INSLEVEL))#10=0

               QUIT 0

 +4        SET CPROV=$GET(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE))

           if CPROV=""

               QUIT 0

 +5        SET SLC=0

           SET RESULT=0

 +6        FOR

               SET SLC=$$LINIT1(SLC)

               if +SLC=0

                   QUIT

               Begin DoDot:1

 +7                DO LINIT2

 +8                IF $DATA(LMODE(INSLEVEL))#10=0

                       QUIT

 +9                IF $DATA(LPRNUM(INSLEVEL))#10=0

                       QUIT

 +10               SET LPROV=$GET(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

                   if LPROV=""

                       QUIT

 +11               IF LPROV=CPROV

                       SET RESULT=1

               End DoDot:1

 +12       QUIT RESULT

 +13      ;

TEST5()   ; There is only one procedure without a line level provider, 0=NO, 1=YES

 +1        NEW SLC,LMODE,LPRNUM,PROVCNT,RESULT

 +2        SET SLC=0

           SET PROVCNT=0

           SET RESULT=0

 +3        FOR

               SET SLC=$$LINIT1(SLC)

               if +SLC=0

                   QUIT

               Begin DoDot:1

 +4                DO LINIT2

 +5                IF $DATA(LMODE(INSLEVEL))#10=0

                       QUIT

 +6                IF $DATA(LPRNUM(INSLEVEL))#10=0

                       QUIT

 +7                SET PROVX=$GET(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))

 +8                if PROVX'=""

                       SET PROVCNT=PROVCNT+1

               End DoDot:1

 +9        IF +$GET(INPUT("SLC"))'=0

               IF INPUT("SLC")=(PROVCNT+1)

                   SET RESULT=1

 +10       QUIT RESULT

 +11      ;

A00000    ;  Case 1

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Move the first available line level provider to the claim level.

 +8        IF $GET(FIRSTINF)=""

               QUIT

 +9        MERGE OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 +10      ;

 +11      ; Remove the claim lines associated with the primary provider.

 +12       SET PROVINFO=FIRSTINF

 +13       DO REMOVELN

 +14       QUIT

 +15      ;

A00001    ;  Case 2

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; Move the first available line level provider to the claim level.

 +8        IF $GET(FIRSTINF)=""

               QUIT

 +9        MERGE OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 +10      ;

 +11      ; Remove the claim lines associated with the primary provider.

 +12       SET PROVINFO=FIRSTINF

 +13       DO REMOVELN

 +14       QUIT

 +15      ;

A00010    ;  Case 3 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A00011    ;  Case 4 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A00100    ;  Case 5

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Set the claim level provider equal to the most significant line level provider.

 +8        IF $GET(MAXAINFO)=""

               QUIT

 +9        MERGE OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 +10      ;

 +11      ; Remove the claim lines associated with the primary provider.

 +12       SET PROVINFO=MAXAINFO

 +13       DO REMOVELN

 +14      ;

 +15       QUIT

 +16      ;

A00101    ;  Case 6

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; Set the claim level provider equal to the most significant line level provider.

 +8        IF $GET(MAXAINFO)=""

               QUIT

 +9        MERGE OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 +10      ;

 +11      ; Remove the claim lines associated with the primary provider.

 +12       SET PROVINFO=MAXAINFO

 +13       DO REMOVELN

 +14      ;

 +15       QUIT

 +16      ;

A00110    ;  Case 7 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A00111    ;  Case 8 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01000    ;  Case 9

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Move the first available line level provider to the claim level.

 +8       ; Set the claim level provider equal to the most significant line level provider.

 +9        IF $GET(FIRSTINF)=""

               QUIT

 +10       MERGE OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)

 +11      ;

 +12      ; Remove the claim lines associated with the primary provider.

 +13       SET PROVINFO=FIRSTINF

 +14       DO REMOVELN

 +15       QUIT

 +16      ;

A01001    ; Case 10 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01010    ; Case 11 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01011    ; Case 12 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01100    ; Case 13

 +1       ; TESTS: Does Claim Level Provider Exist: 0=NO

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Set the claim level provider equal to the most significant line level provider.

 +8        IF $GET(MAXAINFO)=""

               QUIT

 +9        MERGE OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)

 +10      ;

 +11      ; Remove the claim lines associated with the primary provider.

 +12       SET PROVINFO=MAXAINFO

 +13       DO REMOVELN

 +14      ;

 +15       QUIT

 +16      ;

A01101    ; Case 14 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01110    ; Case 15 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A01111    ; Case 16 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A10000    ; Case 17

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; ACTIONS: Transmit as is.

 +8       ;

 +9        QUIT

 +10      ;

A10001    ; Case 18

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; ACTIONS: Transmit as is.

 +8       ;

 +9        QUIT

 +10      ;

A10010    ; Case 19

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A10011    ; Case 20

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A10100    ; Case 21

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; ACTIONS: Transmit as is.

 +8       ;

 +9        QUIT

 +10      ;

A10101    ; Case 22

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; ACTIONS: Transmit as is.

 +8       ;

 +9        QUIT

 +10      ;

A10110    ; Case 23

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A10111    ; Case 24

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 0=NO

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 1=YES

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A11000    ; Case 25

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7        SET STATUS="0^CASE 25 ERROR"

 +8       ;

 +9        QUIT

 +10      ;

A11001    ; Case 26 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A11010    ; Case 27

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 0=NO

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A11011    ; Case 28 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A11100    ; Case 29

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 0=NO

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7        SET STATUS="0^CASE 29 ERROR"

 +8       ;

 +9        QUIT

 +10      ;

A11101    ; Case 30 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

A11110    ; Case 31

 +1       ; TESTS: Does Claim Level Provider Exist: 1=YES

 +2       ;        All procedures have a line level provider: 1=YES

 +3       ;        One Line Level provider is most significant: 1=YES

 +4       ; At least one line level provider matches the claim level provider: 1=YES

 +5       ;        There is only one procedure without a line level provider: 0=NO

 +6       ;

 +7       ; Remove the claim lines associated with the claim level provider.

 +8        DO REMOVELN

 +9       ;

 +10       QUIT

 +11      ;

A11111    ; Case 32 - This case can never happen!

 +1       ; ACTIONS: N/A - Transmit as is.

 +2        QUIT

 +3       ;

CINIT1    ; Claim level initiation

 +1        SET IBIEN=$ORDER(INPUT("L-PROV",0))

 +2        IF IBIEN=""

               SET IBIEN=$ORDER(INPUT("PROVINF",0))

 +3        IF IBIEN=""

               SET IBIEN=$ORDER(INPUT("LAB/FAC",0))

 +4        QUIT

 +5       ;

CINIT2    ; Claim level initiation

 +1        NEW MODEX,PRNUMX,PROVX

 +2        FOR MODEX="C","O"

               Begin DoDot:1

 +3                SET PRNUMX=0

FOR

                       SET PRNUMX=$ORDER(INPUT("PROVINF",IBIEN,MODEX,PRNUMX))

                       if +PRNUMX=0

                           QUIT

                       Begin DoDot:2

 +4                        IF $GET(INPUT("PROVINF",IBIEN,MODEX,PRNUMX))=""

                               QUIT

 +5                        IF INPUT("PROVINF",IBIEN,MODEX,PRNUMX)=INSLEVEL

                               SET CMODE(INSLEVEL)=MODEX

                               SET CPRNUM(INSLEVEL)=PRNUMX

                       End DoDot:2

               End DoDot:1

 +6        QUIT

 +7       ;

LINIT1(SLC) ; Line level initiation

 +1        QUIT $ORDER(INPUT("L-PROV",IBIEN,SLC))

 +2       ;

LINIT2    ; Line level initiation

 +1        NEW MODEX,PRNUMX,PROVX

 +2        FOR MODEX="C","O"

               Begin DoDot:1

 +3                SET PRNUMX=0

FOR

                       SET PRNUMX=$ORDER(INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX))

                       if +PRNUMX=0

                           QUIT

                       Begin DoDot:2

 +4                        IF INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)=INSLEVEL

                               SET LMODE(INSLEVEL)=MODEX

                               SET LPRNUM(INSLEVEL)=PRNUMX

                       End DoDot:2

               End DoDot:1

 +5        QUIT

 +6       ;

REMOVELN  ; Remove the claim lines associated with the claim level provider.

 +1        NEW MODEX,PRNUMX,PROVX

 +2        SET SLC=0

FOR

               SET SLC=$ORDER(OUTPUT("L-PROV",IBIEN,SLC))

               if +SLC=0

                   QUIT

               Begin DoDot:1

 +3                FOR MODEX="C","O"

                       Begin DoDot:2

 +4                        SET PRNUMX=0

FOR

                               SET PRNUMX=$ORDER(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX))

                               if +PRNUMX=0

                                   QUIT

                               Begin DoDot:3

 +5                                if $GET(PROVINFO)=""

                                       QUIT

 +6                                IF $GET(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE))=PROVINFO

                                       Begin DoDot:4

 +7                                        KILL OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE)

 +8                                        IF $DATA(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX))=1

                                               KILL OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)

 +9                                        IF $DATA(OUTPUT("L-PROV",IBIEN,SLC,MODEX))=1

                                               KILL OUTPUT("L-PROV",IBIEN,SLC,MODEX)

 +10                                       IF $DATA(OUTPUT("L-PROV",IBIEN,SLC))=1

                                               KILL OUTPUT("L-PROV",IBIEN,SLC)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       QUIT

IBCEF81.m