Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEF81

IBCEF81.m

Go to the documentation of this file.
  1. IBCEF81 ;ALB/BI - PROVIDER ADJUSTMENTS ;11-OCT-2010
  1. ;;2.0;INTEGRATED BILLING;**432,473,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EN(INPUT) ; FIRST ENTRY POINT
  1. N INSLEVEL,PRTYPE,OUTPUT,IBIEN,CMODE,CPRNUM,STATUS
  1. S STATUS=1
  1. I $D(INPUT)=0 S STATUS=0 Q STATUS
  1. I (($G(IBXFORM)=2)!($G(IBXFORM)=3)) D EN^IBCEF82(.INPUT) Q STATUS ; PERFORM LOCAL PRINT BUSINESS RULES
  1. K OUTPUT M OUTPUT=INPUT
  1. D CINIT1 Q:IBIEN="" STATUS
  1. F INSLEVEL="P","S","T" D ; P=PRIMARY, S=SECONDARY, T=TERTIARY
  1. . D CINIT2
  1. . ;JWS;IB*2.0*592; 6 assistant surgeon for dental
  1. . F PRTYPE=1,2,3,5,6,9 D ; 1=REFERRING, 2=OPERATING, 3=RENDERING, 5=SUPERVISING, 6=ASSISTANT SURGEON, 9=OTHER OPERATING
  1. .. D START(INSLEVEL,PRTYPE,.OUTPUT)
  1. K INPUT M INPUT=OUTPUT
  1. Q STATUS
  1. START(INSLEVEL,PRTYPE,OUTPUT) ; START PROCESSING
  1. N INTERM,PROVINFO,MAXAINFO,FIRSTINF
  1. S INTERM="A"
  1. S INTERM=INTERM_$$TEST1 ; Does Claim Level Provider Exist, 0=NO, 1=YES
  1. S INTERM=INTERM_$$TEST2 ; All procedures have a line level provider, 0=NO, 1=YES
  1. S INTERM=INTERM_$$TEST3 ; One Line Level provider is most significant, 0=NO, 1=YES
  1. S INTERM=INTERM_$$TEST4 ; At least one line level provider matches the claim level provider, 0=NO, 1=YES
  1. S INTERM=INTERM_$$TEST5 ; There is only one procedure without a line level provider, 0=NO, 1=YES
  1. D @INTERM
  1. Q
  1. ;
  1. TEST1() ; Does Claim Level Provider Exist, 0=NO, 1=YES
  1. N PROVX,PROVY
  1. I $D(CMODE(INSLEVEL))#10=0 Q 0
  1. I $D(CPRNUM(INSLEVEL))#10=0 Q 0
  1. S (PROVX,PROVY)=$G(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)) Q:PROVX="" 0
  1. S PROVX="^"_$P(PROVX,";",2)_$P(PROVX,";",1)_")"
  1. I $D(@PROVX) D Q 1 ;CLAIM PROVIDER EXISTS, RETURN TRUE.
  1. . ; LOAD CLAIM LEVEL PROVIDER INFORMATION
  1. . S PROVINFO=PROVY
  1. . S PROVINFO("PROVINF",IBIEN)=IBIEN
  1. . S PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL))=""
  1. . S PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL))=INSLEVEL
  1. . M PROVINFO("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)=INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)
  1. Q 0
  1. ;
  1. TEST2() ; All procedures have a line level provider, 0=NO, 1=YES
  1. N SLC,RESULT,LMODE,LPRNUM,PROVX,LINECNT
  1. S SLC=0,RESULT=1,LINECNT=0
  1. F S SLC=$$LINIT1(SLC) Q:+SLC=0 D
  1. . S LINECNT=LINECNT+1
  1. . D LINIT2
  1. . I $D(LMODE(INSLEVEL))#10=0 S RESULT=0 Q
  1. . I $D(LPRNUM(INSLEVEL))#10=0 S RESULT=0 Q
  1. . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))
  1. . I PROVX="" D Q
  1. .. S RESULT=RESULT*0
  1. . S PROVX="^"_$P(PROVX,";",2)_$P(PROVX,";",1)_")"
  1. . S RESULT=RESULT*($D(@PROVX)'=0)
  1. I +$G(INPUT("SLC"))'=0,INPUT("SLC")>LINECNT S RESULT=0
  1. Q RESULT
  1. ;
  1. TEST3() ; One Line Level provider is most significant, 0=NO, 1=YES
  1. N SLC,RESULT,LMODE,LPRNUM,PCOUNT,PCOUNTF,PCOUNTL,PROVX,TEMPNODE
  1. S SLC=0,RESULT=0
  1. F S SLC=$$LINIT1(SLC) Q:+SLC=0 D
  1. . D LINIT2
  1. . I $D(LMODE(INSLEVEL))#10=0 Q
  1. . I $D(LPRNUM(INSLEVEL))#10=0 Q
  1. . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)) Q:PROVX=""
  1. . I $D(FIRSTINF)=0 D
  1. .. ; LOAD FIRST AVAILABLE PROVIDER INFORMATION
  1. .. S FIRSTINF=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))
  1. .. S FIRSTINF("L-PROV",IBIEN)=IBIEN
  1. .. S FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL))=INSLEVEL
  1. .. M FIRSTINF("L-PROV",IBIEN,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)=INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)
  1. . S PCOUNT(PROVX)=$P($G(PCOUNT(PROVX)),"^",1)+1_"^"_SLC_"^"_LMODE(INSLEVEL)_"^"_LPRNUM(INSLEVEL)_"^"_PRTYPE
  1. S PROVX="" F S PROVX=$O(PCOUNT(PROVX)) Q:PROVX="" D
  1. . S PCOUNTF($P(PCOUNT(PROVX),"^",1),PROVX)=$P(PCOUNT(PROVX),"^",2,5)
  1. S PCOUNTL(1)=$O(PCOUNTF(""),-1) Q:PCOUNTL(1)="" RESULT
  1. S PCOUNTL(2,1)=$O(PCOUNTF(PCOUNTL(1),""),-1) Q:PCOUNTL(2,1)="" RESULT
  1. S PCOUNTL(2,2)=$O(PCOUNTF(PCOUNTL(1),PCOUNTL(2,1)),-1)
  1. I PCOUNTL(2,2)="" D
  1. . S RESULT=1
  1. . ; LOAD MOST SIGNIFICANT LINE LEVEL PROVIDER INFORMATION
  1. . S MAXAINFO=PCOUNTL(2,1)
  1. . S TEMPNODE=PCOUNTF(PCOUNTL(1),PCOUNTL(2,1))
  1. . S MAXAINFO("L-PROV",IBIEN)=IBIEN
  1. . S MAXAINFO("L-PROV",IBIEN,$P(TEMPNODE,"^",2),$P(TEMPNODE,"^",3))=INSLEVEL
  1. . 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))
  1. Q RESULT
  1. ;
  1. TEST4() ; At least one line level provider matches the claim level provider, 0=NO, 1=YES
  1. N CPROV,RESULT,LMODE,LPRNUM,LPROV,SLC
  1. I $D(CMODE(INSLEVEL))#10=0 Q 0
  1. I $D(CPRNUM(INSLEVEL))#10=0 Q 0
  1. S CPROV=$G(INPUT("PROVINF",IBIEN,CMODE(INSLEVEL),CPRNUM(INSLEVEL),PRTYPE)) Q:CPROV="" 0
  1. S SLC=0,RESULT=0
  1. F S SLC=$$LINIT1(SLC) Q:+SLC=0 D
  1. . D LINIT2
  1. . I $D(LMODE(INSLEVEL))#10=0 Q
  1. . I $D(LPRNUM(INSLEVEL))#10=0 Q
  1. . S LPROV=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE)) Q:LPROV=""
  1. . I LPROV=CPROV S RESULT=1
  1. Q RESULT
  1. ;
  1. TEST5() ; There is only one procedure without a line level provider, 0=NO, 1=YES
  1. N SLC,LMODE,LPRNUM,PROVCNT,RESULT
  1. S SLC=0,PROVCNT=0,RESULT=0
  1. F S SLC=$$LINIT1(SLC) Q:+SLC=0 D
  1. . D LINIT2
  1. . I $D(LMODE(INSLEVEL))#10=0 Q
  1. . I $D(LPRNUM(INSLEVEL))#10=0 Q
  1. . S PROVX=$G(INPUT("L-PROV",IBIEN,SLC,LMODE(INSLEVEL),LPRNUM(INSLEVEL),PRTYPE))
  1. . S:PROVX'="" PROVCNT=PROVCNT+1
  1. I +$G(INPUT("SLC"))'=0,INPUT("SLC")=(PROVCNT+1) S RESULT=1
  1. Q RESULT
  1. ;
  1. A00000 ; Case 1
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Move the first available line level provider to the claim level.
  1. I $G(FIRSTINF)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=FIRSTINF
  1. D REMOVELN
  1. Q
  1. ;
  1. A00001 ; Case 2
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; Move the first available line level provider to the claim level.
  1. I $G(FIRSTINF)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=FIRSTINF
  1. D REMOVELN
  1. Q
  1. ;
  1. A00010 ; Case 3 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A00011 ; Case 4 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A00100 ; Case 5
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Set the claim level provider equal to the most significant line level provider.
  1. I $G(MAXAINFO)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=MAXAINFO
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A00101 ; Case 6
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; Set the claim level provider equal to the most significant line level provider.
  1. I $G(MAXAINFO)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=MAXAINFO
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A00110 ; Case 7 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A00111 ; Case 8 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01000 ; Case 9
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Move the first available line level provider to the claim level.
  1. ; Set the claim level provider equal to the most significant line level provider.
  1. I $G(FIRSTINF)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=FIRSTINF("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=FIRSTINF
  1. D REMOVELN
  1. Q
  1. ;
  1. A01001 ; Case 10 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01010 ; Case 11 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01011 ; Case 12 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01100 ; Case 13
  1. ; TESTS: Does Claim Level Provider Exist: 0=NO
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Set the claim level provider equal to the most significant line level provider.
  1. I $G(MAXAINFO)="" Q
  1. M OUTPUT("PROVINF",IBIEN)=MAXAINFO("L-PROV",IBIEN)
  1. ;
  1. ; Remove the claim lines associated with the primary provider.
  1. S PROVINFO=MAXAINFO
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A01101 ; Case 14 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01110 ; Case 15 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A01111 ; Case 16 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A10000 ; Case 17
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; ACTIONS: Transmit as is.
  1. ;
  1. Q
  1. ;
  1. A10001 ; Case 18
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; ACTIONS: Transmit as is.
  1. ;
  1. Q
  1. ;
  1. A10010 ; Case 19
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A10011 ; Case 20
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A10100 ; Case 21
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; ACTIONS: Transmit as is.
  1. ;
  1. Q
  1. ;
  1. A10101 ; Case 22
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; ACTIONS: Transmit as is.
  1. ;
  1. Q
  1. ;
  1. A10110 ; Case 23
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A10111 ; Case 24
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 0=NO
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 1=YES
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A11000 ; Case 25
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. S STATUS="0^CASE 25 ERROR"
  1. ;
  1. Q
  1. ;
  1. A11001 ; Case 26 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A11010 ; Case 27
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 0=NO
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A11011 ; Case 28 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A11100 ; Case 29
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 0=NO
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. S STATUS="0^CASE 29 ERROR"
  1. ;
  1. Q
  1. ;
  1. A11101 ; Case 30 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. A11110 ; Case 31
  1. ; TESTS: Does Claim Level Provider Exist: 1=YES
  1. ; All procedures have a line level provider: 1=YES
  1. ; One Line Level provider is most significant: 1=YES
  1. ; At least one line level provider matches the claim level provider: 1=YES
  1. ; There is only one procedure without a line level provider: 0=NO
  1. ;
  1. ; Remove the claim lines associated with the claim level provider.
  1. D REMOVELN
  1. ;
  1. Q
  1. ;
  1. A11111 ; Case 32 - This case can never happen!
  1. ; ACTIONS: N/A - Transmit as is.
  1. Q
  1. ;
  1. CINIT1 ; Claim level initiation
  1. S IBIEN=$O(INPUT("L-PROV",0))
  1. I IBIEN="" S IBIEN=$O(INPUT("PROVINF",0))
  1. I IBIEN="" S IBIEN=$O(INPUT("LAB/FAC",0))
  1. Q
  1. ;
  1. CINIT2 ; Claim level initiation
  1. N MODEX,PRNUMX,PROVX
  1. F MODEX="C","O" D
  1. . S PRNUMX=0 F S PRNUMX=$O(INPUT("PROVINF",IBIEN,MODEX,PRNUMX)) Q:+PRNUMX=0 D
  1. .. I $G(INPUT("PROVINF",IBIEN,MODEX,PRNUMX))="" Q
  1. .. I INPUT("PROVINF",IBIEN,MODEX,PRNUMX)=INSLEVEL S CMODE(INSLEVEL)=MODEX,CPRNUM(INSLEVEL)=PRNUMX
  1. Q
  1. ;
  1. LINIT1(SLC) ; Line level initiation
  1. Q $O(INPUT("L-PROV",IBIEN,SLC))
  1. ;
  1. LINIT2 ; Line level initiation
  1. N MODEX,PRNUMX,PROVX
  1. F MODEX="C","O" D
  1. . S PRNUMX=0 F S PRNUMX=$O(INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)) Q:+PRNUMX=0 D
  1. .. I INPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)=INSLEVEL S LMODE(INSLEVEL)=MODEX,LPRNUM(INSLEVEL)=PRNUMX
  1. Q
  1. ;
  1. REMOVELN ; Remove the claim lines associated with the claim level provider.
  1. N MODEX,PRNUMX,PROVX
  1. S SLC=0 F S SLC=$O(OUTPUT("L-PROV",IBIEN,SLC)) Q:+SLC=0 D
  1. . F MODEX="C","O" D
  1. .. S PRNUMX=0 F S PRNUMX=$O(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)) Q:+PRNUMX=0 D
  1. ... Q:$G(PROVINFO)=""
  1. ... I $G(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE))=PROVINFO D
  1. .... K OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX,PRTYPE)
  1. .... I $D(OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX))=1 K OUTPUT("L-PROV",IBIEN,SLC,MODEX,PRNUMX)
  1. .... I $D(OUTPUT("L-PROV",IBIEN,SLC,MODEX))=1 K OUTPUT("L-PROV",IBIEN,SLC,MODEX)
  1. .... I $D(OUTPUT("L-PROV",IBIEN,SLC))=1 K OUTPUT("L-PROV",IBIEN,SLC)
  1. Q