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

IBOHTOT.m

Go to the documentation of this file.
  1. IBOHTOT ;ALB/EMG - COUNT/AMT OF CHARGES ON HOLD REPORT ; FEB 25 1997
  1. ;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
  1. ;
  1. EN ;
  1. ;***
  1. D HOME^%ZIS W @IOF,!!,"Count and Dollar Amount of Charges ON HOLD Report",!!
  1. ;
  1. DEV S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP END
  1. I $D(IO("Q")) S ZTRTN="DQ^IBOHTOT",ZTDESC="IB Count/Amt Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q"),ZTSK G END
  1. U IO
  1. ;***
  1. W !!
  1. ;
  1. DQ ; -entry from tasked job
  1. ;***
  1. K ^TMP($J)
  1. S DFN=0 F S DFN=$O(^IB("AH",DFN)) Q:'DFN S IBN=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN I $D(^IB(IBN,0)) D DATA
  1. ;
  1. D PRINT W !
  1. D TPRINT W !
  1. G END
  1. ;
  1. DATA ; -gross count of action types, total charges
  1. ; -^tmp($j,"ib",ibaction type,"gcnt")=count
  1. ; -^tmp($j,"ib",ibaction type,"gtot")=sum of charges
  1. ; -^tmp($j,"ibtot","fcnt")=final count of entries
  1. ; -^tmp($j,"ibtot","ftot")=final sum of charges
  1. ;
  1. S IBND=^IB(IBN,0)
  1. S IBATYP=$S($D(^IBE(350.1,+$P(IBND,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")
  1. S:'$D(^TMP($J,"IB",IBATYP,"GCNT")) ^("GCNT")=0 S ^("GCNT")=^("GCNT")+1
  1. S:'$D(^TMP($J,"IB",IBATYP,"GTOT")) ^("GTOT")=0 S ^("GTOT")=^("GTOT")+$P(IBND,"^",7)
  1. S:'$D(^TMP($J,"IBTOT","FCNT")) ^("FCNT")=0 S ^("FCNT")=^("FCNT")+1
  1. S:'$D(^TMP($J,"IBTOT","FTOT")) ^("FTOT")=0 S ^("FTOT")=^("FTOT")+$P(IBND,"^",7)
  1. Q
  1. ;
  1. ;
  1. PRINT ; -output data
  1. S IBQUIT=0,IBPAG=0,Y=DT D D^DIQ S IBHDT=Y D HDR
  1. W !!?((IOM-25)/2),"TOTALS BY ACTION TYPE"
  1. ;
  1. S IBATYP="" F IBT=0:0 S IBATYP=$O(^TMP($J,"IB",IBATYP)) Q:IBATYP=""!(IBQUIT) D LINE
  1. Q
  1. ;
  1. TPRINT ; -grand total of data
  1. I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
  1. W !!,?(IOM-26/2),"**************************"
  1. W !,?((IOM/2)-20),"TOTAL NUMBER OF ENTRIES: ",$J($S($D(^TMP($J,"IBTOT","FCNT")):^("FCNT"),1:0),13)
  1. W !,?((IOM/2)-20)," TOTAL DOLLAR AMOUNT: $",$J($S($D(^TMP($J,"IBTOT","FTOT")):^("FTOT"),1:0),12,2)
  1. Q
  1. ;
  1. LINE ;
  1. I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
  1. W !!?((IOM/2)-$L($P(IBATYP," ",2,99))),$P(IBATYP," ",2,99)
  1. W !?((IOM/2)-12),"NUMBER ENTRIES: ",$J($S($D(^TMP($J,"IB",IBATYP,"GCNT")):^("GCNT"),1:0),9)
  1. W !?((IOM/2)-12),"DOLLAR AMOUNT: $",$J($S($D(^TMP($J,"IB",IBATYP,"GTOT")):^("GTOT"),1:0),9,2)
  1. Q
  1. ;
  1. HDR ;
  1. W:$E(IOST,1,2)["C-"!(IBPAG>0) !,@IOF
  1. W ?((IOM-42)/2),"Count and Dollar Amount of Charges ON HOLD"
  1. W !?((IOM-3)/2),"for"
  1. D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),"^"),1:"")
  1. W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
  1. W !!?(IOM-26/2),"Date Printed: ",IBHDT
  1. S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
  1. W !?(IOM-26/2),"--------------------------"
  1. Q
  1. ;
  1. END K ^TMP($J)
  1. ;***
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. K DFN,IBT,IBATYP,IBHDT,IBPAG,IBSNM,IBFAC,IBSITE,IBN,IBND,IBQUIT,POP,X,Y
  1. D ^%ZISC
  1. Q