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

ABMDVST2.m

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