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