BMENED15 ; IHS/PHXAO/TMJ - -- Billing ; [ 06/11/03 3:35 PM ]
;Revised version of AZAMED12. Daily rate increased from $233.00 to
; $241.00 beginning Jan 1,1997
;
A ; -- driver
;G ^AZAMEDNO ;IHS/ANMC/FBD-6/17/97-ADDED LINE
D BD I BD<1 D Q Q
D ED I ED<1 D Q Q
D TN I $D(DIRUT) D Q Q
D LV Q
;
BD ; -- beginning date
S %DT="AEQ",%DT("A")="Select beg date: ",X="" D ^%DT S BD=Y-.0001 Q
;
ED ; -- end date
S %DT="AEQ",%DT("A")="Select end date: ",X="" D ^%DT S ED=Y+.9999 Q
;
TN ; -- transmittal number
N DIR,X,Y S DIR(0)="F^5:10",DIR("A")="Enter Transmittal Number"
D ^DIR S T=Y Q
;
LV ; -- loop visits
S VDT=BD F S VDT=$O(^AUPNVSIT("B",VDT)) Q:'VDT Q:VDT>ED D
. S IEN=0 F S IEN=$O(^AUPNVSIT("B",VDT,IEN)) Q:'IEN D
.. S N=$G(^AUPNVSIT(IEN,0)) Q:'N Q:$P(N,U,11) Q:$P(N,U,6)'=DUZ(2)
.. S DFN=$P(N,U,5) Q:'DFN
.. Q:$P(N,U,8)=36 ;dental
.. ;Q:$$CB'=1 ;non indian beneficiary
.. I $$MCD,'$$PRV,'$$DS,'$$URC,'$$AV,'$$MCR,'$$INP,$$ICD'="" D 1
Q
;
1 ; -- create entry
N DIC,DINUM,X,DR,DIE,DA,ICD K DD,DO
S DIC="^DIZ(1115238,",DIC(0)="L",(DINUM,X)=IEN
S DIC("DR")=".02////3;.03////^S X=DFN" D FILE^DICN
; -- stuff additional fields
S DIE=DIC,DA=IEN
S DR=".04///^S X=$$ICD^AZAMED8;.05////^S X=$P(N,U,8)"
S DR=DR_";.06////^S X=$$ES^AZAMED8;.07////^S X=$$CB^AZAMED8"
;S DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""147.00"""
;S DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""159.00""" ;SFB 2/1/95
S DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""241.00""" ;IHS/ANMC/FBD-2/13/97
S DR=DR_";.11////^S X=$$MCDC^AZAMED8;.12////^S X=$$MCDN^AZAMED8"
;S DR=DR_";.13////^S X=T;.14////^S X=DT;.15///^S X=$$HRCN^ADGF" ;IHS/ANMC/FBD-6/24/96-CHANGED ^DGZF RTN REF TO ^ADGF
S DR=DR_";.13////^S X=T;.14////^S X=DT;.15///^S X=$$HRCN^AZAMED" ;IHS/ANMC/LJF 1/21/99 keep calls within namespace
;S DR=DR_";.18////^S X=$$P" ;IHS/ANMC/CLS 10/12/95
D ^DIE Q
;
MCDC() ; -- medicaid eligibility code
Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,3)
;
MCDN() ; -- medicaid eligibility number
Q $P($G(^AUPNMCD(+$$MCDI,0)),U,3)
;
MCDI() ; -- medicaid eligible ien
Q $O(^AUPNMCD("B",DFN,0))
;
MCDM(X,Y) ; -- medicaid eligible multiple ien
S (Y,X)=0 F S X=$O(^AUPNMCD(+$$MCDI,11,X)) Q:'X D Q:Y
. S Y=$G(^AUPNMCD(+$$MCDI,11,+X,0))
. S:Y Y=$S($P(Y,U,2)>VDT:1,'$P(Y,U,2):1,1:0)
Q X
;
;Q $O(^AUPNMCD(+$$MCDI,11,VDT),-1)
;
MCDE() ; -- medicaid eligible end date
Q $P($G(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,2)
;
MCD(X,Y) ; -- medicaid eligible
S (Y,X)=0 F S X=$O(^AUPNMCD(+$$MCDI,11,X)) Q:Y Q:'X D
. S Y=$G(^AUPNMCD(+$$MCDI,11,+X,0))
. S:Y Y=$S($P(Y,U,2)>VDT:1,'$P(Y,U,2):1,1:0)
Q Y
;
;Q $S($$MCDE>VDT:1,1:0)
;
URC() ; -- urc billing file
Q $O(^DIZ(1115238,"B",IEN,0))
;
MCRI() ; -- medicare eligible ien
Q $O(^AUPNMCR("B",DFN,0))
;
MCRM() ; -- medicare eligible multiple ien
Q $O(^AUPNMCR(+$$MCRI,11,VDT),-1)
;
MCRE() ; -- medicare eligible end date
Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,2)
;
MCRB() ; -- medicare eligible eligibility
Q $P($G(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,3)
;
MCR() ; -- medicare eligible
Q $S($$MCRE>VDT:1,$$MCRB="B":1,($$MCRM&'$$MCRE):1,1:0)
;
INP() ; -- inpatient
Q $S('$$INPI:0,$P(VDT,".")<$P($$INPV,"."):0,$P(VDT,".")>$P($$INPD,"."):0,1:1)
;
INPD() ; -- inpatient discharge date
Q +$G(^AUPNVINP(+$$INPI,0))
;
INPV() ; -- inpatient visit date
Q +$G(^AUPNVSIT(+$P($G(^AUPNVINP(+$$INPI,0)),U,3),0))
;
INPI() ; -- inpatient ien
Q $O(^AUPNVINP("AA",+DFN,+$O(^AUPNVINP("AA",+DFN,$$ID($P(VDT,"."))),-1),0))
;
ID(X) ; -- inverse date
Q 9999999-X
;
ICD() ;
N ICD,FLG,IFN S (ICD,FLG,IFN)=""
F S IFN=$O(^AUPNVPOV("AD",IEN,IFN)) Q:'IFN Q:FLG D
. S ICD=$P($G(^ICD9(+$G(^AUPNVPOV(+IFN,0)),0)),U)
. I ICD=".0860" S ICD="" Q
. I ICD=799.90 S ICD="" Q
. I ICD D S FLG=+ICD Q:FLG
.. I ICD>302.99,ICD<303.90 S ICD="" Q
.. I ICD>303.90,ICD<303.94 S ICD="" Q
.. I ICD>303.99,ICD<305.04 S ICD="" Q
.. I ICD>305.29,ICD<305.54 S ICD="" Q
.. I ICD>305.69,ICD<305.94 S ICD="" Q
.. I '$$U21,ICD>369.99,ICD<390.00 S ICD="" Q ;effective 9/1/94
. Q:'$P(ICD,"V",2)
. I $O(^DIZ(1115233,"B",$P(ICD,"V",2),0)) S FLG=1 Q
. I $P(ICD,"V",2)>01.00,$P(ICD,"V",2)<20.00 S FLG=1 Q
. I $P(ICD,"V",2)>21.99,$P(ICD,"V",2)<38.00 S FLG=1 Q
. I $P(ICD,"V",2)>72.19,$P(ICD,"V",2)<77.80 S FLG=1 Q ;changed 9/1/94
. I $P(ICD,"V",2)>78.99,$P(ICD,"V",2)<83.00 S FLG=1 Q
. I $$U21,$P(ICD,"V",2)>20.00,$P(ICD,"V",2)<22.00 S FLG=1 Q
. I $$U21,$P(ICD,"V",2)>70.00,$P(ICD,"V",2)<71.00 S FLG=1 Q
. I $$U21,$P(ICD,"V",2)>71.99,$P(ICD,"V",2)<72.01 S FLG=1 Q ;eff 9/1
. I $$U21,$P(ICD,"V",2)>77.99,$P(ICD,"V",2)<78.99 S FLG=1 Q
. S ICD=""
Q ICD
;
DT(Y) ;
X ^DD("DD") Q Y
;
U21() ; -- under 21 years of age
N X,X1,X2 S X1=DT,X2=$P(^DPT(DFN,0),U,3) D ^%DTC
Q $S((X\365.25)<21:1,1:0)
;
DS() ; -- day surgery
Q $S($P($G(^AUPNVSIT(IEN,0)),U,7)="S":1,1:0) ;IHS/ANMC/LJF 1/21/99
;Q $O(^ADGDS("AD",DFN,$P(VDT,"."),0)) we don't use ^ADGDS anymore
;Q $S($P(N,U,8)'=65:0,$O(^AUPNVPRC("AD",IEN,0)):1,1:0)
;
ES() ; -- eligibility status
Q $P($G(^AUPNPAT(+DFN,11)),U,12)
;
CB() ; -- classification/beneficiary
Q $P($G(^AUPNPAT(+DFN,11)),U,11)
;
P() ; -- provider
Q +$G(^AUPNVPRV(+$O(^AUPNVPRV("AD",+N,0)),0))
;
PRVI() ; -- private insurance
Q $O(^AUPNPRVT("B",DFN,0))
;
PRVM() ; -- private insurance eligible multiple ien
Q $O(^AUPNPRVT(+$$PRVI,11,VDT),-1)
;
PRVE() ; -- private insurance eligible end date
Q $P($G(^AUPNPRVT(+$$PRVI,11,+$$PRVM,0)),U,2)
;
PRVX() ; -- private insurance eligible
Q $S($$PRVE>VDT:1,($$PRVM&'$$PRVE):1,1:0)
;
AV(X,Y) ; -- visit same day
S (Y,X)=0 F S X=$O(^DIZ(1115238,"AV",DFN,$P(VDT,"."),X)) Q:Y Q:'X D
. S Y=$G(^DIZ(1115238,X,0)) S:Y Y=$S($P(Y,U,21):0,1:1)
Q Y
;
Q ; -- cleanup
K BD,ED,T,DFN,VDT,DIRUT,N,IEN Q
;
PRV() ;
N N,X,Y S (X,Y)=0 F S X=$O(^AUPNPRVT(DFN,11,X)) Q:'X D
. S N=^AUPNPRVT(DFN,11,X,0) Q:$P(N,U,6)>VDT
. I $P(N,U,7),$P(N,U,7)<VDT Q
. S Y=1
Q Y
BMENED15 ; IHS/PHXAO/TMJ - -- Billing ; [ 06/11/03 3:35 PM ]
+1 ;Revised version of AZAMED12. Daily rate increased from $233.00 to
+2 ; $241.00 beginning Jan 1,1997
+3 ;
A ; -- driver
+1 ;G ^AZAMEDNO ;IHS/ANMC/FBD-6/17/97-ADDED LINE
+2 DO BD
IF BD<1
DO Q
QUIT
+3 DO ED
IF ED<1
DO Q
QUIT
+4 DO TN
IF $DATA(DIRUT)
DO Q
QUIT
+5 DO LV
QUIT
+6 ;
BD ; -- beginning date
+1 SET %DT="AEQ"
SET %DT("A")="Select beg date: "
SET X=""
DO ^%DT
SET BD=Y-.0001
QUIT
+2 ;
ED ; -- end date
+1 SET %DT="AEQ"
SET %DT("A")="Select end date: "
SET X=""
DO ^%DT
SET ED=Y+.9999
QUIT
+2 ;
TN ; -- transmittal number
+1 NEW DIR,X,Y
SET DIR(0)="F^5:10"
SET DIR("A")="Enter Transmittal Number"
+2 DO ^DIR
SET T=Y
QUIT
+3 ;
LV ; -- loop visits
+1 SET VDT=BD
FOR
SET VDT=$ORDER(^AUPNVSIT("B",VDT))
IF 'VDT
QUIT
IF VDT>ED
QUIT
Begin DoDot:1
+2 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("B",VDT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+3 SET N=$GET(^AUPNVSIT(IEN,0))
IF 'N
QUIT
IF $PIECE(N,U,11)
QUIT
IF $PIECE(N,U,6)'=DUZ(2)
QUIT
+4 SET DFN=$PIECE(N,U,5)
IF 'DFN
QUIT
+5 ;dental
IF $PIECE(N,U,8)=36
QUIT
+6 ;Q:$$CB'=1 ;non indian beneficiary
+7 IF $$MCD
IF '$$PRV
IF '$$DS
IF '$$URC
IF '$$AV
IF '$$MCR
IF '$$INP
IF $$ICD'=""
DO 1
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
1 ; -- create entry
+1 NEW DIC,DINUM,X,DR,DIE,DA,ICD
KILL DD,DO
+2 SET DIC="^DIZ(1115238,"
SET DIC(0)="L"
SET (DINUM,X)=IEN
+3 SET DIC("DR")=".02////3;.03////^S X=DFN"
DO FILE^DICN
+4 ; -- stuff additional fields
+5 SET DIE=DIC
SET DA=IEN
+6 SET DR=".04///^S X=$$ICD^AZAMED8;.05////^S X=$P(N,U,8)"
+7 SET DR=DR_";.06////^S X=$$ES^AZAMED8;.07////^S X=$$CB^AZAMED8"
+8 ;S DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""147.00"""
+9 ;S DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""159.00""" ;SFB 2/1/95
+10 ;IHS/ANMC/FBD-2/13/97
SET DR=DR_";.08////^S X=$P(N,U,7);.09///^S X=""241.00"""
+11 SET DR=DR_";.11////^S X=$$MCDC^AZAMED8;.12////^S X=$$MCDN^AZAMED8"
+12 ;S DR=DR_";.13////^S X=T;.14////^S X=DT;.15///^S X=$$HRCN^ADGF" ;IHS/ANMC/FBD-6/24/96-CHANGED ^DGZF RTN REF TO ^ADGF
+13 ;IHS/ANMC/LJF 1/21/99 keep calls within namespace
SET DR=DR_";.13////^S X=T;.14////^S X=DT;.15///^S X=$$HRCN^AZAMED"
+14 ;S DR=DR_";.18////^S X=$$P" ;IHS/ANMC/CLS 10/12/95
+15 DO ^DIE
QUIT
+16 ;
MCDC() ; -- medicaid eligibility code
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,3)
+2 ;
MCDN() ; -- medicaid eligibility number
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,0)),U,3)
+2 ;
MCDI() ; -- medicaid eligible ien
+1 QUIT $ORDER(^AUPNMCD("B",DFN,0))
+2 ;
MCDM(X,Y) ; -- medicaid eligible multiple ien
+1 SET (Y,X)=0
FOR
SET X=$ORDER(^AUPNMCD(+$$MCDI,11,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET Y=$GET(^AUPNMCD(+$$MCDI,11,+X,0))
+3 IF Y
SET Y=$SELECT($PIECE(Y,U,2)>VDT:1,'$PIECE(Y,U,2):1,1:0)
End DoDot:1
IF Y
QUIT
+4 QUIT X
+5 ;
+6 ;Q $O(^AUPNMCD(+$$MCDI,11,VDT),-1)
+7 ;
MCDE() ; -- medicaid eligible end date
+1 QUIT $PIECE($GET(^AUPNMCD(+$$MCDI,11,+$$MCDM,0)),U,2)
+2 ;
MCD(X,Y) ; -- medicaid eligible
+1 SET (Y,X)=0
FOR
SET X=$ORDER(^AUPNMCD(+$$MCDI,11,X))
IF Y
QUIT
IF 'X
QUIT
Begin DoDot:1
+2 SET Y=$GET(^AUPNMCD(+$$MCDI,11,+X,0))
+3 IF Y
SET Y=$SELECT($PIECE(Y,U,2)>VDT:1,'$PIECE(Y,U,2):1,1:0)
End DoDot:1
+4 QUIT Y
+5 ;
+6 ;Q $S($$MCDE>VDT:1,1:0)
+7 ;
URC() ; -- urc billing file
+1 QUIT $ORDER(^DIZ(1115238,"B",IEN,0))
+2 ;
MCRI() ; -- medicare eligible ien
+1 QUIT $ORDER(^AUPNMCR("B",DFN,0))
+2 ;
MCRM() ; -- medicare eligible multiple ien
+1 QUIT $ORDER(^AUPNMCR(+$$MCRI,11,VDT),-1)
+2 ;
MCRE() ; -- medicare eligible end date
+1 QUIT $PIECE($GET(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,2)
+2 ;
MCRB() ; -- medicare eligible eligibility
+1 QUIT $PIECE($GET(^AUPNMCR(+$$MCRI,11,+$$MCRM,0)),U,3)
+2 ;
MCR() ; -- medicare eligible
+1 QUIT $SELECT($$MCRE>VDT:1,$$MCRB="B":1,($$MCRM&'$$MCRE):1,1:0)
+2 ;
INP() ; -- inpatient
+1 QUIT $SELECT('$$INPI:0,$PIECE(VDT,".")<$PIECE($$INPV,"."):0,$PIECE(VDT,".")>$PIECE($$INPD,"."):0,1:1)
+2 ;
INPD() ; -- inpatient discharge date
+1 QUIT +$GET(^AUPNVINP(+$$INPI,0))
+2 ;
INPV() ; -- inpatient visit date
+1 QUIT +$GET(^AUPNVSIT(+$PIECE($GET(^AUPNVINP(+$$INPI,0)),U,3),0))
+2 ;
INPI() ; -- inpatient ien
+1 QUIT $ORDER(^AUPNVINP("AA",+DFN,+$ORDER(^AUPNVINP("AA",+DFN,$$ID($PIECE(VDT,"."))),-1),0))
+2 ;
ID(X) ; -- inverse date
+1 QUIT 9999999-X
+2 ;
ICD() ;
+1 NEW ICD,FLG,IFN
SET (ICD,FLG,IFN)=""
+2 FOR
SET IFN=$ORDER(^AUPNVPOV("AD",IEN,IFN))
IF 'IFN
QUIT
IF FLG
QUIT
Begin DoDot:1
+3 SET ICD=$PIECE($GET(^ICD9(+$GET(^AUPNVPOV(+IFN,0)),0)),U)
+4 IF ICD=".0860"
SET ICD=""
QUIT
+5 IF ICD=799.90
SET ICD=""
QUIT
+6 IF ICD
Begin DoDot:2
+7 IF ICD>302.99
IF ICD<303.90
SET ICD=""
QUIT
+8 IF ICD>303.90
IF ICD<303.94
SET ICD=""
QUIT
+9 IF ICD>303.99
IF ICD<305.04
SET ICD=""
QUIT
+10 IF ICD>305.29
IF ICD<305.54
SET ICD=""
QUIT
+11 IF ICD>305.69
IF ICD<305.94
SET ICD=""
QUIT
+12 ;effective 9/1/94
IF '$$U21
IF ICD>369.99
IF ICD<390.00
SET ICD=""
QUIT
End DoDot:2
SET FLG=+ICD
IF FLG
QUIT
+13 IF '$PIECE(ICD,"V",2)
QUIT
+14 IF $ORDER(^DIZ(1115233,"B",$PIECE(ICD,"V",2),0))
SET FLG=1
QUIT
+15 IF $PIECE(ICD,"V",2)>01.00
IF $PIECE(ICD,"V",2)<20.00
SET FLG=1
QUIT
+16 IF $PIECE(ICD,"V",2)>21.99
IF $PIECE(ICD,"V",2)<38.00
SET FLG=1
QUIT
+17 ;changed 9/1/94
IF $PIECE(ICD,"V",2)>72.19
IF $PIECE(ICD,"V",2)<77.80
SET FLG=1
QUIT
+18 IF $PIECE(ICD,"V",2)>78.99
IF $PIECE(ICD,"V",2)<83.00
SET FLG=1
QUIT
+19 IF $$U21
IF $PIECE(ICD,"V",2)>20.00
IF $PIECE(ICD,"V",2)<22.00
SET FLG=1
QUIT
+20 IF $$U21
IF $PIECE(ICD,"V",2)>70.00
IF $PIECE(ICD,"V",2)<71.00
SET FLG=1
QUIT
+21 ;eff 9/1
IF $$U21
IF $PIECE(ICD,"V",2)>71.99
IF $PIECE(ICD,"V",2)<72.01
SET FLG=1
QUIT
+22 IF $$U21
IF $PIECE(ICD,"V",2)>77.99
IF $PIECE(ICD,"V",2)<78.99
SET FLG=1
QUIT
+23 SET ICD=""
End DoDot:1
+24 QUIT ICD
+25 ;
DT(Y) ;
+1 XECUTE ^DD("DD")
QUIT Y
+2 ;
U21() ; -- under 21 years of age
+1 NEW X,X1,X2
SET X1=DT
SET X2=$PIECE(^DPT(DFN,0),U,3)
DO ^%DTC
+2 QUIT $SELECT((X\365.25)<21:1,1:0)
+3 ;
DS() ; -- day surgery
+1 ;IHS/ANMC/LJF 1/21/99
QUIT $SELECT($PIECE($GET(^AUPNVSIT(IEN,0)),U,7)="S":1,1:0)
+2 ;Q $O(^ADGDS("AD",DFN,$P(VDT,"."),0)) we don't use ^ADGDS anymore
+3 ;Q $S($P(N,U,8)'=65:0,$O(^AUPNVPRC("AD",IEN,0)):1,1:0)
+4 ;
ES() ; -- eligibility status
+1 QUIT $PIECE($GET(^AUPNPAT(+DFN,11)),U,12)
+2 ;
CB() ; -- classification/beneficiary
+1 QUIT $PIECE($GET(^AUPNPAT(+DFN,11)),U,11)
+2 ;
P() ; -- provider
+1 QUIT +$GET(^AUPNVPRV(+$ORDER(^AUPNVPRV("AD",+N,0)),0))
+2 ;
PRVI() ; -- private insurance
+1 QUIT $ORDER(^AUPNPRVT("B",DFN,0))
+2 ;
PRVM() ; -- private insurance eligible multiple ien
+1 QUIT $ORDER(^AUPNPRVT(+$$PRVI,11,VDT),-1)
+2 ;
PRVE() ; -- private insurance eligible end date
+1 QUIT $PIECE($GET(^AUPNPRVT(+$$PRVI,11,+$$PRVM,0)),U,2)
+2 ;
PRVX() ; -- private insurance eligible
+1 QUIT $SELECT($$PRVE>VDT:1,($$PRVM&'$$PRVE):1,1:0)
+2 ;
AV(X,Y) ; -- visit same day
+1 SET (Y,X)=0
FOR
SET X=$ORDER(^DIZ(1115238,"AV",DFN,$PIECE(VDT,"."),X))
IF Y
QUIT
IF 'X
QUIT
Begin DoDot:1
+2 SET Y=$GET(^DIZ(1115238,X,0))
IF Y
SET Y=$SELECT($PIECE(Y,U,21):0,1:1)
End DoDot:1
+3 QUIT Y
+4 ;
Q ; -- cleanup
+1 KILL BD,ED,T,DFN,VDT,DIRUT,N,IEN
QUIT
+2 ;
PRV() ;
+1 NEW N,X,Y
SET (X,Y)=0
FOR
SET X=$ORDER(^AUPNPRVT(DFN,11,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET N=^AUPNPRVT(DFN,11,X,0)
IF $PIECE(N,U,6)>VDT
QUIT
+3 IF $PIECE(N,U,7)
IF $PIECE(N,U,7)<VDT
QUIT
+4 SET Y=1
End DoDot:1
+5 QUIT Y
