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

IBARXEC5.m

Go to the documentation of this file.
  1. IBARXEC5 ;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT PRINT ; 14-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. % ;
  1. PRINT ; -- Print report
  1. S IBPAG=0,IBQUIT=0 D NOW^%DTC S Y=% D D^DIQ S IBPDAT=Y
  1. K IBBCNT
  1. D HDR
  1. I '$D(^TMP("IBCONV",$J)) W !,"No Charges Canceled due to Income Exemption in date range." Q
  1. S IBNAM="",(IBPCNT,IBTAMT,IBTCNT)=0
  1. F S IBNAM=$O(^TMP("IBCONV",$J,IBNAM)) Q:IBNAM=""!(IBQUIT) D
  1. .S DFN=0 F S DFN=$O(^TMP("IBCONV",$J,IBNAM,DFN)) Q:'DFN!(IBQUIT) S IBPCNT=IBPCNT+1 D
  1. ..S (IBBCNT,IBAMT,IBN)=0 F S IBN=$O(^TMP("IBCONV",$J,IBNAM,DFN,IBN)) D:IBN="" SUB Q:'IBN!(IBQUIT) S X2=^(IBN) D ONE
  1. ;
  1. D:'IBQUIT SUM
  1. K ^TMP("IBCONV",$J)
  1. Q
  1. ;
  1. ONE ; -- print one line
  1. I ($Y+5)>IOSL D PAUSE^IBOUTL,HDR:'IBQUIT
  1. W ! I 'IBBCNT W $E(IBNAM,1,20),?22,$P(X2,"^",2) S ERR="" D ERR I ERR]"" W ?36,ERR,!
  1. ;
  1. S N=$G(^IB(IBN,0)),N1=$G(^(1)) ; new copay nodes
  1. S O=$G(^IB(+$P(N,"^",9),0)),O1=$G(^(1)) ; original copay nodes
  1. S IBBCNT=IBBCNT+1,IBAMT=IBAMT+$P(N,"^",7),IBTAMT=IBTAMT+$P(N,"^",7),IBTCNT=IBTCNT+1
  1. ;
  1. W ?36,$$DAT1^IBOUTL($P(O1,"^",2))
  1. ;
  1. S Y=+$P($P($P(O,"^",4),";",2),":",2)
  1. W $J($P($P(O,"^",8),"-"),9),$S(+Y:"/"_Y,1:"")
  1. W ?57,$$DAT1^IBOUTL($P(N1,"^",2)),?68,+N,?81,$P(N,"^",11),?97,"$",$P(N,"^",7)
  1. Q
  1. ;
  1. HDR ; -- print header
  1. I $D(IBCONVER)!($G(IBQUIC))!(IBPAG)!($E(IOST,1,2)="C-") W @IOF
  1. S IBPAG=IBPAG+1
  1. W "Rx Copay Income Exemption Report",?(IOM-35)
  1. W $P(IBPDAT,"@")," ",$P(IBPDAT,"@",2)," Page ",IBPAG
  1. W !,"Charges Canceled ",$S(IBBDT=IBEDT:"on "_$$DAT1^IBOUTL(IBBDT),1:"from "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT))
  1. W !," Cancel Cancel Original"
  1. W !,"Name Pt. ID Rx Date Rx/Refill Date IB Number Bill No. Amount"
  1. W !,$TR($J(" ",IOM)," ","-")
  1. Q
  1. ;
  1. SUB ; -- write sub totals
  1. W !,?85,"--------------"
  1. W !,?85,"Count = ",$J(IBBCNT,4)
  1. W !,?85,"Amount = $",$J(IBAMT,4),!
  1. Q
  1. ;
  1. SUM ; -- print final summary
  1. W !!?40,"======================================="
  1. W !?40," Total Patient Count = ",$J(IBPCNT,7)
  1. W !?40," Total Rx Count = ",$J(IBTCNT,7)
  1. W !?40," Total Dollar amount = $",$J(IBTAMT,7)
  1. Q
  1. ;
  1. ERR ; -- see if any errors
  1. N DJ S DJ=""
  1. F S DJ=$O(^TMP("IB-ERROR",DJ)) Q:DJ="" S ERR=$G(^TMP("IB-ERROR",DJ,DFN)) Q:ERR]""
  1. Q