Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCONSC

IBCONSC.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. INP ; Entry point for Inpatient Admission report
  1. S IBINPT=1,IBSUB="AMV1" G EN1
  1. ;
  1. INPDIS ; Entry point for Inpatient Discharge report
  1. S IBINPT=2,IBSUB="AMV3" G EN1
  1. ;
  1. EN ; Entry point for Outpatient report
  1. S IBINPT=0,IBSUB=""
  1. EN1 ;
  1. ;***
  1. I '$D(DT) D DT^DICRW
  1. K ^TMP($J)
  1. ;
  1. D ^IBCONS4 I +$G(IBQUIT) G Q
  1. ;
  1. S IBOUT=$$OUT G:IBOUT="" Q
  1. ;
  1. DEV ; -- ask device
  1. I IBOUT="R" W !!,*7,"*** Margin width of this output is 132 ***"
  1. W !,"*** This output should be queued ***"
  1. ;
  1. 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 ***"
  1. ;
  1. S %ZIS="QM" D ^%ZIS G:POP Q
  1. I $D(IO("Q")) K IO("Q") D G Q
  1. .S ZTRTN="BEGIN^IBCONSC",ZTSAVE("IB*")="",ZTSAVE("VAUTD")="",ZTSAVE("VAUTD(")=""
  1. .S ZTDESC="IB - Patients with Insurance and "_$S('IBINPT:"Outpatient ",IBINPT=1:"Admissions",1:"Discharges")
  1. .D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. ;
  1. U IO
  1. ;***
  1. BEGIN ; Background job main entry point. Set up the report header.
  1. ;***
  1. ;
  1. I $D(ZTQUEUED),+$G(IBINPT)=0,+$P($G(^IBE(350.9,1,6)),U,23) D UPCT ; update CT if parameter on, opt, queued
  1. ;
  1. S B="",IBL="",$P(IBL,"=",IOM)="",Y=IBBEG X ^DD("DD")
  1. S IBHD="*Veterans with Reimbursable Insurance and "_$S('IBINPT:"OUTPATIENT Appointments",1:"INPATIENT "_$S(IBINPT=2:"Discharges",1:"Admissions"))_" for the "
  1. S IBHD=IBHD_$S(IBBEG'=IBEND:"period covering ",1:"")_Y
  1. I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
  1. K %DT S X="N",%DT="T" D ^%DT X ^DD("DD") S IBDATE=Y K %DT
  1. S IBTRKR=$G(^IBE(350.9,1,6)),IBQUIT=0
  1. ;
  1. ; Compile data for the report
  1. D @($S(IBINPT:"LOOP1",1:"LOOP2")_"^IBCONS2")
  1. G:IBQUIT Q
  1. ;
  1. ; Print the report
  1. S X=132 X ^%ZOSF("RM") D LOOP25^IBCONS1
  1. ;
  1. Q ; Clean up variables and close the output device.
  1. W !
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. 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
  1. K IBFLAG,IBI,IBDT,IBPAGE,IBL,IBHD,IBBEG1,IBBEG,IBEND,IBOUT,IBSTOP,IBFDT,IBND0,IBNDM,IBNDMP,IBST,IBTDT,IBWHO
  1. K IBTRKR,IBOE,IBSELRNB,IBADMVT,IBETYP,IBRMARK,IBQUIT,IBSELCDV,IBSELRNG,IBSELSR1,IBSELSR2,IBAUTH,IBPRTICR,IBPRTIEX
  1. K IBINPT,IBPGM,IBVAR,IBFLAG,IBNAME,IBAPPT,IBDC,IBDAT,IBDFN,IBSELTRM,IBQUIT,IBPRTRDS,IBPRTIPC,IBPRTIGC
  1. K POP,^TMP($J),IBDV,IBSUB,VAUTD,IBINDT,IBINS,IBDATE,IBFL,PTF,IBSC,IBMOV
  1. Q
  1. ;
  1. ;
  1. HDRDV N IBI,C Q:'$G(IBSELCDV)
  1. I VAUTD=1 S IBHDRDV=": All Divisions Combined" Q
  1. S IBHDRDV=" - Divisions Combined: ",C=""
  1. S IBI="" F S IBI=$O(VAUTD(IBI)) Q:'IBI S IBHDRDV=IBHDRDV_C_" "_VAUTD(IBI),C=","
  1. Q
  1. ;
  1. UPCT ; Update Claims Tracking
  1. ; run the Claims Tracking opt tracker routine for same date range of report
  1. ; newed variables trying to keep the two jobs, report and CT update, from effecting each other except for date range
  1. ; Input: IBBEG, IBEND
  1. ; Output: bulletin indicating how many entries checked and how many added
  1. ;
  1. N IBOE,IBOESTAT,IBOETYP,IBTSBDT,IBTSEDT,SDCNT,XMSUB,IBT,IBENCL,IBMESS,IBRMARK,IBANY,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y,IBQUIT
  1. N VAUTD,IBINPT,IBSUB,IBSELUBL,IBSELBNA,IBSELBIL,IBSELRNB,IBSELCDV,IBSELTRM,IBSELRNG,IBPRTRDS,IBPRTIEX,IBPRTICR,IBPRTIPC,IBPRTIGC
  1. ;
  1. S IBTSBDT=IBBEG,IBTSEDT=IBEND
  1. ;
  1. N IBBEG,IBEND,IBTALK
  1. ;
  1. S IBTALK=1 D EN1^IBTRKR4
  1. Q
  1. ;
  1. OUT() ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. I $G(IBINPT)'=2 S Y="R" G OUTQT ; IB*752/DTG no excel for inpt/otpt
  1. W !
  1. S DIR(0)="SA^E:Excel;R:Report"
  1. S DIR("A")="(E)xcel Format or (R)eport Format: "
  1. S DIR("B")="Report"
  1. ;D ^DIR I $D(DIRUT) Q ""
  1. D ^DIR I $D(DIRUT) S Y="" G OUTQT ;IB*752/DTG common quit point
  1. ;
  1. OUTQT ; Exit point ; IB*752/DTG new exit point
  1. Q Y