IBCONSC ;ALB/MJB,SGD,AAS,RLW - NSC W/INSURANCE OUTPUT ;06 JUN 88 13:51
;;2.0;INTEGRATED BILLING;**66,120,528,752,763**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
;
INP ; Entry point for Inpatient Admission report
S IBINPT=1,IBSUB="AMV1" G EN1
;
INPDIS ; Entry point for Inpatient Discharge report
S IBINPT=2,IBSUB="AMV3" G EN1
;
EN ; Entry point for Outpatient report
S IBINPT=0,IBSUB=""
EN1 ;
;***
I '$D(DT) D DT^DICRW
K ^TMP($J)
;
D ^IBCONS4 I +$G(IBQUIT) G Q
;
S IBOUT=$$OUT G:IBOUT="" Q
;
DEV ; -- ask device
I IBOUT="R" W !!,*7,"*** Margin width of this output is 132 ***"
W !,"*** This output should be queued ***"
;
I +$G(IBINPT)=0,+$P($G(^IBE(350.9,1,6)),U,23) W !,"*** If queued, Outpatient Visits in Claims Tracking will be updated first ***"
;
S %ZIS="QM" D ^%ZIS G:POP Q
I $D(IO("Q")) K IO("Q") D G Q
.S ZTRTN="BEGIN^IBCONSC",ZTSAVE("IB*")="",ZTSAVE("VAUTD")="",ZTSAVE("VAUTD(")=""
.S ZTDESC="IB - Patients with Insurance and "_$S('IBINPT:"Outpatient ",IBINPT=1:"Admissions",1:"Discharges")
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
U IO
;***
BEGIN ; Background job main entry point. Set up the report header.
;***
;
I $D(ZTQUEUED),+$G(IBINPT)=0,+$P($G(^IBE(350.9,1,6)),U,23) D UPCT ; update CT if parameter on, opt, queued
;
S B="",IBL="",$P(IBL,"=",IOM)="",Y=IBBEG X ^DD("DD")
S IBHD="*Veterans with Reimbursable Insurance and "_$S('IBINPT:"OUTPATIENT Appointments",1:"INPATIENT "_$S(IBINPT=2:"Discharges",1:"Admissions"))_" for the "
S IBHD=IBHD_$S(IBBEG'=IBEND:"period covering ",1:"")_Y
I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
K %DT S X="N",%DT="T" D ^%DT X ^DD("DD") S IBDATE=Y K %DT
S IBTRKR=$G(^IBE(350.9,1,6)),IBQUIT=0
;
; Compile data for the report
D @($S(IBINPT:"LOOP1",1:"LOOP2")_"^IBCONS2")
G:IBQUIT Q
;
; Print the report
S X=132 X ^%ZOSF("RM") D LOOP25^IBCONS1
;
Q ; Clean up variables and close the output device.
W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K %,%DT,B,I,I1,II,J,K,L,M,N,X,X1,X2,Y,C,DFN,IBAT,IBCL,IBCNT,IBIFN,IBBILL,IBSELUBL,IBSELBNA,IBSELBIL,IBFORMFD
K IBFLAG,IBI,IBDT,IBPAGE,IBL,IBHD,IBBEG1,IBBEG,IBEND,IBOUT,IBSTOP,IBFDT,IBND0,IBNDM,IBNDMP,IBST,IBTDT,IBWHO
K IBTRKR,IBOE,IBSELRNB,IBADMVT,IBETYP,IBRMARK,IBQUIT,IBSELCDV,IBSELRNG,IBSELSR1,IBSELSR2,IBAUTH,IBPRTICR,IBPRTIEX
K IBINPT,IBPGM,IBVAR,IBFLAG,IBNAME,IBAPPT,IBDC,IBDAT,IBDFN,IBSELTRM,IBQUIT,IBPRTRDS,IBPRTIPC,IBPRTIGC
K POP,^TMP($J),IBDV,IBSUB,VAUTD,IBINDT,IBINS,IBDATE,IBFL,PTF,IBSC,IBMOV
Q
;
;
HDRDV N IBI,C Q:'$G(IBSELCDV)
I VAUTD=1 S IBHDRDV=": All Divisions Combined" Q
S IBHDRDV=" - Divisions Combined: ",C=""
S IBI="" F S IBI=$O(VAUTD(IBI)) Q:'IBI S IBHDRDV=IBHDRDV_C_" "_VAUTD(IBI),C=","
Q
;
UPCT ; Update Claims Tracking
; run the Claims Tracking opt tracker routine for same date range of report
; newed variables trying to keep the two jobs, report and CT update, from effecting each other except for date range
; Input: IBBEG, IBEND
; Output: bulletin indicating how many entries checked and how many added
;
N IBOE,IBOESTAT,IBOETYP,IBTSBDT,IBTSEDT,SDCNT,XMSUB,IBT,IBENCL,IBMESS,IBRMARK,IBANY,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y,IBQUIT
N VAUTD,IBINPT,IBSUB,IBSELUBL,IBSELBNA,IBSELBIL,IBSELRNB,IBSELCDV,IBSELTRM,IBSELRNG,IBPRTRDS,IBPRTIEX,IBPRTICR,IBPRTIPC,IBPRTIGC
;
S IBTSBDT=IBBEG,IBTSEDT=IBEND
;
N IBBEG,IBEND,IBTALK
;
S IBTALK=1 D EN1^IBTRKR4
Q
;
OUT() ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $G(IBINPT)'=2 S Y="R" G OUTQT ; IB*752/DTG no excel for inpt/otpt
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
;D ^DIR I $D(DIRUT) Q ""
D ^DIR I $D(DIRUT) S Y="" G OUTQT ;IB*752/DTG common quit point
;
OUTQT ; Exit point ; IB*752/DTG new exit point
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCONSC 3867 printed Apr 09, 2024@21:08:23 Page 2
IBCONSC ;ALB/MJB,SGD,AAS,RLW - NSC W/INSURANCE OUTPUT ;06 JUN 88 13:51
+1 ;;2.0;INTEGRATED BILLING;**66,120,528,752,763**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
INP ; Entry point for Inpatient Admission report
+1 SET IBINPT=1
SET IBSUB="AMV1"
GOTO EN1
+2 ;
INPDIS ; Entry point for Inpatient Discharge report
+1 SET IBINPT=2
SET IBSUB="AMV3"
GOTO EN1
+2 ;
EN ; Entry point for Outpatient report
+1 SET IBINPT=0
SET IBSUB=""
EN1 ;
+1 ;***
+2 IF '$DATA(DT)
DO DT^DICRW
+3 KILL ^TMP($JOB)
+4 ;
+5 DO ^IBCONS4
IF +$GET(IBQUIT)
GOTO Q
+6 ;
+7 SET IBOUT=$$OUT
if IBOUT=""
GOTO Q
+8 ;
DEV ; -- ask device
+1 IF IBOUT="R"
WRITE !!,*7,"*** Margin width of this output is 132 ***"
+2 WRITE !,"*** This output should be queued ***"
+3 ;
+4 IF +$GET(IBINPT)=0
IF +$PIECE($GET(^IBE(350.9,1,6)),U,23)
WRITE !,"*** If queued, Outpatient Visits in Claims Tracking will be updated first ***"
+5 ;
+6 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO Q
+7 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+8 SET ZTRTN="BEGIN^IBCONSC"
SET ZTSAVE("IB*")=""
SET ZTSAVE("VAUTD")=""
SET ZTSAVE("VAUTD(")=""
+9 SET ZTDESC="IB - Patients with Insurance and "_$SELECT('IBINPT:"Outpatient ",IBINPT=1:"Admissions",1:"Discharges")
+10 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO Q
+11 ;
+12 USE IO
+13 ;***
BEGIN ; Background job main entry point. Set up the report header.
+1 ;***
+2 ;
+3 ; update CT if parameter on, opt, queued
IF $DATA(ZTQUEUED)
IF +$GET(IBINPT)=0
IF +$PIECE($GET(^IBE(350.9,1,6)),U,23)
DO UPCT
+4 ;
+5 SET B=""
SET IBL=""
SET $PIECE(IBL,"=",IOM)=""
SET Y=IBBEG
XECUTE ^DD("DD")
+6 SET IBHD="*Veterans with Reimbursable Insurance and "_$SELECT('IBINPT:"OUTPATIENT Appointments",1:"INPATIENT "_$SELECT(IBINPT=2:"Discharges",1:"Admissions"))_" for the "
+7 SET IBHD=IBHD_$SELECT(IBBEG'=IBEND:"period covering ",1:"")_Y
+8 IF IBBEG<IBEND
SET Y=IBEND
XECUTE ^DD("DD")
SET IBHD=IBHD_" through "_Y
+9 KILL %DT
SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
SET IBDATE=Y
KILL %DT
+10 SET IBTRKR=$GET(^IBE(350.9,1,6))
SET IBQUIT=0
+11 ;
+12 ; Compile data for the report
+13 DO @($SELECT(IBINPT:"LOOP1",1:"LOOP2")_"^IBCONS2")
+14 if IBQUIT
GOTO Q
+15 ;
+16 ; Print the report
+17 SET X=132
XECUTE ^%ZOSF("RM")
DO LOOP25^IBCONS1
+18 ;
Q ; Clean up variables and close the output device.
+1 WRITE !
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL %,%DT,B,I,I1,II,J,K,L,M,N,X,X1,X2,Y,C,DFN,IBAT,IBCL,IBCNT,IBIFN,IBBILL,IBSELUBL,IBSELBNA,IBSELBIL,IBFORMFD
+5 KILL IBFLAG,IBI,IBDT,IBPAGE,IBL,IBHD,IBBEG1,IBBEG,IBEND,IBOUT,IBSTOP,IBFDT,IBND0,IBNDM,IBNDMP,IBST,IBTDT,IBWHO
+6 KILL IBTRKR,IBOE,IBSELRNB,IBADMVT,IBETYP,IBRMARK,IBQUIT,IBSELCDV,IBSELRNG,IBSELSR1,IBSELSR2,IBAUTH,IBPRTICR,IBPRTIEX
+7 KILL IBINPT,IBPGM,IBVAR,IBFLAG,IBNAME,IBAPPT,IBDC,IBDAT,IBDFN,IBSELTRM,IBQUIT,IBPRTRDS,IBPRTIPC,IBPRTIGC
+8 KILL POP,^TMP($JOB),IBDV,IBSUB,VAUTD,IBINDT,IBINS,IBDATE,IBFL,PTF,IBSC,IBMOV
+9 QUIT
+10 ;
+11 ;
HDRDV NEW IBI,C
if '$GET(IBSELCDV)
QUIT
+1 IF VAUTD=1
SET IBHDRDV=": All Divisions Combined"
QUIT
+2 SET IBHDRDV=" - Divisions Combined: "
SET C=""
+3 SET IBI=""
FOR
SET IBI=$ORDER(VAUTD(IBI))
if 'IBI
QUIT
SET IBHDRDV=IBHDRDV_C_" "_VAUTD(IBI)
SET C=","
+4 QUIT
+5 ;
UPCT ; Update Claims Tracking
+1 ; run the Claims Tracking opt tracker routine for same date range of report
+2 ; newed variables trying to keep the two jobs, report and CT update, from effecting each other except for date range
+3 ; Input: IBBEG, IBEND
+4 ; Output: bulletin indicating how many entries checked and how many added
+5 ;
+6 NEW IBOE,IBOESTAT,IBOETYP,IBTSBDT,IBTSEDT,SDCNT,XMSUB,IBT,IBENCL,IBMESS,IBRMARK,IBANY,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y,IBQUIT
+7 NEW VAUTD,IBINPT,IBSUB,IBSELUBL,IBSELBNA,IBSELBIL,IBSELRNB,IBSELCDV,IBSELTRM,IBSELRNG,IBPRTRDS,IBPRTIEX,IBPRTICR,IBPRTIPC,IBPRTIGC
+8 ;
+9 SET IBTSBDT=IBBEG
SET IBTSEDT=IBEND
+10 ;
+11 NEW IBBEG,IBEND,IBTALK
+12 ;
+13 SET IBTALK=1
DO EN1^IBTRKR4
+14 QUIT
+15 ;
OUT() ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ; IB*752/DTG no excel for inpt/otpt
IF $GET(IBINPT)'=2
SET Y="R"
GOTO OUTQT
+3 WRITE !
+4 SET DIR(0)="SA^E:Excel;R:Report"
+5 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+6 SET DIR("B")="Report"
+7 ;D ^DIR I $D(DIRUT) Q ""
+8 ;IB*752/DTG common quit point
DO ^DIR
IF $DATA(DIRUT)
SET Y=""
GOTO OUTQT
+9 ;
OUTQT ; Exit point ; IB*752/DTG new exit point
+1 QUIT Y
