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

IBTUBO3.m

Go to the documentation of this file.
  1. IBTUBO3 ;ALB/RB - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;03 Aug 2004 9:12 AM
  1. ;;2.0;INTEGRATED BILLING;**123,159,192,155,277,516,547,608,665**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. REPORT ; - Prepare report if requested, send summary bulletin.
  1. N IBDIV,IBN,IBPAG,IBQ,IBRUN,DFN,DTE,FL,PT,X0,X1
  1. S IBRUN=$$HTE^XLFDT($H,1)
  1. D BULL^IBTUBUL G:'IBDET REPRTQ
  1. ;
  1. REPRT1 ;
  1. S (IBPAG,IBQ)=0
  1. ;I '$D(^TMP($J)) S X0="" D HDR,NIM D:'IBQ PAUSE G REPRTQ
  1. I '$O(^TMP($J,"IBTUB",0)) S X0="",IBDIV=999999 D HDR,NIM D:'IBQ PAUSE G REPRTQ
  1. I $G(IBSBD) D SUMPG
  1. S IBDIV=0
  1. I $D(^TMP($J,"IBTUB-DIV")) D G REPRT1Q
  1. . F S IBDIV=$O(^TMP($J,"IBTUB-DIV",IBDIV)) Q:'IBDIV D REPRT2
  1. F S IBDIV=$O(^TMP($J,"IBTUB",IBDIV)) Q:'IBDIV D REPRT2
  1. ;
  1. REPRT1Q ;
  1. ;
  1. ;WCJ;IB*2.0*665
  1. ;D:'IBQ PAUSE
  1. D:'IBQ EOR
  1. ;
  1. REPRTQ Q
  1. ;
  1. SUMPG ;IB*2.0*547/TAZ - Summary page to show which Division has blank pages for selected reports.
  1. N IBND
  1. S IBDIV=0
  1. F S IBDIV=$O(^DG(40.8,IBDIV)) Q:'IBDIV D
  1. . I $D(^TMP($J,"IBTUB-DIV")),'$D(^TMP($J,"IBTUB-DIV",IBDIV)) Q ;Not a selected division
  1. . F X0=1,2,3 I IBSEL[X0 D Q:IBQ
  1. .. S X1=$S(X0=2:"OPT",X0=3:"RX",1:"INPT")
  1. .. I '$D(^TMP($J,"IBTUB",IBDIV,X1)) S IBND(X0,IBDIV)=""
  1. I $D(IBND) D
  1. . S IBPAG=1 W !
  1. . W !,"Unbilled Amounts Report"
  1. . W ?60,"Run Date: ",IBRUN,?124,"Page ",$J(IBPAG,3)
  1. . W !,"No data for the following Divisions for the selected reports:"
  1. . F X0=1,2,3 I IBSEL[X0 D Q:IBQ
  1. .. W !,$S(X0=2:"Outpatient:",X0=3:"Prescriptions:",1:"Inpatient:")
  1. .. S IBDIV=0 W !
  1. .. F S IBDIV=$O(IBND(X0,IBDIV)) Q:'IBDIV D Q:IBQ
  1. ... I $Y>(IOSL-6) D HDR Q:IBQ W !,$S(X0=2:"Outpatient:",X0=3:"Prescriptions:",1:"Inpatient:")," Cont'd",!
  1. ... W $$GET1^DIQ(40.8,IBDIV_",",.01),!
  1. .. W !
  1. Q
  1. ;
  1. REPRT2 ;Print Detail lines
  1. F X0=1,2,3 I IBSEL[X0 D Q:IBQ
  1. . S X1=$S(X0=2:"OPT",X0=3:"RX",1:"INPT")
  1. . I IBSBD,'$D(^TMP($J,"IBTUB",IBDIV,X1)) Q ;IB*2.0*547/TAZ Suppress blank pages for Sort by Division
  1. . D HDR Q:IBQ I '$D(^TMP($J,"IBTUB",IBDIV,X1)) D NIM Q
  1. . S PT="" F S PT=$O(^TMP($J,"IBTUB",IBDIV,X1,PT)) Q:PT="" D Q:IBQ
  1. .. S DFN=+$P(PT,"@@",2) Q:'DFN
  1. .. S (DTE,FL)="" F S DTE=$O(^TMP($J,"IBTUB",IBDIV,X1,PT,DTE)) Q:DTE="" D Q:IBQ
  1. ... S IBX="" F S IBX=$O(^TMP($J,"IBTUB",IBDIV,X1,PT,DTE,IBX)) Q:IBX="" D Q:IBQ
  1. .... S IBN=^TMP($J,"IBTUB",IBDIV,X1,PT,DTE,IBX) D LINE Q:IBQ I X1["OPT" D CPTS Q:IBQ
  1. Q
  1. ;
  1. HDR ; - Output header.
  1. N I,X,XTP,IBDIVHDR
  1. I $E(IOST,1,2)="C-",IBPAG D PAUSE G HDRQ:IBQ
  1. I '$G(IBPAG) W !
  1. I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
  1. S IBDIVHDR=""
  1. I IBDIV=999999 S IBDIVHDR=$S('IBSBD&$D(^TMP($J,"IBTUB-DIV")):"SELECTED",'$G(IBSBD):"ALL",1:"UNKNOWN")
  1. E S IBDIVHDR=$$GET1^DIQ(40.8,IBDIV_",",.01)_" ("_$$GET1^DIQ(40.8,IBDIV_",",1)_")"
  1. S IBPAG=$G(IBPAG)+1
  1. W !,"Unbilled Amounts Report"
  1. W ?60,"Run Date: ",IBRUN,?124,"Page ",$J(IBPAG,3)
  1. S XTP=$S(X0=1:"INPATIENT",X0=2:"OUTPATIENT",X0=3:"PRESCRIPTIONS",1:"")
  1. I X0'=3 S XTP=XTP_" EPISODES"
  1. ;S X="ALL "_XTP_" FROM " ;JRA;IB*2.0*608 ';'
  1. S X=$S(($G(IBMCCF)="M"&(X0=2)):"MCCF CLAIMS - ",($G(IBMCCF)="N"&(X0=2)):"NON-MCCF CLAIMS - ",($G(IBMCCF)="B"&(X0=2)):"MCCF & NON-MCCF CLAIMS - ",1:"") ;JRA;IB*2.0*608
  1. S X=X_"ALL "_XTP_" FROM " ;JRA;IB*2.0*608
  1. S X=X_$$DTE(IBBDT)_" TO "_$$DTE(IBEDT\1)_" FOR DIVISION: "_IBDIVHDR
  1. I $G(IBCOMP) S X=X_" / DATA RECOMPILED/STORED FOR "_$$DAT2^IBOUTL(IBTIMON)
  1. S X=X_" / '*' AFTER THE PATIENT NAME = USUALLY BILLED MEANS TEST COPAYMENT"
  1. I X0=1 S X=X_" / 'H' AFTER THE ADMISSION DATE = PATIENT CURRENTLY HOSPITALIZED"
  1. I X0=3 S X=X_" / '$' AFTER THE ORIGINAL FILL DATE = ORIGINAL FILL DATE HAS BEEN BILLED"
  1. S X=X_" / 'CF' COLUMN = NUMBER OF CLAIMS ON FILE FOR THE EPISODE"
  1. I X0'=3 D
  1. . S X=X_" / 'I/P' COLUMN = 'I' - INSTITUTIONAL CLAIM MISSING," ;JRA IB*2.0*608 Fix misspelling 'INSTUTIONAL' => 'INSTITUTIONAL'
  1. . S X=X_" 'P' - PROFESSIONAL CLAIM MISSING"
  1. . Q
  1. F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) Q:X=""
  1. ;
  1. I 'X0 W !,$TR($J(" ",IOM)," ","-"),! G HDRQ
  1. W !!?29,"Last Prim. Claims" W:X0=3 ?52,"Fill",?123,"Original"
  1. W !,"Name",?29,"4SSN Elig. Track.ID#"
  1. I X0=1 W ?52,"Admission CF Insurance Carrier(s)",?98,"I/P",?102,"MRA"
  1. I X0=2 W ?52,"Care Dt. CF Insurance Carrier(s)",?98,"I/P",?102,"MRA",?106,"CPT I. Rate P. Rate"
  1. I X0=3 W ?52,"Date CF Ins. Carrier(s) MRA Drug Name Physician",?123,"Fill Dt."
  1. W !,$TR($J(" ",IOM)," ","-"),!
  1. I $D(ZTQUEUED),$$S^%ZTLOAD D
  1. . W !!,"...Task stoped at user request"
  1. . S (IBQ,ZTSTOP)=1
  1. . Q
  1. ;
  1. HDRQ Q
  1. ;
  1. CPTS ; - Outpatient Only (CPTs and Rates)
  1. N CPT,IBN1
  1. I $O(^TMP($J,"IBTUB",IBDIV,X1,PT,DTE,IBX,""))="" W ?98,"I",?103,$S('$G(IBINMRA):"",$G(^TMP($J,X1_"_MRA",PT,DTE,IBX)):"M",1:"") W ! Q
  1. S CPT="" F S CPT=$O(^TMP($J,"IBTUB",IBDIV,X1,PT,DTE,IBX,CPT)) Q:CPT="" D Q:IBQ
  1. . S IBN1=^TMP($J,"IBTUB",IBDIV,X1,PT,DTE,IBX,CPT)
  1. . I $Y>(IOSL-5) D HDR Q:IBQ S FL=0 D LINE
  1. . W ?98,$P(IBN1,U,3),?103,$S('$G(IBINMRA):"",$G(^TMP($J,"IBTUB",IBDIV,X1_"_MRA",PT,DTE,IBX)):"M",1:""),?106,CPT,?113,$J(+IBN1,8,2)
  1. . W ?124,$J($P(IBN1,U,2),8,2),!
  1. Q
  1. ;
  1. LINE ; - Print detail line.
  1. I $Y>(IOSL-6) D HDR G:IBQ LINQ S FL=0
  1. I 'FL D
  1. . W $E($P(PT,"@@"),1,26) I $$BIL^DGMTUB(DFN,+DTE) W " *"
  1. . W ?29,$$SSN(DFN),?34,$E($$ELIG(DFN),1,5) S FL=1
  1. ;
  1. W ?39,$J(IBX,11)
  1. ; - Inpatient and Outpatient Only
  1. I X1'["RX" D
  1. . W ?52,$$DTE(+DTE) W:X1["INPT" $S($P(IBN,U,5):"H",1:"")
  1. . W ?62,$J($P(IBN,U),2),?65,$$INS(DFN,+DTE,34)
  1. . I X1["INPT" D
  1. .. I $P(IBN,U,2)'="" W ?98,$E($P(IBN,U,2),1,3),!
  1. .. I '$G(^TMP($J,"IBTUB",IBDIV,X1_"_MRA",PT,DTE,IBX))!'$G(IBINMRA) W:$P(IBN,U,2)="" ! Q
  1. .. W ?98,$E($P(^TMP($J,"IBTUB",IBDIV,X1_"_MRA",PT,DTE,IBX),U,2),1,3),?103,"M",!
  1. ;
  1. ; - Pharmacy Only
  1. I X1["RX" D G LINQ
  1. . W ?52,$$DTE(+DTE),?61,$J($P(IBN,U),2),?64,$$INS(DFN,+DTE,19),?85,$S('$G(IBINMRA):"",$G(^TMP($J,X1_"_MRA",PT,DTE,IBX)):"M",1:"")
  1. . W ?88,$E($P(IBN,U,6),1,15),?105,$E($P(IBN,U,2),1,14)
  1. . W ?123,$$DTE($P(IBN,U,3)) W:$P(IBN,"^",5) "$" W !
  1. ;
  1. LINQ Q
  1. ;
  1. SSN(DFN) ; - Return last 4 of patient's SSN.
  1. N SSN,VADM
  1. D DEM^VADPT S SSN=$P(VADM(2),"^"),SSN=$E(SSN,6,9) D KVA^VADPT
  1. Q SSN
  1. ;
  1. ELIG(DFN) ; - Return patient's primary eligibility (1st 10 characters).
  1. N ELIG,VAEL
  1. D ELIG^VADPT S ELIG=$E($P(VAEL(1),"^",2),1,10) D KVAR^VADPT
  1. Q ELIG
  1. ;
  1. DTE(D) ; - Format date (MM/DD/YY or MM/YY).
  1. Q $S('$G(D):"",1:$E(D,4,5)_"/"_$S($E(D,6,7)'="00":$E(D,6,7)_"/",1:"")_$E(D,2,3))
  1. ;
  1. INS(P,D,C) ; - Return patient's insurance carrier(s).
  1. ; Input: P=patient IEN, D=event date, C=Size of the Ins.Carrier column
  1. ; Output: List of Providers
  1. ;
  1. I '$G(P)!('$G(D)) Q ""
  1. ;
  1. N INSC,INSL,INSN,LST,TMP,X
  1. ;
  1. S INSL="" D ALL^IBCNS1(P,"LST",1,D)
  1. S X=0 F S X=$O(LST(X)) Q:'X D
  1. . S INSC=+$G(LST(X,0)) Q:$D(TMP(INSC))!'INSC
  1. . S INSN=$P($G(^DIC(36,INSC,0)),U)
  1. . I $G(LST(0))>1 S INSN=$E(INSN,1,C\2)
  1. . S INSL=INSL_","_INSN
  1. . S TMP(INSC)=""
  1. ;
  1. S $E(INSL)=""
  1. I $L(INSL,",")>1,$L(INSL)>C D
  1. . S INSL=$E(INSL,1,C-3),$P(INSL,",",$L(INSL,","))="..."
  1. S INSL=$E(INSL,1,C)
  1. ;
  1. Q INSL
  1. ;
  1. NIM ; - Print 'no info' message.
  1. W !?3,"No information available for the period specified."
  1. Q
  1. ;
  1. PAUSE ; - Page break.
  1. I $E(IOST,1,2)'="C-" Q
  1. I IOSL>24 Q ;User is creating a continuous document to a log file.
  1. N IBI,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. F IBI=$Y:1:(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
  1. Q
  1. ;
  1. ;WCJ;IB*2.0*665
  1. EOR ; - End of Report
  1. I $E(IOST,1,2)'="C-"!(IOSL>24) D WEOR Q ;User is creating a continuous document to a log file.
  1. F IBI=$Y:1:(IOSL-5) W !
  1. D WEOR
  1. N IBI,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
  1. Q
  1. ;
  1. WEOR ; - End of Report Visual Indicator
  1. W !,?(IOM-$L("*** END OF REPORT ***")\2),"*** END OF REPORT ***",!
  1. Q