| 1 | IBJDI2 ;ALB/CPM - VETERANS WITH UNVERIFIED ELIGIBILITY ;16-DEC-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**69,91,98,100,118,249**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; - Option entry point.
|
|---|
| 6 | ;
|
|---|
| 7 | W !!,"This report measures the number of patients who have been treated at the"
|
|---|
| 8 | W !,"facility but whose eligibility has not been verified. This report will"
|
|---|
| 9 | W !,"also list patients with verified eligibility for at least 2 years, if any.",!
|
|---|
| 10 | ;
|
|---|
| 11 | DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
|
|---|
| 12 | ;
|
|---|
| 13 | ; - Sort by division?
|
|---|
| 14 | S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D DHLP^IBJDI2"
|
|---|
| 15 | S DIR("A")="Do you wish to sort this report by division" W !
|
|---|
| 16 | D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
|
|---|
| 17 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 18 | ;
|
|---|
| 19 | I IBSORT D PSDR^IBODIV G:Y<0 ENQ ; Select division(s).
|
|---|
| 20 | ;
|
|---|
| 21 | ; - Select a detailed or summary report.
|
|---|
| 22 | D DS^IBJD I IBRPT["^" G ENQ
|
|---|
| 23 | ;
|
|---|
| 24 | I IBRPT="D" W !!,"You will need a 132 column printer for this report!"
|
|---|
| 25 | E W !!,"This report only requires an 80 column printer."
|
|---|
| 26 | ;
|
|---|
| 27 | W !!,"Note: This report may take a while to run."
|
|---|
| 28 | W !?6,"You should queue this report to run after normal business hours.",!
|
|---|
| 29 | ;
|
|---|
| 30 | ; - Select a device.
|
|---|
| 31 | S %ZIS="QM" D ^%ZIS G:POP ENQ
|
|---|
| 32 | I $D(IO("Q")) D G ENQ
|
|---|
| 33 | .S ZTRTN="DQ^IBJDI2",ZTDESC="IB - UNVERIFIED ELIGIBILITY"
|
|---|
| 34 | .F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
|
|---|
| 35 | .D ^%ZTLOAD
|
|---|
| 36 | .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
|
|---|
| 37 | .K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 38 | ;
|
|---|
| 39 | U IO
|
|---|
| 40 | ;
|
|---|
| 41 | DQ ; - Tasked entry point.
|
|---|
| 42 | ;
|
|---|
| 43 | I $G(IBXTRACT) D E^IBJDE(2,1) ; Change extract status.
|
|---|
| 44 | ;
|
|---|
| 45 | N IBQUERY,IBQUERY1
|
|---|
| 46 | K IB,^TMP("IBJDI21",$J),^TMP("IBJDI22",$J),^TMP("IBJDI23",$J)
|
|---|
| 47 | K ^TMP("IBDFN",$J),^TMP($J,"SDAMA301")
|
|---|
| 48 | S IBC="DEC^NOT^PEN^TOT^VER^VERO",IBQ=0
|
|---|
| 49 | I IBSORT D G PROC
|
|---|
| 50 | .S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
|
|---|
| 51 | ..S J=$P($G(^DG(40.8,I,0)),U) F K=1:1:6 S IB(J,$P(IBC,U,K))=0
|
|---|
| 52 | S IBDIV="ALL" F I=1:1:6 S IB("ALL",$P(IBC,U,I))=0
|
|---|
| 53 | ;
|
|---|
| 54 | PROC D ^IBJDI21 ; Process and print reports.
|
|---|
| 55 | ;
|
|---|
| 56 | ENQ K ^TMP("IBJDI21",$J),^TMP("IBJDI22",$J),^TMP("IBJDI23",$J)
|
|---|
| 57 | K ^TMP("IBDFN",$J),^TMP($J,"SDAMA301")
|
|---|
| 58 | I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
|
|---|
| 59 | ;
|
|---|
| 60 | D ^%ZISC
|
|---|
| 61 | ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDOD,IBDN,IBPAG,IBRUN,IBX,IBXX,IBPERV
|
|---|
| 62 | K IBESD,IBPM,IBPMD,IBOE,IBOED,IBES,IBLT,IBNUMO,IBNUMD,IBNEXT,IBDT,IBDTF
|
|---|
| 63 | K IBC,IBN,IBDIV,IBSORT,IBPERD,IBPERO,IBPERP,VAUTD,DFN,POP,I,J,K
|
|---|
| 64 | K X,X1,X2,Y,%,%ZIS,DIR,DIROUT,DTOUT,DUOUT,DIRUT,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | DHLP ; - 'Sort by division' prompt.
|
|---|
| 68 | W !!,"Select: '<CR>' to print the trend report without regard to"
|
|---|
| 69 | W !?15,"division"
|
|---|
| 70 | W !?11,"'Y' to select those divisions for which a separate"
|
|---|
| 71 | W !?15,"trend report should be created",!?11,"'^' to quit"
|
|---|
| 72 | Q
|
|---|
