| 1 | IBTOUA ;ALB/AAS - CLAIMS TRACKING UNSCHEDULED ADMISSION REPORT ; 27-OCT-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**20**; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | % I '$D(DT) D DT^DICRW
|
|---|
| 5 | W !!,"Unscheduled Admissions Report"
|
|---|
| 6 | ;
|
|---|
| 7 | DATE ; -- select date
|
|---|
| 8 | W !! D DATE^IBOUTL
|
|---|
| 9 | I IBBDT=""!(IBEDT="") G END
|
|---|
| 10 | ;
|
|---|
| 11 | DEV ; -- select device, run option
|
|---|
| 12 | W !!,"You will need a 132 column printer for this report!",!
|
|---|
| 13 | S %ZIS="QM" D ^%ZIS G:POP END
|
|---|
| 14 | I $D(IO("Q")) S ZTRTN="DQ^IBTOUA",ZTSAVE("IB*")="",ZTDESC="IB - Unscheduled Admissions Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
|
|---|
| 15 | ;
|
|---|
| 16 | U IO
|
|---|
| 17 | S X=132 X ^%ZOSF("RM")
|
|---|
| 18 | DQ D PRINT G END
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | END ; -- Clean up
|
|---|
| 22 | K ^TMP($J) W !
|
|---|
| 23 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 24 | D ^%ZISC
|
|---|
| 25 | K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | PRINT ; -- print one billing report from ct
|
|---|
| 29 | S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
|
|---|
| 30 | K ^TMP($J)
|
|---|
| 31 | ;
|
|---|
| 32 | D FIX^IBTOSA
|
|---|
| 33 | S IBDT=IBBDT-.1
|
|---|
| 34 | F S IBDT=$O(^IBT(356,"D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24))!(IBQUIT) S IBTRN=0 F S IBTRN=$O(^IBT(356,"D",IBDT,IBTRN)) Q:'IBTRN!(IBQUIT) S IBTRND=$G(^IBT(356,IBTRN,0)) D
|
|---|
| 35 | .Q:'$P(IBTRND,"^",20) ; inactive
|
|---|
| 36 | .;Q:+IBDT<IBEDT
|
|---|
| 37 | .I $P(IBTRND,"^",5),$P(IBTRND,"^",7)'=1,$$INSURED^IBCNS1($P(IBTRND,"^",2),IBDT) D SET
|
|---|
| 38 | ;
|
|---|
| 39 | PR D HDR
|
|---|
| 40 | I '$D(^TMP($J,"IBSCH")) W !!,"No Unscheduled Admission found in date range.",! Q
|
|---|
| 41 | S IBNAM="",IBCNT=0
|
|---|
| 42 | F S IBNAM=$O(^TMP($J,"IBSCH",IBNAM)) Q:IBNAM=""!(IBQUIT) S IBDT=0 F S IBDT=$O(^TMP($J,"IBSCH",IBNAM,IBDT)) Q:'IBDT!(IBQUIT) S IBTRN=0 F S IBTRN=$O(^TMP($J,"IBSCH",IBNAM,IBDT,IBTRN)) Q:'IBTRN!(IBQUIT) S IBTRND=^(IBTRN) D ONE
|
|---|
| 43 | ;
|
|---|
| 44 | Q:IBQUIT
|
|---|
| 45 | W !!,"------------------"
|
|---|
| 46 | W !,"TOTAL = ",IBCNT
|
|---|
| 47 | I $D(ZTQUEUED) G END
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ONE ; -- Print one patients data
|
|---|
| 51 | Q:IBQUIT
|
|---|
| 52 | I IOSL<($Y+5) D HDR Q:IBQUIT
|
|---|
| 53 | S IBCNT=IBCNT+1
|
|---|
| 54 | S DFN=$P(IBTRND,"^",2) D PID^VADPT
|
|---|
| 55 | W !,$E(IBNAM,1,27),?30,VA("PID"),?45,$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
|
|---|
| 56 | W ?66,$S('$P(IBTRND,"^",19):"YES",1:$E("NO - "_$P($G(^IBE(356.8,+$P(IBTRND,"^",19),0)),"^"),1,27))
|
|---|
| 57 | W ?100,$E($P($G(^DPT(DFN,.1)),"^"),1,12),?115,$E($$EXPAND^IBTRE(356,.07,$P(IBTRND,"^",7)),1,15)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | HDR ; -- Print header for billing report
|
|---|
| 61 | Q:IBQUIT
|
|---|
| 62 | I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
|
|---|
| 63 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
|
|---|
| 64 | S IBPAG=IBPAG+1
|
|---|
| 65 | W !,"Unscheduled Admissions with Insurance",?(IOM-33),"Page ",IBPAG," ",IBHDT
|
|---|
| 66 | W !,"For Period beginning on ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
|
|---|
| 67 | W !,"Patient",?30,"Pt. ID",?45,"Adm. Date",?66,"Billable",?100,"Ward",?115,"Type"
|
|---|
| 68 | W !,$TR($J(" ",IOM)," ","-")
|
|---|
| 69 | I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stoped at user request"
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | SET ; -- set tmp array
|
|---|
| 73 | I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 D HDR W !!,"....task stoped at user request" Q
|
|---|
| 74 | S ^TMP($J,"IBSCH",$P(^DPT(+$P(IBTRND,"^",2),0),"^"),IBDT,IBTRN)=IBTRND
|
|---|
| 75 | Q
|
|---|
