- 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 Feb 18, 2025@23:44:54 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