source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFOSG.m@ 1068

Last change on this file since 1068 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1IBDFOSG ;ALB/MAF/AAS - SCANNED EF FOR OUTPATIENTS WITH BILLS GENERATED REPORT ;8/21/95
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29,51**;APR 24, 1997
3 ;
4 W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
5 ;
6% I '$D(DT) D DT^DICRW
7 D END
8 W !!,"Scanned Encounter Forms with Outpatient Bills Generated."
9 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
10 S VAUTC=1
11 S IBDFDAT=$$HTE^XLFDT($H)
12 ;
13DATE ; -- select date
14 W !! D DATE^IBOUTL
15 I IBBDT=""!(IBEDT="") G END
16 S IBDFBEG=IBBDT,IBDFEND=IBEDT
17 ;
18DEV ; -- select device, run option
19 W !!,"You will need a 132 column printer for this report!",!
20 S %ZIS="QM" D ^%ZIS G:POP END
21 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
22 ;
23 U IO
24 S X=132 X ^%ZOSF("RM")
25DQ D PRINT G END
26 Q
27 ;
28END ; -- Clean up
29 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 !
30 I $D(ZTQUEUED) S ZTREQ="@" Q
31 D ^%ZISC
32 K X,Y,DFN,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT,IBDFDVE
33 K IBCNT,IBDFBEG,IBDFCLI,IBDFDA,IBDFDAT,IBDFDIV,IBDFEND,IBDFIFN,IBDFMUL,IBDFNODE,IBDFNUM,IBDFSA,IBDFT,IBDFTMP,IBDFTMP1,IBDFTMP2,IBDFTPRT
34 K IBFLG1,IBFLG2,IBFLG3,IBFLG4,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9,IBMCNODE,IBMCSND,IBNAM,IBTSBDT,IBTSEDT
35 K VAUTC,VAUTD
36 Q
37 ;
38PRINT ; -- print one billing report
39 ; Data sorted into ^tmp arrays
40 ; := ^tmp("mccr",$j) =
41 ; Clinic Totals := ^tmp("ctot",$j,division,clinic)=
42 ; Division Totals := ^tmp("dtot",$j,division) =
43 ; Grand Totals := ^tmp("gtot",$j) =
44 ;
45 S (IBPAG,IBDFDVE)=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
46 S IBTSBDT=IBBDT-.1,IBTSEDT=IBEDT+.9
47 D QUIT
48 D START^IBDFOSG1
49 ;
50PR D HDR
51 I '$D(^TMP("MCCR",$J)) W !!,"No Data Meeting This Criteria for the Date Range Chosen",! Q
52 N IBDFDV,IBDFCL,IBDNODE,IBDFTMP,IBDFPAT,IBDFPT,IBDFT
53 S (IBDFDV,IBDFCL,IBDFPT)=0
54 F IBDFDIV=0:0 S IBDFDV=$O(^TMP("CTOT",$J,IBDFDV)) Q:IBDFDV=""!(IBQUIT) D
55 .D DIVH
56 .S IBDFCL=0
57 .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
58 ;
59 ; -- Print Totals Page
60 S IBDFDVE=0
61 Q:IBQUIT
62 D HDR
63 S (IBDFDV,IBDFCL,IBDFPT)=0
64 S IBFLG4=1 ;1 := on division totals page
65 F IBDFDIV=0:0 S IBDFDV=$O(^TMP("DTOT",$J,IBDFDV)) Q:IBDFDV']""!(IBQUIT) D ONEDV
66 Q:IBQUIT
67 D DASH
68 D LINE("GRAND TOTAL",^TMP("GTOT",$J))
69 Q
70 ;
71ONECL ; -- Print one clinics data
72 Q:IBQUIT
73 Q:^TMP("CTOT",$J,IBDFDV,IBDFCL)="0^0^0^0^0^0^0^0^0"
74 D LINE(IBDFCL,^TMP("CTOT",$J,IBDFDV,IBDFCL))
75 Q
76 ;
77ONEDV ; -- Print Division totals
78 Q:IBQUIT
79 I IOSL<($Y+5) D HDR Q:IBQUIT
80 Q:^TMP("DTOT",$J,IBDFDV)="0^0^0^0^0^0^0^0^0"&('$D(IBFLG4))
81 I IBDFDVE=1 D DASH S IBDFDVE=0
82 D LINE(IBDFDV,^TMP("DTOT",$J,IBDFDV))
83 Q
84 ;
85LINE(NAME,IBX) ;
86 ; -- print detail line
87 ; input Name := text to be printed
88 ; ibx ;= 9 piece global node containing data
89 ;
90 I IOSL<($Y+5) D HDR Q:IBQUIT
91 W !,$E(NAME,1,25)
92 W ?27,$J($P(IBX,"^",4),8)
93 W ?39,$J($P(IBX,"^",3),8)
94 W ?51,$J($P(IBX,"^",1),8)
95 W ?63,$J($P(IBX,"^",2),8)
96 S X=$S($P(IBX,"^",4)>0:$P(IBX,"^",5)/$P(IBX,"^",4),1:0)
97 W ?75,$J(X,8,2) ;$J($E(X,1,8),8)
98 W ?87,$J($P(IBX,"^",6),8)
99 W ?99,$J($P(IBX,"^",7),8)
100 W ?111,$J($P(IBX,"^",8),8)
101 W ?123,$J($P(IBX,"^",9),8)
102 Q
103 ;
104HDR ; -- Print header for billing report
105 Q:IBQUIT
106 I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
107 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
108 S IBPAG=IBPAG+1
109 W !,"Scanned Encounters with Bill Generation Data",?(IOM-33),"Page ",IBPAG," ",IBHDT
110 W !,"For Period beginning on ",$$FMTE^XLFDT(IBBDT,2)," to ",$$FMTE^XLFDT(IBEDT,2)
111 W !,?53,"Visits",?65,"#Bills",?75,"Avg. Days",?114,"Total",?126,"Total"
112 W !,"Clinic",?27,"#Scanned",?39,"#Insured",?53,"Billed",?64,"Printed",?75,"to Print",?87,"$ Billed",?100,"$ Recvd",?114,"Bills",?125,"Visits"
113 W !,$TR($J(" ",IOM)," ","-")
114 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stopped at user request" Q
115 Q
116 ;
117 ;
118QUIT K ^TMP("CTOT",$J),^TMP("DTOT",$J),^TMP("GTOT",$J),^TMP("MCCR",$J),^TMP("IBD-BILL",$J) W !
119 Q
120 ;
121 ;
122DASH W !,"------------------",?27,"--------",?39,"--------",?51,"--------",?63,"--------",?75,"--------",?87,"--------",?99,"--------",?111,"--------",?123,"--------"
123 Q
124 ;
125DIVH ; -- Write division header
126 I IOSL<($Y+5) D HDR Q:IBQUIT
127 Q:^TMP("DTOT",$J,IBDFDV)="0^0^0^0^0^0^0^0^0"
128 W !!,?(IOM-$L(IBDFDV)+10/2),"DIVISION: ",IBDFDV,!
129 Q
Note: See TracBrowser for help on using the repository browser.