IBJDI2 ;ALB/CPM - VETERANS WITH UNVERIFIED ELIGIBILITY ;16-DEC-96
;;2.0;INTEGRATED BILLING;**69,91,98,100,118,249**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; - Option entry point.
;
W !!,"This report measures the number of patients who have been treated at the"
W !,"facility but whose eligibility has not been verified. This report will"
W !,"also list patients with verified eligibility for at least 2 years, if any.",!
;
DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
;
; - Sort by division?
S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D DHLP^IBJDI2"
S DIR("A")="Do you wish to sort this report by division" W !
D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
K DIR,DIROUT,DTOUT,DUOUT,DIRUT
;
I IBSORT D PSDR^IBODIV G:Y<0 ENQ ; Select division(s).
;
; - Select a detailed or summary report.
D DS^IBJD I IBRPT["^" G ENQ
;
I IBRPT="D" W !!,"You will need a 132 column printer for this report!"
E W !!,"This report only requires an 80 column printer."
;
W !!,"Note: This report may take a while to run."
W !?6,"You should queue this report to run after normal business hours.",!
;
; - Select a device.
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBJDI2",ZTDESC="IB - UNVERIFIED ELIGIBILITY"
.F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ ; - Tasked entry point.
;
I $G(IBXTRACT) D E^IBJDE(2,1) ; Change extract status.
;
N IBQUERY,IBQUERY1
K IB,^TMP("IBJDI21",$J),^TMP("IBJDI22",$J),^TMP("IBJDI23",$J)
K ^TMP("IBDFN",$J),^TMP($J,"SDAMA301")
S IBC="DEC^NOT^PEN^TOT^VER^VERO",IBQ=0
I IBSORT D G PROC
.S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
..S J=$P($G(^DG(40.8,I,0)),U) F K=1:1:6 S IB(J,$P(IBC,U,K))=0
S IBDIV="ALL" F I=1:1:6 S IB("ALL",$P(IBC,U,I))=0
;
PROC D ^IBJDI21 ; Process and print reports.
;
ENQ K ^TMP("IBJDI21",$J),^TMP("IBJDI22",$J),^TMP("IBJDI23",$J)
K ^TMP("IBDFN",$J),^TMP($J,"SDAMA301")
I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDOD,IBDN,IBPAG,IBRUN,IBX,IBXX,IBPERV
K IBESD,IBPM,IBPMD,IBOE,IBOED,IBES,IBLT,IBNUMO,IBNUMD,IBNEXT,IBDT,IBDTF
K IBC,IBN,IBDIV,IBSORT,IBPERD,IBPERO,IBPERP,VAUTD,DFN,POP,I,J,K
K X,X1,X2,Y,%,%ZIS,DIR,DIROUT,DTOUT,DUOUT,DIRUT,ZTDESC,ZTRTN,ZTSAVE
Q
;
DHLP ; - 'Sort by division' prompt.
W !!,"Select: '<CR>' to print the trend report without regard to"
W !?15,"division"
W !?11,"'Y' to select those divisions for which a separate"
W !?15,"trend report should be created",!?11,"'^' to quit"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDI2 2764 printed Dec 13, 2024@02:23:15 Page 2
IBJDI2 ;ALB/CPM - VETERANS WITH UNVERIFIED ELIGIBILITY ;16-DEC-96
+1 ;;2.0;INTEGRATED BILLING;**69,91,98,100,118,249**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; - Option entry point.
+1 ;
+2 WRITE !!,"This report measures the number of patients who have been treated at the"
+3 WRITE !,"facility but whose eligibility has not been verified. This report will"
+4 WRITE !,"also list patients with verified eligibility for at least 2 years, if any.",!
+5 ;
DATE DO DATE^IBOUTL
IF IBBDT=""!(IBEDT="")
GOTO ENQ
+1 ;
+2 ; - Sort by division?
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("?")="^D DHLP^IBJDI2"
+4 SET DIR("A")="Do you wish to sort this report by division"
WRITE !
+5 DO ^DIR
SET IBSORT=+Y
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+6 KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT
+7 ;
+8 ; Select division(s).
IF IBSORT
DO PSDR^IBODIV
if Y<0
GOTO ENQ
+9 ;
+10 ; - Select a detailed or summary report.
+11 DO DS^IBJD
IF IBRPT["^"
GOTO ENQ
+12 ;
+13 IF IBRPT="D"
WRITE !!,"You will need a 132 column printer for this report!"
+14 IF '$TEST
WRITE !!,"This report only requires an 80 column printer."
+15 ;
+16 WRITE !!,"Note: This report may take a while to run."
+17 WRITE !?6,"You should queue this report to run after normal business hours.",!
+18 ;
+19 ; - Select a device.
+20 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+21 IF $DATA(IO("Q"))
Begin DoDot:1
+22 SET ZTRTN="DQ^IBJDI2"
SET ZTDESC="IB - UNVERIFIED ELIGIBILITY"
+23 FOR I="IB*","VAUTD","VAUTD("
SET ZTSAVE(I)=""
+24 DO ^%ZTLOAD
+25 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+26 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+27 ;
+28 USE IO
+29 ;
DQ ; - Tasked entry point.
+1 ;
+2 ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(2,1)
+3 ;
+4 NEW IBQUERY,IBQUERY1
+5 KILL IB,^TMP("IBJDI21",$JOB),^TMP("IBJDI22",$JOB),^TMP("IBJDI23",$JOB)
+6 KILL ^TMP("IBDFN",$JOB),^TMP($JOB,"SDAMA301")
+7 SET IBC="DEC^NOT^PEN^TOT^VER^VERO"
SET IBQ=0
+8 IF IBSORT
Begin DoDot:1
+9 SET I=0
FOR
SET I=$SELECT(VAUTD:$ORDER(^DG(40.8,I)),1:$ORDER(VAUTD(I)))
if 'I
QUIT
Begin DoDot:2
+10 SET J=$PIECE($GET(^DG(40.8,I,0)),U)
FOR K=1:1:6
SET IB(J,$PIECE(IBC,U,K))=0
End DoDot:2
End DoDot:1
GOTO PROC
+11 SET IBDIV="ALL"
FOR I=1:1:6
SET IB("ALL",$PIECE(IBC,U,I))=0
+12 ;
PROC ; Process and print reports.
DO ^IBJDI21
+1 ;
ENQ KILL ^TMP("IBJDI21",$JOB),^TMP("IBJDI22",$JOB),^TMP("IBJDI23",$JOB)
+1 KILL ^TMP("IBDFN",$JOB),^TMP($JOB,"SDAMA301")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO ENQ1
+3 ;
+4 DO ^%ZISC
ENQ1 KILL IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDOD,IBDN,IBPAG,IBRUN,IBX,IBXX,IBPERV
+1 KILL IBESD,IBPM,IBPMD,IBOE,IBOED,IBES,IBLT,IBNUMO,IBNUMD,IBNEXT,IBDT,IBDTF
+2 KILL IBC,IBN,IBDIV,IBSORT,IBPERD,IBPERO,IBPERP,VAUTD,DFN,POP,I,J,K
+3 KILL X,X1,X2,Y,%,%ZIS,DIR,DIROUT,DTOUT,DUOUT,DIRUT,ZTDESC,ZTRTN,ZTSAVE
+4 QUIT
+5 ;
DHLP ; - 'Sort by division' prompt.
+1 WRITE !!,"Select: '<CR>' to print the trend report without regard to"
+2 WRITE !?15,"division"
+3 WRITE !?11,"'Y' to select those divisions for which a separate"
+4 WRITE !?15,"trend report should be created",!?11,"'^' to quit"
+5 QUIT
