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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBODISP ;ALB/AAS - INTEGRATED BILLING - OUTPUTS ; 8-MAR-91
2 ;;2.0; INTEGRATED BILLING ;**17,199**; 21-MAR-94
3 ;
4EN ;
5 ;***
6 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
7 ;S XRTL=$ZU(0),XRTN="EN^IBODISP-1" D T0^%ZOSV ;start rt clock
8 ; -display ib action by reference number
9 S DIC="^IB(",DIC(0)="AEQM" D ^DIC K DIC G ENQ:+Y<1 S DA=+Y D DISP G EN
10 ;***
11 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
12 Q
13 ;
14DISP S DIC="^IB(",DR="0:1" D EN^DIQ
15 Q
16ENQ K DIC,DA,DR,Y,X,IBQT
17 Q
18EN1 ;
19 ;***
20 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
21 ;S XRTL=$ZU(0),XRTN="EN1^IBODISP-1" D T0^%ZOSV ;start rt clock
22 ;
23 ; -display ib action by patient [by date]
24 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
25 S DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC G EN1Q:+Y<1 S DFN=+Y
26 D DATE^IBOUTL G:'IBEDT EN1
27 ; -loop through inverse dates by patient and display
28 S S=2,IBDT=IBBDT-.0000001,(IBQUIT,IBOCNT)=0
29 F IBI=0:0 S IBDT=$O(^IB("APTDT",DFN,IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) F IBJJ=0:0 S IBJJ=$O(^IB("APTDT",DFN,IBDT,IBJJ)) Q:'IBJJ!('S)!($D(DTOUT)) S DA=IBJJ,IBOCNT=IBOCNT+1 I DA D DISP,PAUSE^IBOUTL G:IBQUIT EN1
30 I IBOCNT<1 W !!,"No IB Actions Found for this Date Range",!!
31 G EN1
32EN1Q K DIC,DA,DR,IBEDT,IBBDT,IBDT,IBI,IBJ,IBJJ,IBOCNT,S,X,Y,DFN,D0,IBQUIT
33 ;***
34 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
35 Q
36 ;
37EN2 ;
38 ; -print list of ib actions
39 ;***
40 ;S XRTL=$ZU(0),XRTN="EN2^IBODISP-1" D T0^%ZOSV ;start rt clock
41 W !!,"Print IB Action Entries by Date Added",!!," ** Please note that this output requires 132 columns **",!
42 S DIC="^IB(",L=0,FLDS="[IB LIST]",BY="@12,@"
43 D ASK G:$G(IBQT) ENQ
44 S DHD="INTEGRATED BILLING ACTIONS FROM: "_FR(1)_" TO: "_TO(1)
45 D EN1^DIP
46 K DIC,L,FLDS,FR,BY,TO
47 D ^%ZISC
48 ;***
49 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN2^IBODISP" D T1^%ZOSV ;stop rt clock
50 Q
51ASK ;
52 N IBBDT,IBEDT
53 D DATE^IBOUTL
54 I (IBBDT<1)!(IBEDT<1) S IBQT=1 Q
55 S FR=IBBDT_",?",TO=IBEDT_",?"
56 S FR(1)=$$DAT1^IBOUTL(FR),TO(1)=$$DAT1^IBOUTL(TO)
57 Q
Note: See TracBrowser for help on using the repository browser.