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

IBARXEP.m

Go to the documentation of this file.
  1. IBARXEP ;ALB/AAS - RX COPAY EXEMPTION PRINT BILLING PATIENTS ; 20-JAN-93
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % ; -- print list of patient by status
  1. K IBCNTE,BY
  1. I '$D(IOF) D HOME^%ZIS
  1. W @IOF,?20,"Print Patient Medication Copayment Exemptions",!!!
  1. ;
  1. S DIR("?")="Answer YES if you only want to print a statistical summary or answer NO if you want a list of patients plus the statistical summary."
  1. S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
  1. I $D(DIRUT) G END
  1. S IBSUM=Y
  1. I 'IBSUM W !!,"You will need a 132 column printer for this report!",!
  1. W !! D BY G END:$G(BY)=""
  1. S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
  1. S FLDS=$S(IBSUM:"[IB BILLING PATIENT SUMMARY]",1:"[IB BILLING PATIENT]")
  1. S DHD="Patient Medication Copayment Exemption "_$S(IBSUM:"Statistics",1:"Report")
  1. S DIOEND="D SUMMARY^IBARXEP"
  1. ;
  1. ; -- exclude deceased patients
  1. I 'IBSUM S DIS(0)="I '+$G(^DPT(+D0,.35))"
  1. ;
  1. D EN1^DIP
  1. END K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
  1. Q
  1. ;
  1. ;
  1. CNT ; -- set counts into ^tmp for summary report
  1. N X,Y S X=$G(^IBA(354,D0,0)) Q:X=""
  1. S Y=$P($G(^IBE(354.2,+$P(X,"^",5),0)),"^") Q:Y=""
  1. S X=$P(X,"^",4) Q:X=""
  1. S:'$D(IBCNTE(X,Y)) IBCNTE(X,Y)=0 S IBCNTE(X,Y)=IBCNTE(X,Y)+1
  1. Q
  1. ;
  1. BY ; -- sort by exemption reason or by exemption status
  1. S DIR(0)="SMA^.04:EXEMPTION STATUS;.05:EXEMPTION REASON",DIR("A")="SORT BY: ",DIR("B")="EXEMPTION STATUS"
  1. S DIR("?")="Sort by either Exemption Status (.04) or Exemption Reason (.05)"
  1. D ^DIR K DIR I $D(DIRUT) Q
  1. S BY=$S(Y=.05:"[IB BILLING PATIENT BY REASON]",Y=.04:"[IB BILLING PATIENT BY STATUS]",1:"")
  1. Q
  1. ;
  1. SUMMARY ; -- print summary page
  1. N X,Y
  1. W:'IBSUM !!,"===================================================="
  1. S (X,Y)="",IBCNT(0)=0,IBCNT(1)=0
  1. F S X=$O(IBCNTE(X)) Q:X="" S IBCNT=0 F S Y=$O(IBCNTE(X,Y)) Q:Y="" D
  1. .;sub counts
  1. .S IBCNT(X)=IBCNT(X)+IBCNTE(X,Y)
  1. .S IBCNT=IBCNT+1
  1. .;print line
  1. .W:IBCNT=1 !,$S(X:"Exempt",1:"Non-Exempt")," Status:"
  1. .W !?5,Y,?40,"= ",IBCNTE(X,Y)
  1. W !
  1. W:$D(IBCNTE(1)) !,"Total Exempt Patients",?40,"= ",IBCNT(1)
  1. W:$D(IBCNTE(0)) !,"Total Non-Exempt Patients",?40,"= ",IBCNT(0)
  1. ;
  1. I IBSUM W !!!,"Statistics DO include counts from deceased patients."
  1. I 'IBSUM W !!!,"Statistics and report DO NOT include deceased patients."
  1. Q
  1. ;
  1. NOINC ; -- print list of patient with no income data with address
  1. ;
  1. K IBCNTE,BY
  1. I '$D(IOF) D HOME^%ZIS
  1. W @IOF,?10,"Print Patients with NO INCOME DATA Medication Copayment Exemptions",!!!
  1. ;
  1. S IBSUM=0
  1. S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
  1. S BY="[IB BILLING PAT W/INCOME]"
  1. S FLDS="[IB BILLING PAT W/INCOME]"
  1. S DHD="Patient with a NO INCOME DATA Medication Copayment Exemption Report"
  1. ;S DIOEND="D SUMMARY^IBARXEP"
  1. ;
  1. ; -- exclude deceased patients
  1. S DIS(0)="I '+$G(^DPT(+D0,.35))"
  1. ;
  1. D EN1^DIP
  1. NOINCQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
  1. Q
  1. ;
  1. EXADD ; -- print list of EXEMPT patients with address
  1. ;
  1. K IBCNTE,BY
  1. I '$D(IOF) D HOME^%ZIS
  1. W @IOF,?10,"Print List of Exempt Patients with Addresses",!!!
  1. ;
  1. S IBSUM=0
  1. S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
  1. S BY="[IB EXEMPT PATIENTS]"
  1. S FLDS="[IB PATIENT ADDRESSES]"
  1. S DHD="List of Exempt Patients with Addresses"
  1. ;
  1. ; -- exclude deceased patients
  1. S DIS(0)="I '+$G(^DPT(+D0,.35))"
  1. ;
  1. D EN1^DIP
  1. EXADDQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
  1. Q