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

AZAMED15.m

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