source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCONSC.m@ 1006

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1IBCONSC ;ALB/MJB,SGD,AAS,RLW - NSC W/INSURANCE OUTPUT ;06 JUN 88 13:51
2 ;;2.0;INTEGRATED BILLING;**66,120**; 21-MAR-94
3 ;
4 ;
5INP ; Entry point for Inpatient Admission report
6 S IBINPT=1,IBSUB="AMV1" G EN1
7 ;
8INPDIS ; Entry point for Inpatient Discharge report
9 S IBINPT=2,IBSUB="AMV3" G EN1
10 ;
11EN ; Entry point for Outpatient report
12 S IBINPT=0,IBSUB=""
13EN1 ;
14 ;***
15 ;S XRTL=$ZU(0),XRTN="IBCONSC-1" D T0^%ZOSV ;start rt clock
16 I '$D(DT) D DT^DICRW
17 K ^TMP($J)
18 ;
19 D ^IBCONS4 I +$G(IBQUIT) G Q
20 ;
21DEV ; -- ask device
22 W !!,*7,"*** Margin width of this output is 132 ***"
23 W !,"*** This output should be queued ***"
24 ;
25 I +$G(IBINPT)=0,+$P($G(^IBE(350.9,1,6)),U,23) W !,"*** If queued, Outpatient Visits in Claims Tracking will be updated first ***"
26 ;
27 S %ZIS="QM" D ^%ZIS G:POP Q
28 I $D(IO("Q")) K IO("Q") D G Q
29 .S ZTRTN="BEGIN^IBCONSC",ZTSAVE("IB*")="",ZTSAVE("VAUTD")="",ZTSAVE("VAUTD(")=""
30 .S ZTDESC="IB - Patients with Insurance and "_$S('IBINPT:"Outpatient ",IBINPT=1:"Admissions",1:"Discharges")
31 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
32 ;
33 U IO
34 ;***
35 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCONSC" D T1^%ZOSV ;stop rt clock
36 ;
37 ;
38BEGIN ; Background job main entry point. Set up the report header.
39 ;***
40 ;S XRTL=$ZU(0),XRTN="IBCONSC-2" D T0^%ZOSV ;start rt clock
41 ;
42 I $D(ZTQUEUED),+$G(IBINPT)=0,+$P($G(^IBE(350.9,1,6)),U,23) D UPCT ; update CT if parameter on, opt, queued
43 ;
44 S B="",IBL="",$P(IBL,"=",IOM)="",Y=IBBEG X ^DD("DD")
45 S IBHD="*Veterans with Reimbursable Insurance and "_$S('IBINPT:"OUTPATIENT Appointments",1:"INPATIENT "_$S(IBINPT=2:"Discharges",1:"Admissions"))_" for the "
46 S IBHD=IBHD_$S(IBBEG'=IBEND:"period covering ",1:"")_Y
47 I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
48 K %DT S X="N",%DT="T" D ^%DT X ^DD("DD") S IBDATE=Y K %DT
49 S IBTRKR=$G(^IBE(350.9,1,6)),IBQUIT=0
50 ;
51 ; Compile data for the report
52 D @($S(IBINPT:"LOOP1",1:"LOOP2")_"^IBCONS2")
53 G:IBQUIT Q
54 ;
55 ; Print the report
56 S X=132 X ^%ZOSF("RM") D LOOP25^IBCONS1
57 ;
58Q ; Clean up variables and close the output device.
59 W !
60 I $D(ZTQUEUED) S ZTREQ="@" Q
61 D ^%ZISC
62 K %,%DT,B,I,I1,II,J,K,L,M,N,X,X1,X2,Y,C,DFN,IBCNT,IBIFN,IBBILL,IBSELUBL,IBSELBNA,IBSELBIL,IBFORMFD
63 K IBFLAG,IBI,IBDT,IBPAGE,IBL,IBHD,IBBEG1,IBBEG,IBEND,IBSTOP
64 K IBTRKR,IBOE,IBSELRNB,IBADMVT,IBETYP,IBRMARK,IBQUIT,IBSELCDV,IBSELRNG,IBSELSR1,IBSELSR2,IBAUTH,IBPRTICR,IBPRTIEX
65 K IBINPT,IBPGM,IBVAR,IBFLAG,IBNAME,IBAPPT,IBDC,IBDAT,IBDFN,IBSELTRM,IBQUIT,IBPRTRDS,IBPRTIPC,IBPRTIGC
66 K POP,^TMP($J),IBDV,IBSUB,VAUTD,IBINDT,IBINS,IBDATE,IBFL,PTF,IBSC,IBMOV
67 ;***
68 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCONSC" D T1^%ZOSV ;stop rt clock
69 Q
70 ;
71 ;
72HDRDV N IBI,C Q:'$G(IBSELCDV)
73 I VAUTD=1 S IBHDRDV=": All Divisions Combined" Q
74 S IBHDRDV=" - Divisions Combined: ",C=""
75 S IBI="" F S IBI=$O(VAUTD(IBI)) Q:'IBI S IBHDRDV=IBHDRDV_C_" "_VAUTD(IBI),C=","
76 Q
77 ;
78UPCT ; Update Claims Tracking
79 ; run the Claims Tracking opt tracker routine for same date range of report
80 ; newed variables trying to keep the two jobs, report and CT update, from effecting each other except for date range
81 ; Input: IBBEG, IBEND
82 ; Output: bulletin indicating how many entries checked and how many added
83 ;
84 N IBOE,IBOESTAT,IBOETYP,IBTSBDT,IBTSEDT,SDCNT,XMSUB,IBT,IBENCL,IBMESS,IBRMARK,IBANY,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y,IBQUIT
85 N VAUTD,IBINPT,IBSUB,IBSELUBL,IBSELBNA,IBSELBIL,IBSELRNB,IBSELCDV,IBSELTRM,IBSELRNG,IBPRTRDS,IBPRTIEX,IBPRTICR,IBPRTIPC,IBPRTIGC
86 ;
87 S IBTSBDT=IBBEG,IBTSEDT=IBEND
88 ;
89 N IBBEG,IBEND,IBTALK
90 ;
91 S IBTALK=1 D EN1^IBTRKR4
92 Q
Note: See TracBrowser for help on using the repository browser.