source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHRAR.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1IBOHRAR ;ALB/EMG-RELEASED CHARGES REPORT;APR 11 1997
2 ;;2.0;INTEGRATED BILLING;**70,95,215,347**;21-MAR-94;Build 24
3 ;
4EN ; - Option entry point.
5 N X,Y,ZTIO
6 S (IBCRT,IBQUIT)=0,IBLINE="",$P(IBLINE,"-",IOM)=""
7 D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y D HOME^%ZIS
8 W @IOF,!,"List of On Hold/Hold-Review Charges Released to AR"
9 W !!?5,"This report will list all charges that were previously on"
10 W !?5,"ON HOLD or HOLD-REVIEW status and currently have a status"
11 W !?5,"of BILLED and the DATE LAST UPDATED is within the date range"
12 W !?5,"you specify."
13 ;
14SELECT W !!,"Print former (O)N HOLD charges,"
15 R !?13,"(H)OLD-REVIEW charges, or (B)OTH: BOTH// ",X:DTIME
16 G:'$T!(X["^") END S:X="" X="B" S X=$E(X)
17 I "BHObho"'[X D HELP G SELECT
18 W " ",$S("Hh"[X:"HOLD-REVIEW","Oo"[X:"ON HOLD",1:"BOTH")
19 S IBSEL=$S("Hh"[X:"H","Oo"[X:"O",1:"HO")
20 ;
21RANGE S DIR(0)="DA^:NOW:EX",DIR("A")="Start with DATE: "
22 S DIR("?")="Enter the starting date for this report."
23 W ! D ^DIR K DIR G:$D(DIRUT) END S IBSDT=+Y
24 S DIR(0)="DA^+Y:NOW:EX",DIR("A")=" Go to DATE: "
25 S DIR("?")="Enter the ending date for this report."
26 D ^DIR K DIR G:$D(DIRUT) END S IBEDT=+Y
27 ;
28QUEUED ; - Entry point if queued.
29 K ^TMP($J)
30 I '$G(IBQUIT) D DEVICE
31 I '$G(IBQUIT) D CHRGS,PRINT
32 ;
33END D ^%ZISC
34 K DFN,DIRUT,DUOUT,I,IBACT,IBATYPE,IBBILL,IBCHG,IBCNT,IBCRT,IBDT,IBFR
35 K IBGBL,IBHDR,IBHR,IBLINE,IBN,IBNAME,IBND,IBND1,IBNOW,IBOH,IBPAGE,IBQUIT
36 K IBRDT,IBRF,IBRX,IBRXN,IBSEL,IBSDT,IBSSN,IBTO,IBTYPE,POP,VA,X,^TMP($J)
37 Q
38 ;
39DEVICE I $D(ZTQUEUED) Q
40 W !!,"*** This output should be queued ***"
41 S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
42 I $D(IO("Q")) D Q
43 .S ZTRTN="QUEUED^IBOHRAR",ZTIO=ION,ZTDESC="CHARGES RELEASED TO AR"
44 .S ZTSAVE("IB*")="" D ^%ZTLOAD
45 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
46 .D HOME^%ZIS K ZTSK S IBQUIT=1
47 ;
48 U IO
49 Q
50 ;
51CHRGS ; - Indexes charges released to AR within date range.
52 S IBSDT=IBSDT+.000001,IBEDT=IBEDT+.24 Q:IBQUIT
53 I $E(IOST,1,2)="C-" S IBCRT=1
54 S IBN=0 F S IBN=$O(^IB("AC",3,IBN)) Q:'IBN D
55 .S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)) Q:'IBND!('IBND1)
56 .S IBOH=$P(IBND1,U,6),IBHR=$P(IBND1,U,7)
57 .I IBOH,IBSEL["O" S IBGBL="IBOH" D CHRGS1 Q
58 .I IBHR,IBSEL["H" S IBGBL="IBHR" D CHRGS1
59 ;
60 Q
61 ;
62CHRGS1 ; - Set global for report.
63 S IBDT=$P(IBND1,U,4) Q:'IBDT!(IBDT<IBSDT)!(IBDT>IBEDT)
64 S DFN=$P(IBND,U,2) Q:'DFN
65 D PAT S ^TMP($J,IBGBL,IBNAME,DFN,IBN)=""
66 Q
67 ;
68PRINT ; - Print charges released to AR.
69 N IENS Q:IBQUIT
70 I IBCRT=1 W @IOF
71 S IBGBL="" F S IBGBL=$O(^TMP($J,IBGBL)) Q:IBGBL="" D Q:IBQUIT
72 .S (IBCNT,IBPAGE)=0 D HEADER Q:IBQUIT
73 .S IBNAME="" F S IBNAME=$O(^TMP($J,IBGBL,IBNAME)) Q:IBNAME="" S (DFN,IBFL)=0 F S DFN=$O(^TMP($J,IBGBL,IBNAME,DFN)) Q:'DFN D Q:IBQUIT
74 ..D PRNTPAT Q:IBQUIT
75 ..S IBN=0 F S IBN=$O(^TMP($J,IBGBL,IBNAME,DFN,IBN)) Q:IBN="" D
76 ...S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1))
77 ...S (IBRX,IBRXN,IBRF,IBRDT)=0,IBACT=+IBND
78 ...S IBTYPE=$P(IBND,U,3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),U)
79 ...S IBTYPE=$S(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$E(IBTYPE,4,7))
80 ...S IBBILL=$P($P(IBND,U,11),"-",2)
81 ...I $P(IBND,U,4)["52:" S IBRXN=$P($P(IBND,U,4),":",2),IBRX=$P($P(IBND,U,8),"-"),IBRF=$P($P(IBND,U,4),":",3)
82 ...I IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
83 ...E S IBRDT=$$FILE^IBRXUTL(IBRXN,22)
84 ...S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,U,14)))
85 ...S IBTO=$$DAT1^IBOUTL($S($P(IBND,U,15)'="":$P(IBND,U,15),1:$P(IBND1,U,2)))
86 ...S IBCHG=$J(+$P(IBND,U,7),9,2)
87 ...I IBQUIT Q
88 ...W ?27,IBACT,?37,IBBILL,?46,IBTYPE W:IBRX>0 ?52,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),!
89 ...W ?52,IBFR,?62,IBTO,?70,IBCHG,!
90 ...S IBCNT=IBCNT+1
91 ...I ($Y+4)>IOSL,$O(^TMP($J,IBGBL,IBNAME,DFN,IBN)) D PRNTPAT
92 .;
93 .I IBCNT=0 W !?10,"No charges were released in this time period.",!!
94 ;
95 Q
96 ;
97PAT ; - Print patient data during processing.
98 N VADM,VAERR D DEM^VADPT K:VAERR VADM
99 S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=""
100 Q
101 ;
102PRNTPAT ; - Print patient data on report.
103 N VADM,VAERR
104 D DEM^VADPT S IBSSN=$S('VAERR:VA("BID"),1:"")
105 I ($Y+4)>IOSL D HEADER Q:IBQUIT
106 W $E(IBNAME,1,20),?21,IBSSN
107 Q
108 ;
109HEADER ; - Report header.
110 I IBQUIT Q
111 I IBCRT,$Y>1 D PAUSE Q:IBQUIT
112 S IBHDR=$S(IBGBL="IBHR":"HOLD-REVIEW",1:"ON HOLD"),IBPAGE=IBPAGE+1
113 W !,@IOF
114 W "List of ",IBHDR," charges released to AR from ",$P($$DAT2^IBOUTL(IBSDT),"@")," to ",$P($$DAT2^IBOUTL(IBEDT),"@")
115 W !,"Date Printed: ",IBNOW,?72,"Page ",IBPAGE,!,IBLINE
116 W !,"Name",?20,"Pt.ID",?27,"Act.ID",?37,"Bill #",?46,"Type",?52,"Fr/Fl Dt",?62,"To/Rls Dt",?73,"Charge"
117 W !,IBLINE,!
118 Q
119 ;
120PAUSE ; - Pause for screen output.
121 I $E(IOST,1,2)'="C-" Q
122 F I=$Y:1:(IOSL-5) W !
123 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1
124 Q
125 ;
126HELP ; - 'Print former (O)N HOLD...' prompt help text.
127 W !!?5,"Enter: '<CR>' - To select both On Hold and Hold-Review charges"
128 W !?15,"'O' - To select only On Hold charges"
129 W !?15,"'H' - To select only Hold-Review charges"
130 W !?15,"'^' - To quit this option",!
131 Q
Note: See TracBrowser for help on using the repository browser.