- IBARXEP ;ALB/AAS - RX COPAY EXEMPTION PRINT BILLING PATIENTS ; 20-JAN-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % ; -- print list of patient by status
- K IBCNTE,BY
- I '$D(IOF) D HOME^%ZIS
- W @IOF,?20,"Print Patient Medication Copayment Exemptions",!!!
- ;
- 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."
- S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
- I $D(DIRUT) G END
- S IBSUM=Y
- I 'IBSUM W !!,"You will need a 132 column printer for this report!",!
- W !! D BY G END:$G(BY)=""
- S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
- S FLDS=$S(IBSUM:"[IB BILLING PATIENT SUMMARY]",1:"[IB BILLING PATIENT]")
- S DHD="Patient Medication Copayment Exemption "_$S(IBSUM:"Statistics",1:"Report")
- S DIOEND="D SUMMARY^IBARXEP"
- ;
- ; -- exclude deceased patients
- I 'IBSUM S DIS(0)="I '+$G(^DPT(+D0,.35))"
- ;
- D EN1^DIP
- END K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- Q
- ;
- ;
- CNT ; -- set counts into ^tmp for summary report
- N X,Y S X=$G(^IBA(354,D0,0)) Q:X=""
- S Y=$P($G(^IBE(354.2,+$P(X,"^",5),0)),"^") Q:Y=""
- S X=$P(X,"^",4) Q:X=""
- S:'$D(IBCNTE(X,Y)) IBCNTE(X,Y)=0 S IBCNTE(X,Y)=IBCNTE(X,Y)+1
- Q
- ;
- BY ; -- sort by exemption reason or by exemption status
- S DIR(0)="SMA^.04:EXEMPTION STATUS;.05:EXEMPTION REASON",DIR("A")="SORT BY: ",DIR("B")="EXEMPTION STATUS"
- S DIR("?")="Sort by either Exemption Status (.04) or Exemption Reason (.05)"
- D ^DIR K DIR I $D(DIRUT) Q
- S BY=$S(Y=.05:"[IB BILLING PATIENT BY REASON]",Y=.04:"[IB BILLING PATIENT BY STATUS]",1:"")
- Q
- ;
- SUMMARY ; -- print summary page
- N X,Y
- W:'IBSUM !!,"===================================================="
- S (X,Y)="",IBCNT(0)=0,IBCNT(1)=0
- F S X=$O(IBCNTE(X)) Q:X="" S IBCNT=0 F S Y=$O(IBCNTE(X,Y)) Q:Y="" D
- .;sub counts
- .S IBCNT(X)=IBCNT(X)+IBCNTE(X,Y)
- .S IBCNT=IBCNT+1
- .;print line
- .W:IBCNT=1 !,$S(X:"Exempt",1:"Non-Exempt")," Status:"
- .W !?5,Y,?40,"= ",IBCNTE(X,Y)
- W !
- W:$D(IBCNTE(1)) !,"Total Exempt Patients",?40,"= ",IBCNT(1)
- W:$D(IBCNTE(0)) !,"Total Non-Exempt Patients",?40,"= ",IBCNT(0)
- ;
- I IBSUM W !!!,"Statistics DO include counts from deceased patients."
- I 'IBSUM W !!!,"Statistics and report DO NOT include deceased patients."
- Q
- ;
- NOINC ; -- print list of patient with no income data with address
- ;
- K IBCNTE,BY
- I '$D(IOF) D HOME^%ZIS
- W @IOF,?10,"Print Patients with NO INCOME DATA Medication Copayment Exemptions",!!!
- ;
- S IBSUM=0
- S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
- S BY="[IB BILLING PAT W/INCOME]"
- S FLDS="[IB BILLING PAT W/INCOME]"
- S DHD="Patient with a NO INCOME DATA Medication Copayment Exemption Report"
- ;S DIOEND="D SUMMARY^IBARXEP"
- ;
- ; -- exclude deceased patients
- S DIS(0)="I '+$G(^DPT(+D0,.35))"
- ;
- D EN1^DIP
- NOINCQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- Q
- ;
- EXADD ; -- print list of EXEMPT patients with address
- ;
- K IBCNTE,BY
- I '$D(IOF) D HOME^%ZIS
- W @IOF,?10,"Print List of Exempt Patients with Addresses",!!!
- ;
- S IBSUM=0
- S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
- S BY="[IB EXEMPT PATIENTS]"
- S FLDS="[IB PATIENT ADDRESSES]"
- S DHD="List of Exempt Patients with Addresses"
- ;
- ; -- exclude deceased patients
- S DIS(0)="I '+$G(^DPT(+D0,.35))"
- ;
- D EN1^DIP
- EXADDQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEP 3528 printed Feb 18, 2025@23:33:41 Page 2
- IBARXEP ;ALB/AAS - RX COPAY EXEMPTION PRINT BILLING PATIENTS ; 20-JAN-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % ; -- print list of patient by status
- +1 KILL IBCNTE,BY
- +2 IF '$DATA(IOF)
- DO HOME^%ZIS
- +3 WRITE @IOF,?20,"Print Patient Medication Copayment Exemptions",!!!
- +4 ;
- +5 SET 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."
- +6 SET DIR(0)="Y"
- SET DIR("A")="Print Summary Only"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- +7 IF $DATA(DIRUT)
- GOTO END
- +8 SET IBSUM=Y
- +9 IF 'IBSUM
- WRITE !!,"You will need a 132 column printer for this report!",!
- +10 WRITE !!
- DO BY
- if $GET(BY)=""
- GOTO END
- +11 SET DIC="^IBA(354,"
- SET L=0
- SET FR="?,?,?"
- SET TO="?,?,?"
- +12 SET FLDS=$SELECT(IBSUM:"[IB BILLING PATIENT SUMMARY]",1:"[IB BILLING PATIENT]")
- +13 SET DHD="Patient Medication Copayment Exemption "_$SELECT(IBSUM:"Statistics",1:"Report")
- +14 SET DIOEND="D SUMMARY^IBARXEP"
- +15 ;
- +16 ; -- exclude deceased patients
- +17 IF 'IBSUM
- SET DIS(0)="I '+$G(^DPT(+D0,.35))"
- +18 ;
- +19 DO EN1^DIP
- END KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- +1 QUIT
- +2 ;
- +3 ;
- CNT ; -- set counts into ^tmp for summary report
- +1 NEW X,Y
- SET X=$GET(^IBA(354,D0,0))
- if X=""
- QUIT
- +2 SET Y=$PIECE($GET(^IBE(354.2,+$PIECE(X,"^",5),0)),"^")
- if Y=""
- QUIT
- +3 SET X=$PIECE(X,"^",4)
- if X=""
- QUIT
- +4 if '$DATA(IBCNTE(X,Y))
- SET IBCNTE(X,Y)=0
- SET IBCNTE(X,Y)=IBCNTE(X,Y)+1
- +5 QUIT
- +6 ;
- BY ; -- sort by exemption reason or by exemption status
- +1 SET DIR(0)="SMA^.04:EXEMPTION STATUS;.05:EXEMPTION REASON"
- SET DIR("A")="SORT BY: "
- SET DIR("B")="EXEMPTION STATUS"
- +2 SET DIR("?")="Sort by either Exemption Status (.04) or Exemption Reason (.05)"
- +3 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- QUIT
- +4 SET BY=$SELECT(Y=.05:"[IB BILLING PATIENT BY REASON]",Y=.04:"[IB BILLING PATIENT BY STATUS]",1:"")
- +5 QUIT
- +6 ;
- SUMMARY ; -- print summary page
- +1 NEW X,Y
- +2 if 'IBSUM
- WRITE !!,"===================================================="
- +3 SET (X,Y)=""
- SET IBCNT(0)=0
- SET IBCNT(1)=0
- +4 FOR
- SET X=$ORDER(IBCNTE(X))
- if X=""
- QUIT
- SET IBCNT=0
- FOR
- SET Y=$ORDER(IBCNTE(X,Y))
- if Y=""
- QUIT
- Begin DoDot:1
- +5 ;sub counts
- +6 SET IBCNT(X)=IBCNT(X)+IBCNTE(X,Y)
- +7 SET IBCNT=IBCNT+1
- +8 ;print line
- +9 if IBCNT=1
- WRITE !,$SELECT(X:"Exempt",1:"Non-Exempt")," Status:"
- +10 WRITE !?5,Y,?40,"= ",IBCNTE(X,Y)
- End DoDot:1
- +11 WRITE !
- +12 if $DATA(IBCNTE(1))
- WRITE !,"Total Exempt Patients",?40,"= ",IBCNT(1)
- +13 if $DATA(IBCNTE(0))
- WRITE !,"Total Non-Exempt Patients",?40,"= ",IBCNT(0)
- +14 ;
- +15 IF IBSUM
- WRITE !!!,"Statistics DO include counts from deceased patients."
- +16 IF 'IBSUM
- WRITE !!!,"Statistics and report DO NOT include deceased patients."
- +17 QUIT
- +18 ;
- NOINC ; -- print list of patient with no income data with address
- +1 ;
- +2 KILL IBCNTE,BY
- +3 IF '$DATA(IOF)
- DO HOME^%ZIS
- +4 WRITE @IOF,?10,"Print Patients with NO INCOME DATA Medication Copayment Exemptions",!!!
- +5 ;
- +6 SET IBSUM=0
- +7 SET DIC="^IBA(354,"
- SET L=0
- SET FR="?,?,?"
- SET TO="?,?,?"
- +8 SET BY="[IB BILLING PAT W/INCOME]"
- +9 SET FLDS="[IB BILLING PAT W/INCOME]"
- +10 SET DHD="Patient with a NO INCOME DATA Medication Copayment Exemption Report"
- +11 ;S DIOEND="D SUMMARY^IBARXEP"
- +12 ;
- +13 ; -- exclude deceased patients
- +14 SET DIS(0)="I '+$G(^DPT(+D0,.35))"
- +15 ;
- +16 DO EN1^DIP
- NOINCQ KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- +1 QUIT
- +2 ;
- EXADD ; -- print list of EXEMPT patients with address
- +1 ;
- +2 KILL IBCNTE,BY
- +3 IF '$DATA(IOF)
- DO HOME^%ZIS
- +4 WRITE @IOF,?10,"Print List of Exempt Patients with Addresses",!!!
- +5 ;
- +6 SET IBSUM=0
- +7 SET DIC="^IBA(354,"
- SET L=0
- SET FR="?,?,?"
- SET TO="?,?,?"
- +8 SET BY="[IB EXEMPT PATIENTS]"
- +9 SET FLDS="[IB PATIENT ADDRESSES]"
- +10 SET DHD="List of Exempt Patients with Addresses"
- +11 ;
- +12 ; -- exclude deceased patients
- +13 SET DIS(0)="I '+$G(^DPT(+D0,.35))"
- +14 ;
- +15 DO EN1^DIP
- EXADDQ KILL DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
- +1 QUIT