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

AZANED16.m

Go to the documentation of this file. 
  1. BMENED16 ; IHS/PHXAO/TMJ - -- Billing Dental ; [ 06/11/03  3:36 PM ]
  1.  ;IHS/ANMC/FBD-2/13/97-Changed per diem rate from $233 to $241
  1.  ;                     as of 2/13/97.
  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.  .. Q:$P(N,U,8)'=36  S DFN=$P(N,U,5) Q:'DFN  ;dental
  1.  .. I $$U21,$$MCD,'$$PRV,'$$DS,'$$MCR,'$$INP,$$ADA'="" D 1,2
  1.  .. ;I $$MCD,'$$PRV,'$$DS,'$$URC,'$$AV,'$$MCR,'$$INP,$$ADA'="" D 1
  1.  Q
  1.  ;
  1. 1 ; -- create entry       
  1.  Q:$O(^DIZ(1115238,"B",IEN,0))
  1.  N DIC,DINUM,X,DR,DIE,DA,ADA 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.  Q
  1.  ;
  1. 2 ; -- stuff additional fields
  1.  S DIE="^DIZ(1115238,",DIC(0)="L",DA=IEN
  1.  S DR=".21///^S X=$$ADA^AZAMED16"
  1.  S DR=DR_";.06////^S X=$$ES^AZAMED16;.07////^S X=$$CB^AZAMED16"
  1.  ;S DR=DR_";.09///^S X=""147.00"""
  1.  ;S DR=DR_";.09///^S X=""159.00""" ;SFB 2/1/95
  1.  S DR=DR_";.09///^S X=""241.00""" ;IHS/ANMC/FBD-2/13/97
  1.  S DR=DR_";.11////^S X=$$MCDC^AZAMED16;.12////^S X=$$MCDN^AZAMED16"
  1.  ;S DR=DR_";.22////^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_";.22////^S X=T;.14////^S X=DT;.15///^S X=$$HRCN^AZAMED"  ;IHS/ANMC/LJF 1/21/99 keep calls within namespace
  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. ADA() ;
  1.  B
  1.  N ADA,FLG,IFN S (ADA,FLG,IFN)=""
  1.  F  S IFN=$O(^AUPNVDEN("AD",IEN,IFN)) Q:'IFN  Q:FLG  D
  1.  . S ADA=$P($G(^AUTTADA(+$G(^AUPNVDEN(+IFN,0)),0)),U)
  1.  . I ADA,ADA<8000 S FLG=1 Q
  1.  . I ADA,ADA>8999 S FLG=1 Q
  1.  . S ADA=""
  1.  Q ADA
  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. 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() ; -- visit same day
  1.  Q $O(^DIZ(1115238,"AV",DFN,$P(VDT,"."),0))
  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