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

IBJDI41.m

Go to the documentation of this file.
  1. IBJDI41 ;ALB/CPM - PATIENTS WITH UNIDENTIFIED INSURANCE (CONT'D) ;17-DEC-96
  1. ;;2.0;INTEGRATED BILLING;**98,100,118,528,771**;21-MAR-94;Build 26
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; - Entry point from IBJDI4.
  1. ;
  1. ; - Find inpatients treated within the user-specified date range.
  1. N IBDCNT,IBFEED S IBDCNT=0 ;IB*771/DTG new var's
  1. I IOST["C-" S IBFEED=21
  1. E S IBFEED=50 ; IB*771/DTG correct for excessive line feeds at end of report
  1. I '$D(ZTQUEUED)&($E(IOST,1,2)="C-") W !,"Identify Patients "
  1. S IBD=IBBDT-.01 F S IBD=$O(^DGPM("ATT3",IBD)) Q:'IBD!(IBD\1>IBEDT) D Q:IBQ
  1. .; IB*771/DTG check for 'dots'
  1. .I '$D(ZTQUEUED)&($E(IOST,1,2)="C-") S IBDCNT=IBDCNT+1 I IBDCNT#500=0 W "."
  1. .S IBPM=0 F S IBPM=$O(^DGPM("ATT3",IBD,IBPM)) Q:'IBPM D Q:IBQ
  1. ..I IBPM#100=0 S IBQ=$$STOP^IBOUTL("Patients with Unidentified Insurance Report") Q:IBQ
  1. ..S IBPMD=$G(^DGPM(IBPM,0)) I 'IBPMD Q
  1. ..I IBSORT S IBDIV=$$DIV^IBJDI21(1,+$P(IBPMD,U,6)) Q:'$D(IB(IBDIV))
  1. ..S DFN=+$P(IBPMD,U,3) Q:'DFN
  1. ..;
  1. ..; - Process patient.
  1. ..I '$D(^TMP("IBJDI41",$J,DFN)) D PROC(DFN,IBD\1,"*")
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. ; - Find outpatients treated within the user-specified date range.
  1. D CLOSE^IBSDU(.IBQUERY)
  1. I '$D(ZTQUEUED)&($E(IOST,1,2)="C-") W !,"Gathering schedule info" ;IB*771/DTG message before schedule check
  1. D OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDI41(Y0)","Patients with Unidentified Insurance Report",.IBQ,"IBJDI41",.IBQUERY)
  1. D CLOSE^IBSDU(.IBQUERY)
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. I IBRPT'="D" G PRT
  1. ;
  1. ; - Find data required for the report.
  1. S IBDCNT=0 ; IB*771/DTG count for 'dot' display
  1. I '$D(ZTQUEUED)&($E(IOST,1,2)="C-") W !,"Compiling Detail "
  1. S DFN=0 F S DFN=$O(^TMP("IBJDI41",$J,DFN)) Q:'DFN S IBX=^(DFN) D Q:IBQ
  1. .I '$D(ZTQUEUED)&($E(IOST,1,2)="C-") S IBDCNT=IBDCNT+1 I IBDCNT#1000=0 W "." ; IB*771/DTG count for 'dot' display
  1. .I IBSEL=0,$P(IBX,U,4)'="*" Q
  1. .I DFN#100=0 S IBQ=$$STOP^IBOUTL("Patients with Unidentified Insurance Report") Q:IBQ
  1. .;
  1. .; - Set patient eligibilities for report.
  1. .D ELIG^VADPT S IBELIG=+$G(VAEL(1))_";"
  1. .I +IBELIG>0 S X=0 F S X=$O(VAEL(1,X)) Q:'X S IBELIG=IBELIG_X_";"
  1. .;
  1. .; - Set up detailed information to appear on the report.
  1. .S IBDN=$G(^DPT(DFN,0)),IBPAT=$P(IBDN,U)_$P(IBX,U,2)
  1. .S IBPH=$P($G(^DPT(DFN,.13)),U,1,2),IBSEL1=$P(IBX,U,3)
  1. .S IBDOD=$S(+$G(^DPT(DFN,.35)):$$DAT1^IBOUTL(+$G(^(.35))\1),1:"")
  1. .F X=1:1 S X1=$P(IBSEL1,",",X) Q:X1="" D
  1. ..S ^TMP("IBJDI42",$J,$P(IBX,U),X1,IBPAT_"@@"_DFN)=$P(IBDN,U,9)_U_$P(IBPH,U)_U_$P(IBPH,U,2)_U_$S(+IBELIG>0:IBELIG,1:"")_U_$P(IBX,U,4)_U_IBDOD_U_$S(IBRMK:$P(IBDN,U,10),1:"")
  1. .;
  1. .K VA,VAEL,VAERR
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. PRT ; - Print the reports.
  1. ;
  1. N IBDNXT S IBDNXT="" ;IB*771/DTG for print loop management
  1. ; - Extract summary data.
  1. I $G(IBXTRACT) D G ENQ
  1. .F X="BILL","DEC","HMO","IND","MEDC","MEDG","NO","NULL","TOT","UNK","YES" S IB(X)=$G(IB("ALL",X))
  1. .D E^IBJDE(4,0)
  1. ;
  1. S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
  1. I IBOUT="E" W ! ; IB*771/DTG add additional line feed for excel at start of print
  1. ;S IBDIV="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" D Q:IBQ
  1. S IBDIV="",IBDXT="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" S IBDNXT=$O(IB(IBDIV)) D Q:IBQ ;IB*771/DTG add check for next division
  1. .I IBRPT="D" D DET
  1. .;I IBOUT="E" D EXCSUM,PAUSE Q
  1. .I IBOUT="E" D EXCSUM D:IBDNXT'="" PAUSE Q ;IB*771/DTG check for next division
  1. .;I 'IBQ D SUM,PAUSE
  1. .I 'IBQ D SUM D:IBDNXT'="" PAUSE ;IB*771/DTG check for next division
  1. I '$G(IBQ) D EOR,PAUSE ;IB*771/DTG print EOR message
  1. ;
  1. ENQ Q
  1. ;
  1. EOR ; IB*771/DTG end of report
  1. W ! W:$G(IBOUT)="R" ?30 W "*** END OF REPORT ***",!
  1. Q
  1. ;
  1. ENC(IBOED) ; - Encounter extract for all patients loop.
  1. ; Input: IBOED = Outpatient encounter in file #409.68
  1. ; Pre-set variables IB array, IBSORT also required.
  1. ;
  1. I IBSORT S IBDIV=$$DIV^IBJDI21(0,+$P(IBOED,U,11)) Q:'$D(IB(IBDIV))
  1. D PROC(+$P(IBOED,U,2),+IBOED\1,"") ; Process patient.
  1. Q
  1. ;
  1. PROC(DFN,IBINDT,IBIPC) ; - Process each specific patient.
  1. ; Input: DFN = Pointer to the patient in file #2
  1. ; IBINDT = Encounter or discharge date
  1. ; IBIPC = Inpatient treatment marker
  1. ; ("*"=Had inpat. treatment, null=No inpat. treatment)
  1. ;
  1. ; Pre-set variables IB array, IBDIV, IBRPT, IBSEL also required.
  1. ;
  1. I $$TESTP^IBJDI1(DFN) Q ; Test patient.
  1. D ELIG^VADPT I 'VAEL(4) G PRCQ ; Patient is not a vet.
  1. ;
  1. ; - Find 'Covered by Insurance' indicator and set flags.
  1. S IBINSC="",IBSEL1=$S(IBSEL=0:"0,",1:""),IBX=$P($G(^DPT(DFN,.31)),U,11)
  1. I IBX="Y"!(IBX="N") D
  1. .I IBX="Y" D
  1. ..S IB(IBDIV,"YES")=IB(IBDIV,"YES")+1 S:IBSEL[1 IBSEL1=IBSEL1_"1,"
  1. .E S IB(IBDIV,"NO")=IB(IBDIV,"NO")+1 S:IBSEL[7 IBSEL1=IBSEL1_"7,"
  1. .;
  1. .S (IBOUTP,IBWNR)=1 D ^IBCNS Q:'IBINS F X=0:1:4 S IBFL(X)=0
  1. .S X=0 F S X=$O(IBDD(X)) Q:'X D
  1. ..I IBRPT="D",IBSEL'=0 S IBINSC=IBINSC_X_";"
  1. ..I $P($G(^DIC(36,X,0)),U,2)'="N",'IBFL(0) D
  1. ...S IB(IBDIV,"BILL")=IB(IBDIV,"BILL")+1,IBFL(0)=1
  1. ...I IBSEL[2 S IBSEL1=IBSEL1_"2,"
  1. ..S IBTYP=$$TYPE^IBJDI4(IBDD(X))
  1. ..I IBTYP=1,'IBFL(1) D
  1. ...S IB(IBDIV,"HMO")=IB(IBDIV,"HMO")+1,IBFL(1)=1
  1. ...I IBSEL[3 S IBSEL1=IBSEL1_"3,"
  1. ..I IBTYP=2,'IBFL(2) D
  1. ...S IB(IBDIV,"MEDC")=IB(IBDIV,"MEDC")+1,IBFL(2)=1
  1. ...I IBSEL[4 S IBSEL1=IBSEL1_"4,"
  1. ..I IBTYP=3,'IBFL(3) D
  1. ...S IB(IBDIV,"MEDG")=IB(IBDIV,"MEDG")+1,IBFL(3)=1
  1. ...I IBSEL[5 S IBSEL1=IBSEL1_"5,"
  1. ..I IBTYP=4,'IBFL(4) D
  1. ...S IB(IBDIV,"IND")=IB(IBDIV,"IND")+1,IBFL(4)=1
  1. ...I IBSEL[6 S IBSEL1=IBSEL1_"6,"
  1. I IBX="U" D
  1. .S IB(IBDIV,"UNK")=IB(IBDIV,"UNK")+1 S:IBSEL[8 IBSEL1=IBSEL1_"8,"
  1. I IBX="" D
  1. .S IB(IBDIV,"NULL")=IB(IBDIV,"NULL")+1 S:IBSEL[9 IBSEL1=IBSEL1_"9,"
  1. I IBRPT="D",IBSEL=0,(IBX="U"!(IBX="")) S IBINSC="*"
  1. ;
  1. ; - Set patient index and 'total patients' accumulator.
  1. S ^TMP("IBJDI41",$J,DFN)=IBDIV_U_$S(IBRPT="D":IBIPC_U_IBSEL1_U_IBINSC,1:"")
  1. S IB(IBDIV,"TOT")=IB(IBDIV,"TOT")+1
  1. I +$G(^DPT(DFN,.35)) S IB(IBDIV,"DEC")=IB(IBDIV,"DEC")+1 ; Deceased.
  1. ;
  1. PRCQ K IBDD,IBFL,IBINS,IBINSC,IBOUTP,IBTYP,IBWNR,IBX,VA,VAERR,VAEL,X
  1. Q
  1. ;
  1. DIV(X) ; - Return division name.
  1. S Y=$P($G(^DG(40.8,X,0)),U) I Y="" S Y=0
  1. Q Y
  1. ;
  1. DET ; - Print the detailed report.
  1. ;I IBSEL=0,'$D(^TMP("IBJDI42",$J,IBDIV,0)) S IBX=0 D HDET W !!,"There were no ",$$TITLE^IBJDI4(0)," during this period." G DETQ
  1. I IBSEL=0,'$D(^TMP("IBJDI42",$J,IBDIV,0)) S IBPAG=0,IBX=0 D HDET W !!,"There were no ",$$TITLE^IBJDI4(0)," during this period." G DETQ ;IB*771/DTG add initialize of page number
  1. I IBSEL'=0 F X=1:1 S IBX=$P(IBSEL,",",X) Q:IBX="" D
  1. .I '$D(^TMP("IBJDI42",$J,IBDIV,IBX)) S IBPAG=0 D HDET W !!,"There were no ",$$TITLE^IBJDI4(IBX)," during this period."
  1. ;
  1. I IBOUT="E" D EXCHDR
  1. S IBX="" F S IBX=$O(^TMP("IBJDI42",$J,IBDIV,IBX)) Q:IBX="" D Q:IBQ
  1. .I IBOUT="R" S IBPAG=0 D HDET Q:IBQ
  1. .S IBX1="" F S IBX1=$O(^TMP("IBJDI42",$J,IBDIV,IBX,IBX1)) Q:IBX1="" S IBX2=^(IBX1) D Q:IBQ
  1. ..I IBOUT="E" D EXCOUT Q
  1. ..I $Y>(IOSL-3) D PAUSE Q:IBQ D HDET Q:IBQ
  1. ..W $P(IBX1,"@@"),?27,$$SSN($P(IBX2,U)),?41,$E($P(IBX2,U,2),1,15),?58,$P(IBX2,U,3)
  1. ..S IBELIG=$P(IBX2,U,4) W ?80,$$ELIG(+IBELIG)
  1. ..S IBINSC=$P(IBX2,U,5) W ?102,$$INSC(+IBINSC),?124,$P(IBX2,U,6),!
  1. ..I IBRMK,$P(IBX2,U,7)]"" W ?2,"Remarks: ",$P(IBX2,U,7)
  1. ..I '$P(IBELIG,";",2),'$P(IBINSC,";",2),$P(IBX2,U,7)]"" W ! Q
  1. ..F X=2:1 Q:'$P(IBELIG,";",X)&('$P(IBINSC,";",X)) D
  1. ...W ?80,$$ELIG($P(IBELIG,";",X)),?102,$$INSC($P(IBINSC,";",X)),!
  1. ;
  1. DETQ I 'IBQ D PAUSE
  1. Q
  1. ;
  1. EXCOUT ; OUTPUT EXCEL FORMAT
  1. W !,$P(IBX1,"@@")_U_$$SSN($P(IBX2,U))_U_$E($P(IBX2,U,2),1,15)_U_$P(IBX2,U,3)_U
  1. S IBELIG=$P(IBX2,U,4) W $$ELIG(+IBELIG)_U
  1. S IBINSC=$P(IBX2,U,5) W $$INSC(+IBINSC)_U_$P(IBX2,U,6)_U
  1. I IBRMK,$P(IBX2,U,7)]"" W $P(IBX2,U,7)_U
  1. F X=2:1 Q:'$P(IBELIG,";",X)&('$P(IBINSC,";",X)) D
  1. .W $$ELIG($P(IBELIG,";",X))_U_$$INSC($P(IBINSC,";",X))
  1. Q
  1. ;
  1. HDET ; - Write the detail report header.
  1. I IBOUT="E" D EXCHDR Q ;IB*771/DTG use excel header for excel
  1. W @IOF,*13 S IBPAG=$G(IBPAG)+1
  1. W !,$$TITLE^IBJDI4(IBX),$S(IBDIV'="ALL":" for "_IBDIV,1:""),?80,"Run Date: ",IBRUN,?123,"Page: ",IBPAG
  1. W !,"Patients treated in the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)," NOTE: *=Had inpatient care, +=Billable insurance"
  1. W !!?45,"Home",?62,"Work",?124,"Date of"
  1. W !,"Patient",?27,"SSN",?41,"Phone Number",?58,"Phone Number",?80,"Eligibility",?102,"Insurance",?125,"Death"
  1. W !,$$DASH(132),!!
  1. S IBQ=$$STOP^IBOUTL("Patients with Unidentified Insurance Report")
  1. Q
  1. ;
  1. EXCHDR ; Write the excel header.
  1. W !,$$TITLE^IBJDI4(IBX),$S(IBDIV'="ALL":" for "_IBDIV,1:"")
  1. W !,"Run Date: ",IBRUN
  1. W !,"Patients treated in the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)," NOTE: *=Had inpatient care, +=Billable insurance"
  1. W !,"Patient"_U_"SSN"_U_"Home Phone Number"_U_"Work Phone Number"_U_"Eligibility"_U_"Insurance"_U_"Date of Death"
  1. Q
  1. ;
  1. SUM ; - Print the summary report.
  1. W @IOF,*13 S IBPAG=$G(IBPAG)+1
  1. W !!?26,"PATIENT INSURANCE STATISTICS",!
  1. I IBDIV'="ALL" W ?(61-$L(IBDIV))\2,"SUMMARY REPORT for ",IBDIV
  1. E W ?33,"SUMMARY REPORT"
  1. W !!?19,"Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
  1. W !!?24,"Run Date: ",IBRUN,!?20,$$DASH(40),!!
  1. ;
  1. S IBPER(1)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"YES")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(2)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"BILL")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(3)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"BILL")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(4)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(5)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(6)=$J($S('IB(IBDIV,"BILL"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"BILL")*100),0,2)
  1. S IBPER(7)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"MEDC")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(8)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"MEDC")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(9)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(10)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(11)=$J($S('IB(IBDIV,"BILL"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"BILL")*100),0,2)
  1. S IBPER(12)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"IND")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(13)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"NO")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(14)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"UNK")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(15)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"NULL")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(16)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"DEC")/IB(IBDIV,"TOT")*100),0,2)
  1. W ?22,"Number of Patients Treated:",?50,$J(IB(IBDIV,"TOT"),5)
  1. W !?9,"Number of Patients Covered by Insurance:",?50,$J(IB(IBDIV,"YES"),5)," (",IBPER(1),"%)"
  1. W !?3,"No. of Patients Covered by Billable Insurance:",?50,$J(IB(IBDIV,"BILL"),5)," (",IBPER(2),"%-",IBPER(3),"%)*"
  1. W !?12,"Number of Patients Covered by an HMO:",?50,$J(IB(IBDIV,"HMO"),5)," (",IBPER(4),"%-",IBPER(5),"%-",IBPER(6),"%)**"
  1. W !?10,"Number of Patients Covered by Medicare:",?50,$J(IB(IBDIV,"MEDC"),5)," (",IBPER(7),"%-",IBPER(8),"%)*"
  1. W !?11,"Number of Patients Covered by Medigap:",?50,$J(IB(IBDIV,"MEDG"),5)," (",IBPER(9),"%-",IBPER(10),"%-",IBPER(11),"%)**"
  1. W !?2,"No. of Patients Covered by an Indemnity Policy:",?50,$J(IB(IBDIV,"IND"),5)," (",IBPER(12),"%)"
  1. W !?5,"Number of Patients Not Covered by Insurance:",?50,$J(IB(IBDIV,"NO"),5)," (",IBPER(13),"%)"
  1. W !?7,"Number of Patients with Unknown Insurance:",?50,$J(IB(IBDIV,"UNK"),5)," (",IBPER(14),"%)"
  1. W !," No. of Patients w/Insurance Question Unanswered:",?50,$J(IB(IBDIV,"NULL"),5)," (",IBPER(15),"%)"
  1. W !?21,"Number of Deceased Patients:",?50,$J(IB(IBDIV,"DEC"),5)," (",IBPER(16),"%)"
  1. W !!," *(% from patients treated-% from patients with insurance)"
  1. W !,"**(% from patients treated-% from patients w/ins-% from patients w/billable ins)"
  1. Q
  1. ;
  1. EXCSUM ; - Print the summary report in excel format.
  1. W @IOF,*13 S IBPAG=$G(IBPAG)+1
  1. W !!,"PATIENT INSURANCE STATISTICS",!
  1. I IBDIV'="ALL" W ?(61-$L(IBDIV))\2,"SUMMARY REPORT for ",IBDIV
  1. E W ?33,"SUMMARY REPORT"
  1. W !,"Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
  1. W !,"Run Date: ",IBRUN,!
  1. ;
  1. S IBPER(1)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"YES")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(2)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"BILL")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(3)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"BILL")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(4)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(5)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(6)=$J($S('IB(IBDIV,"BILL"):0,1:IB(IBDIV,"HMO")/IB(IBDIV,"BILL")*100),0,2)
  1. S IBPER(7)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"MEDC")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(8)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"MEDC")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(9)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(10)=$J($S('IB(IBDIV,"YES"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"YES")*100),0,2)
  1. S IBPER(11)=$J($S('IB(IBDIV,"BILL"):0,1:IB(IBDIV,"MEDG")/IB(IBDIV,"BILL")*100),0,2)
  1. S IBPER(12)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"IND")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(13)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"NO")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(14)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"UNK")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(15)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"NULL")/IB(IBDIV,"TOT")*100),0,2)
  1. S IBPER(16)=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"DEC")/IB(IBDIV,"TOT")*100),0,2)
  1. W "Number of Patients Treated:"_U_$J(IB(IBDIV,"TOT"),5)
  1. W !,"Number of Patients Covered by Insurance:"_U_$J(IB(IBDIV,"YES"),5)," (",IBPER(1),"%)"
  1. W !,"No. of Patients Covered by Billable Insurance:"_U_$J(IB(IBDIV,"BILL"),5)," (",IBPER(2),"%-",IBPER(3),"%)*"
  1. W !,"Number of Patients Covered by an HMO:"_U_$J(IB(IBDIV,"HMO"),5)," (",IBPER(4),"%-",IBPER(5),"%-",IBPER(6),"%)**"
  1. W !,"Number of Patients Covered by Medicare:"_U_$J(IB(IBDIV,"MEDC"),5)," (",IBPER(7),"%-",IBPER(8),"%)*"
  1. W !,"Number of Patients Covered by Medigap:"_U_$J(IB(IBDIV,"MEDG"),5)," (",IBPER(9),"%-",IBPER(10),"%-",IBPER(11),"%)**"
  1. W !,"No. of Patients Covered by an Indemnity Policy:"_U_$J(IB(IBDIV,"IND"),5)," (",IBPER(12),"%)"
  1. W !,"Number of Patients Not Covered by Insurance:"_U_$J(IB(IBDIV,"NO"),5)," (",IBPER(13),"%)"
  1. W !,"Number of Patients with Unknown Insurance:"_U_$J(IB(IBDIV,"UNK"),5)," (",IBPER(14),"%)"
  1. W !,"No. of Patients w/Insurance Question Unanswered:"_U_$J(IB(IBDIV,"NULL"),5)," (",IBPER(15),"%)"
  1. W !,"Number of Deceased Patients:"_U_$J(IB(IBDIV,"DEC"),5)," (",IBPER(16),"%)"
  1. W !!," *(% from patients treated-% from patients with insurance)"
  1. W !,"**(% from patients treated-% from patients w/ins-% from patients w/billable ins)"
  1. Q
  1. ;
  1. DASH(X) ; - Return a dashed line.
  1. Q $TR($J("",X)," ","=")
  1. ;
  1. ELIG(X) ; - Return eligibility code name.
  1. Q $E($P($G(^DIC(8,+X,0)),U),1,20)
  1. ;
  1. INSC(X) ; - Return insurance company.
  1. S X=$G(^DIC(36,+X,0))
  1. Q $E($P(X,U),1,20)_$S($P(X,U,2)["Y"!($P(X,U,2)["*"):"+",1:"")
  1. ;
  1. PAUSE ; - Page break.
  1. I $D(ZTQUEUED) Q ;IB*771/DTG quit if report was queued
  1. I $E(IOST,1,2)'="C-" Q
  1. N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. ;F IBX=$Y:1:(IOSL-3) W !
  1. F IBX=1:1:(IBFEED-$Y) W ! ;IB*771/DTG stop extra blank lines
  1. S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
  1. Q
  1. ;
  1. SSN(X) ; - Format the SSN.
  1. Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")