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.
 ;
 Q
 ;
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
 Q 
 ;
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
 Q
 ;
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
 Q
 ;
A00010  ;  Case 3 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A00011  ;  Case 4 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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
 ;
 Q
 ;
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
 ;
 Q
 ;
A00110  ;  Case 7 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A00111  ;  Case 8 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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
 Q
 ;
A01001  ; Case 10 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A01010  ; Case 11 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A01011  ; Case 12 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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
 ;
 Q
 ;
A01101  ; Case 14 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A01110  ; Case 15 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
A01111  ; Case 16 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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.
 ;
 Q
 ;
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.
 ;
 Q
 ;
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
 ;
 Q
 ;
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
 ;
 Q
 ;
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.
 ;
 Q
 ;
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.
 ;
 Q
 ;
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
 ;
 Q
 ;
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
 ;
 Q
 ;
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"
 ;
 Q
 ;
A11001   ; Case 26 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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
 ;
 Q
 ;
A11011   ; Case 28 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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"
 ;
 Q
 ;
A11101   ; Case 30 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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
 ;
 Q
 ;
A11111   ; Case 32 - This case can never happen!
 ; ACTIONS: N/A - Transmit as is.
 Q
 ;
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))
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF81   16927     printed  Sep 23, 2025@19:46:36                                                                                                                                                                                                    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