IBCEF82 ;ALB/BI - PROVIDER ADJUSTMENTS ;20-OCT-2010
;;2.0;INTEGRATED BILLING;**432,473**;21-MAR-94;Build 29
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
EN(INPUT) ; ENTRY POINT FOR LOCAL PRINTING
N INSLEVEL,PRTYPE,OUTPUT,IBIEN,CMODE,CPRNUM,STATUS
S STATUS=1
I $D(INPUT)=0 S STATUS=0 Q STATUS
K OUTPUT M OUTPUT=INPUT
D CINIT1 Q:IBIEN="" STATUS
F INSLEVEL="P","S","T" D ; P=PRIMARY, S=SECONDARY, T=TERTIARY
. D CINIT2
. F PRTYPE=1,2,3,5,9 D ; 1=REFERRING, 2=OPERATING, 3=RENDERING, 5=SUPERVISING, 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
. D LINIT2
. S LINECNT=LINECNT+1
. 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
;
; ACTIONS: Error Message
;
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
;
; ACTIONS: Error Message
;
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
;
; ACTIONS: Error Message
;
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
;
; ACTIONS: Error Message
;
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
;
; ACTIONS: Return the first Line Level Provider.
;
; Move the first line level provider to the claim level.
I $G(FIRSTINF)="" Q
M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)
;
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
;
; ACTIONS: Make the most significant provider the Claim Level Provider.
;
; 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)
;
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: Take no Action, use claim level provider.
;
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: 1. Move the Claim Level Provider to the Line Level.
; 2. Use the first line level provider for the claim level.
;
; Don't perform this action for a single line claim.
I $G(INPUT("SLC"))=1 Q
;
; Determine Line with Missing Provider.
N SLC
S SLC=0 F S SLC=$O(^DGCR(399,IBIEN,"RC",SLC)) Q:+SLC=0 D
. I $D(INPUT("L-PROV",IBIEN,SLC))=0 D
.. ; Move claim level provider to the lines without a provider.
.. M OUTPUT("L-PROV",IBIEN,SLC)=PROVINFO("PROVINF",IBIEN)
;
; Move the first line level provider to the claim level.
S SLC=1
I $D(CMODE(INSLEVEL))'=1 Q
I $D(CPRNUM(INSLEVEL))'=1 Q
I $D(OUTPUT("L-PROV",IBIEN,SLC,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)) D
. K OUTPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)
. M OUTPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)=OUTPUT("L-PROV",IBIEN,SLC,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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: Take no Action, use claim level provider.
;
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: Take no Action, use claim level provider.
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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
;
; ACTIONS: Error in Billing
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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
;
; ACTIONS: Error in Billing
;
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
;
; ACTIONS: Take no Action, use claim level provider.
;
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[HIBCEF82 17664 printed Dec 13, 2024@02:10:23 Page 2
IBCEF82 ;ALB/BI - PROVIDER ADJUSTMENTS ;20-OCT-2010
+1 ;;2.0;INTEGRATED BILLING;**432,473**;21-MAR-94;Build 29
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN(INPUT) ; ENTRY POINT FOR LOCAL PRINTING
+1 NEW INSLEVEL,PRTYPE,OUTPUT,IBIEN,CMODE,CPRNUM,STATUS
+2 SET STATUS=1
+3 IF $DATA(INPUT)=0
SET STATUS=0
QUIT STATUS
+4 KILL OUTPUT
MERGE OUTPUT=INPUT
+5 DO CINIT1
if IBIEN=""
QUIT STATUS
+6 ; P=PRIMARY, S=SECONDARY, T=TERTIARY
FOR INSLEVEL="P","S","T"
Begin DoDot:1
+7 DO CINIT2
+8 ; 1=REFERRING, 2=OPERATING, 3=RENDERING, 5=SUPERVISING, 9=OTHER OPERATING
FOR PRTYPE=1,2,3,5,9
Begin DoDot:2
+9 DO START(INSLEVEL,PRTYPE,.OUTPUT)
End DoDot:2
End DoDot:1
+10 KILL INPUT
MERGE INPUT=OUTPUT
+11 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 DO LINIT2
+5 SET LINECNT=LINECNT+1
+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 ; ACTIONS: Error Message
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Error Message
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Error Message
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Error Message
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Return the first Line Level Provider.
+8 ;
+9 ; Move the first line level provider to the claim level.
+10 IF $GET(FIRSTINF)=""
QUIT
+11 MERGE OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)
+12 ;
+13 QUIT
+14 ;
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 ; ACTIONS: Make the most significant provider the Claim Level Provider.
+8 ;
+9 ; Set the claim level provider equal to the most significant line level provider.
+10 IF $GET(MAXAINFO)=""
QUIT
+11 MERGE OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)
+12 ;
+13 QUIT
+14 ;
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: Take no Action, use claim level provider.
+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: 1. Move the Claim Level Provider to the Line Level.
+8 ; 2. Use the first line level provider for the claim level.
+9 ;
+10 ; Don't perform this action for a single line claim.
+11 IF $GET(INPUT("SLC"))=1
QUIT
+12 ;
+13 ; Determine Line with Missing Provider.
+14 NEW SLC
+15 SET SLC=0
FOR
SET SLC=$ORDER(^DGCR(399,IBIEN,"RC",SLC))
if +SLC=0
QUIT
Begin DoDot:1
+16 IF $DATA(INPUT("L-PROV",IBIEN,SLC))=0
Begin DoDot:2
+17 ; Move claim level provider to the lines without a provider.
+18 MERGE OUTPUT("L-PROV",IBIEN,SLC)=PROVINFO("PROVINF",IBIEN)
End DoDot:2
End DoDot:1
+19 ;
+20 ; Move the first line level provider to the claim level.
+21 SET SLC=1
+22 IF $DATA(CMODE(INSLEVEL))'=1
QUIT
+23 IF $DATA(CPRNUM(INSLEVEL))'=1
QUIT
+24 IF $DATA(OUTPUT("L-PROV",IBIEN,SLC,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE))
Begin DoDot:1
+25 KILL OUTPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)
+26 MERGE OUTPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)=OUTPUT("L-PROV",IBIEN,SLC,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)
End DoDot:1
+27 ;
+28 QUIT
+29 ;
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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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: Take no Action, use claim level provider.
+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: Take no Action, use claim level provider.
+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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Error in Billing
+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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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 ; ACTIONS: Error in Billing
+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 ; ACTIONS: Take no Action, use claim level provider.
+8 ;
+9 QUIT
+10 ;
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
