- ABMDVST2 ; IHS/ASDST/DMJ - PCC CLAIM STUFF - PART 3 (PROVIDER) ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;03/26/96 12:12 PM
- ;This routine loops thru the
- ;the V Provider file 3 times. First it looks for a valid MD. Then
- ;it looks for the attendings and operatings.
- ;Then it looks for additional providers for a total of up to 4
- ;including looking at ordering providers in V LAB etc.
- ;The var ABMP("MD") is used in ABMDVST4 to estimate CPT code for a
- ;doctor's visit.
- ;IHS/DSD/LSL - 03/24/98 - Undefined error on a global.
- ;Global AUPNPRV should be AUPNVPRV
- ;
- ;IHS/SD/SDR - v2.5 p9 - IM16620
- ; Removed code to make provider rendering
- ;
- Q:ABMIDONE
- N VPRVMD,DOC,DIC,DA,ABMN,ABMPC,ABMPCOD,VPROVC
- ;
- PRV ;
- ;The following code is a loop that
- ;goes thru the V provider file until it finds an
- ;"MD" then it quits the loop
- ; If it finds an MD it sets ABMP("MD")
- S ABMP("MD")=""
- S ABMN=0
- S ABM=0
- F S ABM=$O(^AUPNVPRV("AD",ABMVDFN,ABM)) Q:'ABM D Q:ABMP("MD")
- .D PROVMD(ABM)
- .I $G(VPROVC) S ABMP("MD")=VPROVC Q
- ;End of 1st loop
- ;The 2nd loop looks for attending and operating. If they are found
- ;they are filed.
- PRV2 K DIC,DD,DO
- S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",41,",DIC(0)="LE"
- S ABMOP=0
- S ABMAT=0
- ;First it loops thru the provider file
- S ABM=0
- F S ABM=$O(^AUPNVPRV("AD",ABMVDFN,ABM)) Q:'ABM D
- .Q:'$D(^AUPNVPRV(ABM,0))
- .S Y=^AUPNVPRV(ABM,0)
- .S ABMAT=$S($P(Y,U,5)="A":ABM,$P(Y,U,4)="P":ABM,1:ABMAT)
- .S ABMOP=$S($P(Y,U,5)="O":ABM,1:ABMOP)
- I 'ABMAT,ABMOP S ABMAT=ABMOP
- D:ABMAT
- .D PROVMD(ABMAT)
- .I '$G(VPROVC),ABMP("MD") S ABMAT=ABMP("MD")
- ;If the attending not found check the billing pointer visit
- I 'ABMAT D
- .N GOODP,P,V
- .S V=$P(^AUPNVSIT(ABMVDFN,0),U,28)
- .I V D
- ..S P=""
- ..F S P=$O(^AUPNVPRV("AD",V,P)) Q:'P D Q:$G(GOODP)
- ...S Y=^AUPNVPRV(P,0)
- ...S ABMAT=$S($P(Y,U,5)="A":P,$P(Y,U,4)="P":P,1:ABMAT)
- ...S ABMOP=$S($P(Y,U,5)="O":P,1:ABMOP)
- ...S GOODP=$$GOODPRV(ABMAT)
- ...Q:'GOODP
- ...S GOODP='$$UBILPRV($$DOCLASS(+Y))
- ..Q:$G(GOODP)
- ..I $$GOODPRV(ABMOP),'$$UBILPRV($$DOCLASS(+^AUPNVPRV(ABMOP,0))) D
- ...S ABMAT=ABMOP
- ...S GOODP=1
- .Q:$G(GOODP)
- .;If attending still not found check ordering provider
- .D ORDPROV
- .Q:'$D(ABMORD)
- .S P=""
- .F S P=$O(ABMORD(P)) Q:'P D Q:$G(GOODP)
- ..Q:'ABMORD(P)
- ..Q:$$UBILPRV(ABMORD(P))
- ..S GOODP=1
- ..;Format is diff because ABMAT obtained from provider file is ien
- ..S ABMAT="^"_P_"^"_ABMORD(P)
- N ABMNOFIL
- I ABMAT D
- .S X=ABMAT,ABMPCAT="A"
- .D PRVST
- E I $L(ABMAT)>1 D
- .S X=$P(ABMAT,U,2)
- .Q:'X
- .S ABMPCAT="A"
- .I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABMPCAT)) D Q
- ..S ABMNOFIL=1
- .D FILE
- I ABMOP D
- .S X=ABMOP,ABMPCAT="O"
- .D PRVST
- E I ABMP("VTYP")=111!($G(ABMP("BTYP"))=111),+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0)),ABMAT D
- .S X=ABMAT,ABMPCAT="O"
- .D PRVST
- S:$G(ABMNOFIL) (ABMAT,ABMOP)=""
- ; End of 2nd loop
- ;In the 3rd loop we first count the # of providers already filed
- ;because the max is 4.
- S ABM=0,ABMN=0
- F S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM)) Q:'ABM S ABMN=ABMN+1
- ;3rd loop
- ;We look for otheR providers not attnd or op that are billable.
- K ABMPCAT
- S ABM=0
- F S ABM=$O(^AUPNVPRV("AD",ABMVDFN,ABM)) Q:'ABM D Q:ABMN>3
- .S ABMAT=$G(ABMAT),ABMOP=$G(ABMOP)
- .Q:ABMAT=ABM
- .Q:ABMOP=ABM
- .Q:'$$GOODPRV(ABM)
- .Q:$$UBILPRV(ABMPC)
- .S X=+^AUPNVPRV(ABM,0)
- .S ABMPCAT="T"
- .D FILE
- G Q:ABMN>3
- I '$D(ABMORD) D ORDPROV
- G Q:'$D(ABMORD)
- S P=""
- F S P=$O(ABMORD(P)) Q:'P D Q:ABMN>3
- .S X=P
- .Q:X=$P(ABMAT,U,2)
- .S ABMPCAT="T"
- .D FILE
- Q K ABMORD,ABMAT,ABMOP,ABMR
- Q
- ;
- PRVCHK(X) ;Subrtn to find attending and operating
- Q:'$D(^AUPNVPRV(X,0))
- ;If provider Attending or Primary set ABMAT to ien otherwise 0
- I 'ABMAT S ABMAT=$S($P(^AUPNVPRV(X,0),U,5)="A":X,$P(^(0),U,4)="P":X,1:0)
- ;If provider Operating set ABMOP to ien otherwise 0
- I 'ABMOP S ABMOP=$S($P(^AUPNVPRV(X,0),U,5)="O":X,1:0)
- Q
- ;
- PRVST ;FILE PROVIDER
- ;Check to see if Operating/Attending already in claim file
- ;This code will only allow one attending and one operating to be filed
- I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABMPCAT)) D Q
- .S ABMNOFIL=1
- PRVST2 S X=$P(^AUPNVPRV(X,0),U)
- ;At this point X has been converted from VPRV ien to file 16 or 200 ien
- ;Checking to see if file 9000010.06 points to file 6
- ;If so convert X to file 200 ien
- ;I ^DD(9000010.06,.01,0)["DIC(6" D
- FILE Q:$$UBILPRV($$DOCLASS(X))
- I ABM("DOCFILE")=6 D
- .I $G(^DIC(16,X,"A3")) S X=^("A3") Q
- .S ABMR("PNAME")=$P(^DIC(16,X,0),U)
- .S X=$O(^VA(200,"B",ABMR("PNAME"),0))
- Q:'X
- Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",X))
- S DIC("P")=$P(^DD(9002274.3,41,0),U,2)
- S DIC("DR")=".02////"_ABMPCAT
- K DD,DO D FILE^DICN
- S ABMN=ABMN+1
- Q
- ;
- ORDPROV ;EP - Requires ABMVDFN (Visit ien) to be defined.
- ;Returns all ordering providers in ABMORD(docien)=Prov class ien
- N VFILE,L
- F VFILE="^AUPNVLAB","^AUPNVMIC","^AUPNVPTH","^AUPNVBB","^AUPNVCYT","^AUPNVMED","^AUPNVRAD" D
- .S L=0
- .F S L=$O(@VFILE@("AD",ABMVDFN,L)) Q:'L D
- ..Q:'$D(@VFILE@(L,12))
- ..S DOC=$P(@VFILE@(L,12),U,2)
- ..Q:'DOC
- ..S X=$$DOCLASS(DOC)
- ..S ABMORD(DOC)=X
- Q
- ;
- PROVMD(X) ;
- ;X contains ien of the V provider file
- ;Returns the V Provider file ien of the provider if a billable
- ;physician in var VPROVC
- Q:'$P($G(^AUPNVPRV(X,0)),U)
- S VPROVC=$$DOCLASS(+^AUPNVPRV(X,0))
- ;At this point VPROVC contains provider class file ien
- Q:'VPROVC
- PROVMD2 ;
- I $$UBILPRV(VPROVC) S VPROVC="" Q
- I '$D(^DIC(7,VPROVC,9999999)) S VPROVC="" Q
- S Y=$P(^DIC(7,VPROVC,9999999),U)
- ;Y contains provider class code
- S VPROVC=$S(Y="00"!(Y>69&(Y<87))!(Y=18)!(Y=25)!(Y=33)!(Y=44)!(Y=45)!(Y=49)!(Y=64)!(Y=68):X,1:"")
- ;Finally VPROVC contains the ien of the provider file if the
- ;provider class code is one of the accepted codes.
- ;Codes
- ;00 = Physician
- ;18 = Physician (Contract)
- ;25 = Podiatrist (Contract)
- ;33 = Podiatrist
- ;41 = OB/Gyn (Contract)
- ;44 = Physician (Tribal)
- ;45 = Osteopath
- ;49 = Contract Psychiatrist
- ;64 = Nephrologist
- ;68 = Emergency Room Physician
- ;70 to 86 = Various medical specialties
- Q
- ;
- DOCLASS(DOC) ;EP - Get provider class from either file 6 or 200
- ;DOC is the ien of either file 6 or 200 depending on which file is
- ;pointed to by file 9000010.06
- ;This function returns the ien of file 7 the provider class
- N X1
- I $D(ABM("DOCFILE")) D Q X1
- .S X1=ABM("DOCFILE")
- .S X1=$S(X1=6:$P($G(^DIC(6,DOC,0)),U,4),1:$P($G(^VA(200,DOC,"PS")),U,5))
- I ^DD(9000010.06,.01,0)["DIC(6" D Q $P($G(^DIC(6,DOC,0)),U,4)
- .S ABM("DOCFILE")=6
- I ^DD(9000010.06,.01,0)["VA(200" D Q $P($G(^VA(200,DOC,"PS")),U,5)
- .S ABM("DOCFILE")=200
- Q ""
- ;
- GOODPRV(ABM) ;Attempts to reject provider that are never valid
- ;ABM is the ien of V Provider file
- ;Returns true if accepted provider.
- Q:'$P($G(^AUPNVPRV(ABM,0)),U) 0
- S (Y,ABMPC)=$$DOCLASS(+^AUPNVPRV(ABM,0))
- Q:'Y 0
- Q:'$D(^DIC(7,Y,9999999)) 0
- S (Y,ABMPCOD)=+^DIC(7,Y,9999999)
- Q:Y<40 $S(Y<15:1,Y=15:0,Y<20:1,Y=20:0,Y=21:1,Y<24:0,Y<27:1,Y=27:0,1:1)
- Q $S(Y=40:0,Y<56:1,Y<60:0,Y=60:1,Y=61:0,Y<65:1,Y=65:0,Y<88:1,Y=88:0,1:1)
- ;List of invalid provider class codes
- ;15
- ;20
- ;22-23
- ;27
- ;40
- ;57-59
- ;61
- ;65
- ;88
- ;
- UBILPRV(PCLSS) ;Check for unbillable provider classes
- ;PCLSS is the ien of the provider class file #7.
- ;Returns true if files indicate this is an unbillable provider
- N INS,PRI,MCOUT,D2B,COV
- Q:'PCLSS 1
- I $D(^ABMDPARM(DUZ(2),1,17,PCLSS)) Q 1
- ;Look in the insurer subfile of the claim file
- ; look at first priority insurer
- ;The first pri insurer may not be the same as the 1st one in the ABML
- ;array. Hence the rtn may be able to stuff new providers into the
- ;claim for a previously created claim.
- S D2=0
- S D1=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1,""))
- S INS=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)
- I INS="" S INS=$S(ABMACTVI]"":ABMACTVI,1:ABMP("INS"))
- ;Vis type 111 is inpatient
- I ABMP("VTYP")'=111 D
- .;Compares prim insurer in claim file with ins in ABML array
- .S PRI=0
- .F S PRI=$O(ABML(PRI)) Q:'PRI D Q:$D(MCOUT)
- ..Q:'$D(ABML(PRI,INS))
- ..S MCOUT=$S($P(ABML(PRI,INS),U,3)?1(1"M",1"R"):1,1:0)
- ..Q:'MCOUT
- ..;If there is coverage type B store ien in D2B
- ..S COV=0,D2B=""
- ..F S COV=$O(ABML(PRI,INS,"COV",COV)) Q:'COV D
- ...Q:ABML(PRI,INS,"COV",COV)'="B"
- ...S D2B=COV
- ;Get the coverage type
- N QFLG
- S QFLG=0
- I 'D1,INS]"" S D1=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",INS,""))
- I 'D1 Q QFLG
- F S D2=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,D1,11,D2)) Q:'D2 D
- .;If Medicare or RR outpat only look at coverage type B
- .I $G(MCOUT),D2'=D2B Q
- .;Check if an unbillable provider discipline in coverage file
- .I $D(^AUTTPIC(D2,15,PCLSS)) S QFLG=1
- .E S QFLG=0
- Q QFLG
- ABMDVST2 ; IHS/ASDST/DMJ - PCC CLAIM STUFF - PART 3 (PROVIDER) ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;03/26/96 12:12 PM
- +3 ;This routine loops thru the
- +4 ;the V Provider file 3 times. First it looks for a valid MD. Then
- +5 ;it looks for the attendings and operatings.
- +6 ;Then it looks for additional providers for a total of up to 4
- +7 ;including looking at ordering providers in V LAB etc.
- +8 ;The var ABMP("MD") is used in ABMDVST4 to estimate CPT code for a
- +9 ;doctor's visit.
- +10 ;IHS/DSD/LSL - 03/24/98 - Undefined error on a global.
- +11 ;Global AUPNPRV should be AUPNVPRV
- +12 ;
- +13 ;IHS/SD/SDR - v2.5 p9 - IM16620
- +14 ; Removed code to make provider rendering
- +15 ;
- +16 IF ABMIDONE
- QUIT
- +17 NEW VPRVMD,DOC,DIC,DA,ABMN,ABMPC,ABMPCOD,VPROVC
- +18 ;
- PRV ;
- +1 ;The following code is a loop that
- +2 ;goes thru the V provider file until it finds an
- +3 ;"MD" then it quits the loop
- +4 ; If it finds an MD it sets ABMP("MD")
- +5 SET ABMP("MD")=""
- +6 SET ABMN=0
- +7 SET ABM=0
- +8 FOR
- SET ABM=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABM))
- IF 'ABM
- QUIT
- Begin DoDot:1
- +9 DO PROVMD(ABM)
- +10 IF $GET(VPROVC)
- SET ABMP("MD")=VPROVC
- QUIT
- End DoDot:1
- IF ABMP("MD")
- QUIT
- +11 ;End of 1st loop
- +12 ;The 2nd loop looks for attending and operating. If they are found
- +13 ;they are filed.
- PRV2 KILL DIC,DD,DO
- +1 SET DA(1)=ABMP("CDFN")
- SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",41,"
- SET DIC(0)="LE"
- +2 SET ABMOP=0
- +3 SET ABMAT=0
- +4 ;First it loops thru the provider file
- +5 SET ABM=0
- +6 FOR
- SET ABM=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABM))
- IF 'ABM
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^AUPNVPRV(ABM,0))
- QUIT
- +8 SET Y=^AUPNVPRV(ABM,0)
- +9 SET ABMAT=$SELECT($PIECE(Y,U,5)="A":ABM,$PIECE(Y,U,4)="P":ABM,1:ABMAT)
- +10 SET ABMOP=$SELECT($PIECE(Y,U,5)="O":ABM,1:ABMOP)
- End DoDot:1
- +11 IF 'ABMAT
- IF ABMOP
- SET ABMAT=ABMOP
- +12 IF ABMAT
- Begin DoDot:1
- +13 DO PROVMD(ABMAT)
- +14 IF '$GET(VPROVC)
- IF ABMP("MD")
- SET ABMAT=ABMP("MD")
- End DoDot:1
- +15 ;If the attending not found check the billing pointer visit
- +16 IF 'ABMAT
- Begin DoDot:1
- +17 NEW GOODP,P,V
- +18 SET V=$PIECE(^AUPNVSIT(ABMVDFN,0),U,28)
- +19 IF V
- Begin DoDot:2
- +20 SET P=""
- +21 FOR
- SET P=$ORDER(^AUPNVPRV("AD",V,P))
- IF 'P
- QUIT
- Begin DoDot:3
- +22 SET Y=^AUPNVPRV(P,0)
- +23 SET ABMAT=$SELECT($PIECE(Y,U,5)="A":P,$PIECE(Y,U,4)="P":P,1:ABMAT)
- +24 SET ABMOP=$SELECT($PIECE(Y,U,5)="O":P,1:ABMOP)
- +25 SET GOODP=$$GOODPRV(ABMAT)
- +26 IF 'GOODP
- QUIT
- +27 SET GOODP='$$UBILPRV($$DOCLASS(+Y))
- End DoDot:3
- IF $GET(GOODP)
- QUIT
- +28 IF $GET(GOODP)
- QUIT
- +29 IF $$GOODPRV(ABMOP)
- IF '$$UBILPRV($$DOCLASS(+^AUPNVPRV(ABMOP,0)))
- Begin DoDot:3
- +30 SET ABMAT=ABMOP
- +31 SET GOODP=1
- End DoDot:3
- End DoDot:2
- +32 IF $GET(GOODP)
- QUIT
- +33 ;If attending still not found check ordering provider
- +34 DO ORDPROV
- +35 IF '$DATA(ABMORD)
- QUIT
- +36 SET P=""
- +37 FOR
- SET P=$ORDER(ABMORD(P))
- IF 'P
- QUIT
- Begin DoDot:2
- +38 IF 'ABMORD(P)
- QUIT
- +39 IF $$UBILPRV(ABMORD(P))
- QUIT
- +40 SET GOODP=1
- +41 ;Format is diff because ABMAT obtained from provider file is ien
- +42 SET ABMAT="^"_P_"^"_ABMORD(P)
- End DoDot:2
- IF $GET(GOODP)
- QUIT
- End DoDot:1
- +43 NEW ABMNOFIL
- +44 IF ABMAT
- Begin DoDot:1
- +45 SET X=ABMAT
- SET ABMPCAT="A"
- +46 DO PRVST
- End DoDot:1
- +47 IF '$TEST
- IF $LENGTH(ABMAT)>1
- Begin DoDot:1
- +48 SET X=$PIECE(ABMAT,U,2)
- +49 IF 'X
- QUIT
- +50 SET ABMPCAT="A"
- +51 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABMPCAT))
- Begin DoDot:2
- +52 SET ABMNOFIL=1
- End DoDot:2
- QUIT
- +53 DO FILE
- End DoDot:1
- +54 IF ABMOP
- Begin DoDot:1
- +55 SET X=ABMOP
- SET ABMPCAT="O"
- +56 DO PRVST
- End DoDot:1
- +57 IF '$TEST
- IF ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111)
- IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0))
- IF ABMAT
- Begin DoDot:1
- +58 SET X=ABMAT
- SET ABMPCAT="O"
- +59 DO PRVST
- End DoDot:1
- +60 IF $GET(ABMNOFIL)
- SET (ABMAT,ABMOP)=""
- +61 ; End of 2nd loop
- +62 ;In the 3rd loop we first count the # of providers already filed
- +63 ;because the max is 4.
- +64 SET ABM=0
- SET ABMN=0
- +65 FOR
- SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM))
- IF 'ABM
- QUIT
- SET ABMN=ABMN+1
- +66 ;3rd loop
- +67 ;We look for otheR providers not attnd or op that are billable.
- +68 KILL ABMPCAT
- +69 SET ABM=0
- +70 FOR
- SET ABM=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABM))
- IF 'ABM
- QUIT
- Begin DoDot:1
- +71 SET ABMAT=$GET(ABMAT)
- SET ABMOP=$GET(ABMOP)
- +72 IF ABMAT=ABM
- QUIT
- +73 IF ABMOP=ABM
- QUIT
- +74 IF '$$GOODPRV(ABM)
- QUIT
- +75 IF $$UBILPRV(ABMPC)
- QUIT
- +76 SET X=+^AUPNVPRV(ABM,0)
- +77 SET ABMPCAT="T"
- +78 DO FILE
- End DoDot:1
- IF ABMN>3
- QUIT
- +79 IF ABMN>3
- GOTO Q
- +80 IF '$DATA(ABMORD)
- DO ORDPROV
- +81 IF '$DATA(ABMORD)
- GOTO Q
- +82 SET P=""
- +83 FOR
- SET P=$ORDER(ABMORD(P))
- IF 'P
- QUIT
- Begin DoDot:1
- +84 SET X=P
- +85 IF X=$PIECE(ABMAT,U,2)
- QUIT
- +86 SET ABMPCAT="T"
- +87 DO FILE
- End DoDot:1
- IF ABMN>3
- QUIT
- Q KILL ABMORD,ABMAT,ABMOP,ABMR
- +1 QUIT
- +2 ;
- PRVCHK(X) ;Subrtn to find attending and operating
- +1 IF '$DATA(^AUPNVPRV(X,0))
- QUIT
- +2 ;If provider Attending or Primary set ABMAT to ien otherwise 0
- +3 IF 'ABMAT
- SET ABMAT=$SELECT($PIECE(^AUPNVPRV(X,0),U,5)="A":X,$PIECE(^(0),U,4)="P":X,1:0)
- +4 ;If provider Operating set ABMOP to ien otherwise 0
- +5 IF 'ABMOP
- SET ABMOP=$SELECT($PIECE(^AUPNVPRV(X,0),U,5)="O":X,1:0)
- +6 QUIT
- +7 ;
- PRVST ;FILE PROVIDER
- +1 ;Check to see if Operating/Attending already in claim file
- +2 ;This code will only allow one attending and one operating to be filed
- +3 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABMPCAT))
- Begin DoDot:1
- +4 SET ABMNOFIL=1
- End DoDot:1
- QUIT
- PRVST2 SET X=$PIECE(^AUPNVPRV(X,0),U)
- +1 ;At this point X has been converted from VPRV ien to file 16 or 200 ien
- +2 ;Checking to see if file 9000010.06 points to file 6
- +3 ;If so convert X to file 200 ien
- +4 ;I ^DD(9000010.06,.01,0)["DIC(6" D
- FILE IF $$UBILPRV($$DOCLASS(X))
- QUIT
- +1 IF ABM("DOCFILE")=6
- Begin DoDot:1
- +2 IF $GET(^DIC(16,X,"A3"))
- SET X=^("A3")
- QUIT
- +3 SET ABMR("PNAME")=$PIECE(^DIC(16,X,0),U)
- +4 SET X=$ORDER(^VA(200,"B",ABMR("PNAME"),0))
- End DoDot:1
- +5 IF 'X
- QUIT
- +6 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"B",X))
- QUIT
- +7 SET DIC("P")=$PIECE(^DD(9002274.3,41,0),U,2)
- +8 SET DIC("DR")=".02////"_ABMPCAT
- +9 KILL DD,DO
- DO FILE^DICN
- +10 SET ABMN=ABMN+1
- +11 QUIT
- +12 ;
- ORDPROV ;EP - Requires ABMVDFN (Visit ien) to be defined.
- +1 ;Returns all ordering providers in ABMORD(docien)=Prov class ien
- +2 NEW VFILE,L
- +3 FOR VFILE="^AUPNVLAB","^AUPNVMIC","^AUPNVPTH","^AUPNVBB","^AUPNVCYT","^AUPNVMED","^AUPNVRAD"
- Begin DoDot:1
- +4 SET L=0
- +5 FOR
- SET L=$ORDER(@VFILE@("AD",ABMVDFN,L))
- IF 'L
- QUIT
- Begin DoDot:2
- +6 IF '$DATA(@VFILE@(L,12))
- QUIT
- +7 SET DOC=$PIECE(@VFILE@(L,12),U,2)
- +8 IF 'DOC
- QUIT
- +9 SET X=$$DOCLASS(DOC)
- +10 SET ABMORD(DOC)=X
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- PROVMD(X) ;
- +1 ;X contains ien of the V provider file
- +2 ;Returns the V Provider file ien of the provider if a billable
- +3 ;physician in var VPROVC
- +4 IF '$PIECE($GET(^AUPNVPRV(X,0)),U)
- QUIT
- +5 SET VPROVC=$$DOCLASS(+^AUPNVPRV(X,0))
- +6 ;At this point VPROVC contains provider class file ien
- +7 IF 'VPROVC
- QUIT
- PROVMD2 ;
- +1 IF $$UBILPRV(VPROVC)
- SET VPROVC=""
- QUIT
- +2 IF '$DATA(^DIC(7,VPROVC,9999999))
- SET VPROVC=""
- QUIT
- +3 SET Y=$PIECE(^DIC(7,VPROVC,9999999),U)
- +4 ;Y contains provider class code
- +5 SET VPROVC=$SELECT(Y="00"!(Y>69&(Y<87))!(Y=18)!(Y=25)!(Y=33)!(Y=44)!(Y=45)!(Y=49)!(Y=64)!(Y=68):X,1:"")
- +6 ;Finally VPROVC contains the ien of the provider file if the
- +7 ;provider class code is one of the accepted codes.
- +8 ;Codes
- +9 ;00 = Physician
- +10 ;18 = Physician (Contract)
- +11 ;25 = Podiatrist (Contract)
- +12 ;33 = Podiatrist
- +13 ;41 = OB/Gyn (Contract)
- +14 ;44 = Physician (Tribal)
- +15 ;45 = Osteopath
- +16 ;49 = Contract Psychiatrist
- +17 ;64 = Nephrologist
- +18 ;68 = Emergency Room Physician
- +19 ;70 to 86 = Various medical specialties
- +20 QUIT
- +21 ;
- DOCLASS(DOC) ;EP - Get provider class from either file 6 or 200
- +1 ;DOC is the ien of either file 6 or 200 depending on which file is
- +2 ;pointed to by file 9000010.06
- +3 ;This function returns the ien of file 7 the provider class
- +4 NEW X1
- +5 IF $DATA(ABM("DOCFILE"))
- Begin DoDot:1
- +6 SET X1=ABM("DOCFILE")
- +7 SET X1=$SELECT(X1=6:$PIECE($GET(^DIC(6,DOC,0)),U,4),1:$PIECE($GET(^VA(200,DOC,"PS")),U,5))
- End DoDot:1
- QUIT X1
- +8 IF ^DD(9000010.06,.01,0)["DIC(6"
- Begin DoDot:1
- +9 SET ABM("DOCFILE")=6
- End DoDot:1
- QUIT $PIECE($GET(^DIC(6,DOC,0)),U,4)
- +10 IF ^DD(9000010.06,.01,0)["VA(200"
- Begin DoDot:1
- +11 SET ABM("DOCFILE")=200
- End DoDot:1
- QUIT $PIECE($GET(^VA(200,DOC,"PS")),U,5)
- +12 QUIT ""
- +13 ;
- GOODPRV(ABM) ;Attempts to reject provider that are never valid
- +1 ;ABM is the ien of V Provider file
- +2 ;Returns true if accepted provider.
- +3 IF '$PIECE($GET(^AUPNVPRV(ABM,0)),U)
- QUIT 0
- +4 SET (Y,ABMPC)=$$DOCLASS(+^AUPNVPRV(ABM,0))
- +5 IF 'Y
- QUIT 0
- +6 IF '$DATA(^DIC(7,Y,9999999))
- QUIT 0
- +7 SET (Y,ABMPCOD)=+^DIC(7,Y,9999999)
- +8 IF Y<40
- QUIT $SELECT(Y<15:1,Y=15:0,Y<20:1,Y=20:0,Y=21:1,Y<24:0,Y<27:1,Y=27:0,1:1)
- +9 QUIT $SELECT(Y=40:0,Y<56:1,Y<60:0,Y=60:1,Y=61:0,Y<65:1,Y=65:0,Y<88:1,Y=88:0,1:1)
- +10 ;List of invalid provider class codes
- +11 ;15
- +12 ;20
- +13 ;22-23
- +14 ;27
- +15 ;40
- +16 ;57-59
- +17 ;61
- +18 ;65
- +19 ;88
- +20 ;
- UBILPRV(PCLSS) ;Check for unbillable provider classes
- +1 ;PCLSS is the ien of the provider class file #7.
- +2 ;Returns true if files indicate this is an unbillable provider
- +3 NEW INS,PRI,MCOUT,D2B,COV
- +4 IF 'PCLSS
- QUIT 1
- +5 IF $DATA(^ABMDPARM(DUZ(2),1,17,PCLSS))
- QUIT 1
- +6 ;Look in the insurer subfile of the claim file
- +7 ; look at first priority insurer
- +8 ;The first pri insurer may not be the same as the 1st one in the ABML
- +9 ;array. Hence the rtn may be able to stuff new providers into the
- +10 ;claim for a previously created claim.
- +11 SET D2=0
- +12 SET D1=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1,""))
- +13 SET INS=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)
- +14 IF INS=""
- SET INS=$SELECT(ABMACTVI]"":ABMACTVI,1:ABMP("INS"))
- +15 ;Vis type 111 is inpatient
- +16 IF ABMP("VTYP")'=111
- Begin DoDot:1
- +17 ;Compares prim insurer in claim file with ins in ABML array
- +18 SET PRI=0
- +19 FOR
- SET PRI=$ORDER(ABML(PRI))
- IF 'PRI
- QUIT
- Begin DoDot:2
- +20 IF '$DATA(ABML(PRI,INS))
- QUIT
- +21 SET MCOUT=$SELECT($PIECE(ABML(PRI,INS),U,3)?1(1"M",1"R"):1,1:0)
- +22 IF 'MCOUT
- QUIT
- +23 ;If there is coverage type B store ien in D2B
- +24 SET COV=0
- SET D2B=""
- +25 FOR
- SET COV=$ORDER(ABML(PRI,INS,"COV",COV))
- IF 'COV
- QUIT
- Begin DoDot:3
- +26 IF ABML(PRI,INS,"COV",COV)'="B"
- QUIT
- +27 SET D2B=COV
- End DoDot:3
- End DoDot:2
- IF $DATA(MCOUT)
- QUIT
- End DoDot:1
- +28 ;Get the coverage type
- +29 NEW QFLG
- +30 SET QFLG=0
- +31 IF 'D1
- IF INS]""
- SET D1=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",INS,""))
- +32 IF 'D1
- QUIT QFLG
- +33 FOR
- SET D2=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,D1,11,D2))
- IF 'D2
- QUIT
- Begin DoDot:1
- +34 ;If Medicare or RR outpat only look at coverage type B
- +35 IF $GET(MCOUT)
- IF D2'=D2B
- QUIT
- +36 ;Check if an unbillable provider discipline in coverage file
- +37 IF $DATA(^AUTTPIC(D2,15,PCLSS))
- SET QFLG=1
- +38 IF '$TEST
- SET QFLG=0
- End DoDot:1
- +39 QUIT QFLG