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

IBDFOSG.m

Go to the documentation of this file. 
  1. IBDFOSG ;ALB/MAF/AAS - SCANNED EF FOR OUTPATIENTS WITH BILLS GENERATED REPORT ;8/21/95
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
  1.  ;
  1. % I '$D(DT) D DT^DICRW
  1.  D END
  1.  W !!,"Scanned Encounter Forms with Outpatient Bills Generated."
  1.  S IBDFMUL=0 I $D(^DG(43,1,"GL")) S:$P(^DG(43,1,"GL"),"^",2)=1 IBDFMUL=1 D DIVISION^VAUTOMA G:Y=-1 END
  1.  S VAUTC=1
  1.  S IBDFDAT=$$HTE^XLFDT($H)
  1.  ;
  1. DATE ; -- select date
  1.  W !! D DATE^IBOUTL
  1.  I IBBDT=""!(IBEDT="") G END
  1.  S IBDFBEG=IBBDT,IBDFEND=IBEDT
  1.  ;
  1. DEV ; -- select device, run option
  1.  W !!,"You will need a 132 column printer for this report!",!
  1.  S %ZIS="QM" D ^%ZIS G:POP END
  1.  I $D(IO("Q")) K ZTSK S ZTRTN="DQ^IBDFOSG",ZTSAVE("IB*")="",ZTSAVE("VA*")="",ZTDESC="IBD - Scanned Encounter Forms with Bill Generation" D ^%ZTLOAD K IO("Q") W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS G END
  1.  ;
  1.  U IO
  1.  S X=132 X ^%ZOSF("RM")
  1. DQ D PRINT G END
  1.  Q
  1.  ;
  1. END ; -- Clean up
  1.  K ^TMP("CTOT",$J),^TMP("DTOT",$J),^TMP("GTOT",$J),^TMP("MCCR",$J),^TMP("IBD-BILL",$J),^TMP("IBD-PRINTED",$J),^TMP("IBD-ENTERED",$J) W !
  1.  I $D(ZTQUEUED) S ZTREQ="@" Q
  1.  D ^%ZISC
  1.  K X,Y,DFN,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT,IBDFDVE
  1.  K IBCNT,IBDFBEG,IBDFCLI,IBDFDA,IBDFDAT,IBDFDIV,IBDFEND,IBDFIFN,IBDFMUL,IBDFNODE,IBDFNUM,IBDFSA,IBDFT,IBDFTMP,IBDFTMP1,IBDFTMP2,IBDFTPRT
  1.  K IBFLG1,IBFLG2,IBFLG3,IBFLG4,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9,IBMCNODE,IBMCSND,IBNAM,IBTSBDT,IBTSEDT
  1.  K VAUTC,VAUTD
  1.  Q
  1.  ;
  1. PRINT ; -- print one billing report
  1.  ;    Data sorted into ^tmp arrays
  1.  ;                    := ^tmp("mccr",$j) =
  1.  ;    Clinic Totals   := ^tmp("ctot",$j,division,clinic)=
  1.  ;    Division Totals := ^tmp("dtot",$j,division)       =
  1.  ;    Grand Totals    := ^tmp("gtot",$j)                =
  1.  ;
  1.  S (IBPAG,IBDFDVE)=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
  1.  S IBTSBDT=IBBDT-.1,IBTSEDT=IBEDT+.9
  1.  D QUIT
  1.  D START^IBDFOSG1
  1.  ;
  1. PR D HDR
  1.  I '$D(^TMP("MCCR",$J)) W !!,"No Data Meeting This Criteria for the Date Range Chosen",! Q
  1.  N IBDFDV,IBDFCL,IBDNODE,IBDFTMP,IBDFPAT,IBDFPT,IBDFT
  1.  S (IBDFDV,IBDFCL,IBDFPT)=0
  1.  F IBDFDIV=0:0 S IBDFDV=$O(^TMP("CTOT",$J,IBDFDV)) Q:IBDFDV=""!(IBQUIT)  D
  1.  .D DIVH
  1.  .S IBDFCL=0
  1.  .F IBDFCLI=0:0 S IBDFCL=$O(^TMP("CTOT",$J,IBDFDV,IBDFCL)) Q:IBDFCL=""  D ONECL I $O(^TMP("CTOT",$J,IBDFDV,IBDFCL))="" S IBDFDVE=1 D ONEDV
  1.  ;
  1.  ;  -- Print Totals Page
  1.  S IBDFDVE=0
  1.  Q:IBQUIT
  1.  D HDR
  1.  S (IBDFDV,IBDFCL,IBDFPT)=0
  1.  S IBFLG4=1 ;1 := on division totals page
  1.  F IBDFDIV=0:0 S IBDFDV=$O(^TMP("DTOT",$J,IBDFDV)) Q:IBDFDV']""!(IBQUIT)  D ONEDV
  1.  Q:IBQUIT
  1.  D DASH
  1.  D LINE("GRAND TOTAL",^TMP("GTOT",$J))
  1.  Q
  1.  ;
  1. ONECL ; -- Print one clinics data
  1.  Q:IBQUIT
  1.  Q:^TMP("CTOT",$J,IBDFDV,IBDFCL)="0^0^0^0^0^0^0^0^0"
  1.  D LINE(IBDFCL,^TMP("CTOT",$J,IBDFDV,IBDFCL))
  1.  Q
  1.  ;
  1. ONEDV ;  -- Print Division totals
  1.  Q:IBQUIT
  1.  I IOSL<($Y+5) D HDR Q:IBQUIT
  1.  Q:^TMP("DTOT",$J,IBDFDV)="0^0^0^0^0^0^0^0^0"&('$D(IBFLG4))
  1.  I IBDFDVE=1 D DASH S IBDFDVE=0
  1.  D LINE(IBDFDV,^TMP("DTOT",$J,IBDFDV))
  1.  Q
  1.  ;
  1. LINE(NAME,IBX) ;
  1.  ; -- print detail line
  1.  ;    input Name := text to be printed
  1.  ;          ibx  ;= 9 piece global node containing data
  1.  ;
  1.  I IOSL<($Y+5) D HDR Q:IBQUIT
  1.  W !,$E(NAME,1,25)
  1.  W ?27,$J($P(IBX,"^",4),8)
  1.  W ?39,$J($P(IBX,"^",3),8)
  1.  W ?51,$J($P(IBX,"^",1),8)
  1.  W ?63,$J($P(IBX,"^",2),8)
  1.  S X=$S($P(IBX,"^",4)>0:$P(IBX,"^",5)/$P(IBX,"^",4),1:0)
  1.  W ?75,$J(X,8,2) ;$J($E(X,1,8),8)
  1.  W ?87,$J($P(IBX,"^",6),8)
  1.  W ?99,$J($P(IBX,"^",7),8)
  1.  W ?111,$J($P(IBX,"^",8),8)
  1.  W ?123,$J($P(IBX,"^",9),8)
  1.  Q
  1.  ;
  1. HDR ; -- Print header for billing report
  1.  Q:IBQUIT
  1.  I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
  1.  I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
  1.  S IBPAG=IBPAG+1
  1.  W !,"Scanned Encounters with Bill Generation Data",?(IOM-33),"Page ",IBPAG,"  ",IBHDT
  1.  W !,"For Period beginning on ",$$FMTE^XLFDT(IBBDT,2)," to ",$$FMTE^XLFDT(IBEDT,2)
  1.  W !,?53,"Visits",?65,"#Bills",?75,"Avg. Days",?114,"Total",?126,"Total"
  1.  W !,"Clinic",?27,"#Scanned",?39,"#Insured",?53,"Billed",?64,"Printed",?75,"to Print",?87,"$ Billed",?100,"$ Recvd",?114,"Bills",?125,"Visits"
  1.  W !,$TR($J(" ",IOM)," ","-")
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stopped at user request" Q
  1.  Q
  1.  ;
  1.  ;
  1. QUIT K ^TMP("CTOT",$J),^TMP("DTOT",$J),^TMP("GTOT",$J),^TMP("MCCR",$J),^TMP("IBD-BILL",$J) W !
  1.  Q
  1.  ;
  1.  ;
  1. DASH W !,"------------------",?27,"--------",?39,"--------",?51,"--------",?63,"--------",?75,"--------",?87,"--------",?99,"--------",?111,"--------",?123,"--------"
  1.  Q
  1.  ;
  1. DIVH ;  -- Write division header
  1.  I IOSL<($Y+5) D HDR Q:IBQUIT
  1.  Q:^TMP("DTOT",$J,IBDFDV)="0^0^0^0^0^0^0^0^0"
  1.  W !!,?(IOM-$L(IBDFDV)+10/2),"DIVISION: ",IBDFDV,!
  1.  Q