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

IBJDI5.m

Go to the documentation of this file.
  1. IBJDI5 ;ALB/CPM - INSURANCE POLICIES NOT VERIFIED ;18-DEC-96
  1. ;;2.0;INTEGRATED BILLING;**69,98,100,118,123,528**;21-MAR-94;Build 163
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; - Option entry point.
  1. ;
  1. W !!,"This report provides a number of the insurance policies which were"
  1. W !,"entered into the system within a given timeframe, but were never verified.",!
  1. ;
  1. DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
  1. ;
  1. ; - Select a detailed or summary report.
  1. D DS^IBJD I IBRPT["^" G ENQ
  1. ;
  1. ; - Select print/not print verified policies/totals.
  1. S DIR(0)="YO"
  1. S DIR("A",1)="Do you want to print a "_$S(IBRPT="D":"separate report for",1:"total number of")_" policies that were verified"
  1. S DIR("A")=" over a year ago"
  1. S DIR("B")="NO" D ^DIR K DIR S IBVER=Y I IBVER["^" G ENQ
  1. ;
  1. ; pick excel or report format
  1. N IBOUT
  1. S IBOUT=$$OUT
  1. ;
  1. ;
  1. I IBRPT="D" W !!,"You will need a 132 column printer for this report!"
  1. E W !!,"This report only requires an 80 column printer."
  1. ;
  1. W !!,"Note: This report may take a while to run."
  1. W !?6,"You should queue this report to run after normal business hours.",!
  1. ;
  1. ; - Select a device.
  1. S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. I $D(IO("Q")) D G ENQ
  1. .S ZTRTN="DQ^IBJDI5",ZTDESC="IB - INSURANCE POLICIES NOT VERIFIED"
  1. .F I="IBBDT","IBEDT","IBRPT","IBVER","IBOUT" S ZTSAVE(I)=""
  1. .D ^%ZTLOAD
  1. .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. ;
  1. U IO
  1. ;
  1. DQ ; - Tasked entry point.
  1. ;
  1. I $G(IBXTRACT) D E^IBJDE(5,1) ; Change extract status.
  1. ;
  1. N IBQUERY
  1. K IB,^TMP("IBJDI51",$J),^TMP("IBJDI52",$J)
  1. S (IB("NOT"),IB("TOT"),IB("VER"),IBQ)=0 S:IBVER IB("VERO")=0
  1. ;
  1. ; - Find inpatients treated within the user-specified date range.
  1. S IBD=IBBDT-.01 F S IBD=$O(^DGPM("ATT3",IBD)) Q:'IBD!(IBD\1>IBEDT) D Q:IBQ
  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("Insurance Policies Not Verified") Q:IBQ
  1. ..S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD
  1. ..S DFN=+$P(IBPMD,U,3) Q:'DFN
  1. ..;
  1. ..; - Process patient.
  1. ..I '$D(^TMP("IBJDI51",$J,DFN)) D PROC(DFN,"*",IBD)
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. ; - Find outpatients treated within the user-specified date range.
  1. D CLOSE^IBSDU(.IBQUERY)
  1. D OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDI5(Y0)","Insurance Policies Not Verified",.IBQ,"IBJDI51",.IBQUERY)
  1. D CLOSE^IBSDU(.IBQUERY)
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. ; - Find data required for the report.
  1. S IBC=0 F S IBC=$O(^TMP("IBJDI51",$J,IBC)) Q:'IBC D Q:IBQ
  1. .I IBC#100=0 S IBQ=$$STOP^IBOUTL("Insurance Policies Not Verified") Q:IBQ
  1. .;
  1. .; - Get the patient's active insurance policies.
  1. .K IBINS S IBC1=$G(^TMP("IBJDI51",$J,IBC))
  1. .D ALL^IBCNS1(IBC,"IBINS",1,+IBC1) Q:'$D(IBINS)
  1. .S IBC2=0 F S IBC2=$O(IBINS(IBC2)) Q:'IBC2 D
  1. ..;
  1. ..; - Make sure the insurance company reimburses VA.
  1. ..S IBC3=$G(^DIC(36,+$G(IBINS(IBC2,0)),0))
  1. ..Q:$P(IBC3,U)="" Q:$P(IBC3,U,2)="N"
  1. ..;
  1. ..S IBCDFND=$G(IBINS(IBC2,1))
  1. ..;
  1. ..S IB("TOT")=IB("TOT")+1 ; Count all.
  1. ..;
  1. ..; - Check if policy is verified, verified over a year, or neither.
  1. ..S IBVFLG=0
  1. ..I $P(IBCDFND,U,3) D Q:'IBVFLG
  1. ...S IB("VER")=IB("VER")+1 Q:'IBVER
  1. ...S X1=DT,X2=$P(IBCDFND,U,3) D ^%DTC
  1. ...I X>365 S IB("VERO")=IB("VERO")+1,IBVFLG=1
  1. ..E S IB("NOT")=IB("NOT")+1
  1. ..;
  1. ..; - Build line for detailed report.
  1. ..I IBRPT="D" D
  1. ...S IBDOD=$S(+$G(^DPT(IBC,.35)):$$DAT2^IBOUTL(+$G(^(.35))\1),1:"")
  1. ...S X=$G(^DPT(IBC,0)),IBEBY=$P(IBCDFND,U,2)
  1. ...S IBVDTE=$S(IBVFLG:$P(IBCDFND,U,3),1:"")
  1. ...S IBVBY=$S(IBVFLG:$P(IBCDFND,U,4),1:"")
  1. ...S ^TMP("IBJDI52",$J,IBVFLG,$P(X,U)_$P(IBC1,U,2)_"@@"_$P(X,U,9)_"@@"_IBDOD_"@@"_IBC,IBC2)=$P(IBC3,U)_U_IBEBY_U_$S(+IBCDFND>0:+IBCDFND\1,1:"")_U_IBVBY_U_$S(+IBVDTE>0:IBVDTE\1,1:"")
  1. ;
  1. I IBQ G ENQ
  1. ;
  1. I $G(IBXTRACT) D E^IBJDE(5,0) G ENQ ; Extract summary data.
  1. ;
  1. ; - Print the reports.
  1. S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
  1. I IBRPT="D" D DET
  1. I 'IBQ D:IBOUT="R" SUM
  1. I IBOUT="E" D EXCSUM
  1. ;
  1. I 'IBQ D PAUSE
  1. ;
  1. ENQ K ^TMP("IBJDI51",$J),^TMP("IBJDI52",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
  1. ;
  1. D ^%ZISC
  1. ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRPT,IBD,IBDN,IBPH,IBPM,IBINS,IBPMD,IBPAG,IBRUN,%
  1. K IBEBY,IBVBY,IBVDTE,IBDOD,IBPER,IBC,IBC1,IBC2,IBC3,IBCDFN,IBVER,IBVFLG
  1. K IBCDFND,IBX,IBX1,IBX2,IBX3,DFN,POP,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE,%ZIS,IBXTRACT,STOP
  1. Q
  1. ;
  1. ENC(IBOED) ; - Encounter extract for outpatient loop.
  1. ; Input: IBOED = Outpatient encounter in file #409.68
  1. ;
  1. D PROC(+$P(IBOED,U,2),"",+IBOED) ; Process patient.
  1. Q
  1. ;
  1. PROC(DFN,IBIPC,IBDTE) ; - Process each specific patient.
  1. ; Input: DFN = Pointer to the patient in file #2
  1. ; IBIPC = Inpatient treatment marker
  1. ; ("*"=Had inpat. treatment, null=No inpat. treatment)
  1. ; IBDTE = Patient's checkout or discharge date
  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. ; - Set patient index.
  1. S ^TMP("IBJDI51",$J,DFN)=IBDTE\1_U_IBIPC
  1. ;
  1. PRCQ K VA,VAERR,VAEL
  1. Q
  1. ;
  1. ENCHK(IBOED) ; - Check outpatient's encounter record.
  1. ; Input: IBOED = Outpatient encounter in file #409.68
  1. ; Output: 1 = OK for processing
  1. ; 0 = Not OK for processing
  1. ;
  1. N X,X1 S Y=0 I '$G(IBOED) G ENCKQ
  1. ;
  1. ; - Check if encounter was a registration/cancellation without exam.
  1. S X=+$P(IBOED,U,2)
  1. S X1=+$P($G(^DPT(X,"DIS",+$O(^DPT("ADIS",+IBOED,X,0)),0)),U,7)
  1. I $D(^DIC(37,"B","CANCEL WITHOUT EXAM",X1)) G ENCKQ
  1. I $D(^DIC(37,"B","NO CARE OR TREATMENT REQUIRED",X1)) G ENCKQ
  1. ;
  1. I "^1^4^7^"[("^"_+$P(IBOED,U,10)_"^") G ENCKQ ; C&P/collat/emply visit.
  1. I $P(IBOED,U,12)'=2 G ENCKQ ; Not checked out.
  1. ;
  1. S Y=1
  1. ENCKQ Q Y
  1. ;
  1. DET ; - Print the detailed report.
  1. I '$D(^TMP("IBJDI52",$J,0)) S IBX=0 D HDET W !,"All policies within the selected date range have been verified." D PAUSE
  1. I IBOUT="E" S IBX=0 D EXCHDR
  1. S IBX="" F S IBX=$O(^TMP("IBJDI52",$J,IBX)) Q:IBX="" D Q:IBQ
  1. .I IBOUT="R" D HDET Q:IBQ
  1. .S IBX1="" F S IBX1=$O(^TMP("IBJDI52",$J,IBX,IBX1)) Q:IBX1="" D Q:IBQ
  1. ..I IBOUT="R" I $Y>(IOSL-4) D PAUSE Q:IBQ D HDET Q:IBQ
  1. ..I IBOUT="R" W $P(IBX1,"@@"),?33,$$SSN($P(IBX1,"@@",2)),?47,$P(IBX1,"@@",3)
  1. ..S IBX2=0 F S IBX2=$O(^TMP("IBJDI52",$J,IBX,IBX1,IBX2)) Q:'IBX2 S IBX3=^(IBX2) D
  1. ...I IBOUT="R" I $Y>(IOSL-4) D PAUSE Q:IBQ D HDET Q:IBQ
  1. ...I IBOUT="R" D
  1. ....W ?62,$P(IBX3,U),?94,$E($P($G(^VA(200,+$P(IBX3,U,2),0)),U),1,24)
  1. ....W ?120,$$DAT2^IBOUTL($P(IBX3,U,3)),!
  1. ....I IBX W ?94,$E($P($G(^VA(200,+$P(IBX3,U,4),0)),U),1,24),?120,$$DAT2^IBOUTL($P(IBX3,U,5)),!
  1. ...I IBOUT="E" D
  1. ....W $P(IBX1,"@@")_U_$$SSN($P(IBX1,"@@",2))_U_$P(IBX1,"@@",3)
  1. ....W U_$P(IBX3,U)_U_$E($P($G(^VA(200,+$P(IBX3,U,2),0)),U),1,24)_U_$$DAT2^IBOUTL($P(IBX3,U,3)),!
  1. ....I IBX W "^^^^"_$E($P($G(^VA(200,+$P(IBX3,U,4),0)),U),1,24)_U_$$DAT2^IBOUTL($P(IBX3,U,5)),!
  1. .;
  1. .I 'IBQ,IBOUT="R" D PAUSE
  1. ;
  1. I IBOUT="R",'$D(^TMP("IBJDI52",$J,1)),IBVER S IBX=1 D HDET W !,"All policies within the selected date range have been verified less than a year ago." D PAUSE
  1. Q
  1. ;
  1. HDET ; - Write the detail report header.
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
  1. S IBPAG=IBPAG+1
  1. W !,"Insurance Policies ",$S(IBX:"Verified Over a Year Ago",1:"Not Verified"),?80,"Run Date: ",IBRUN,?123,"Page: ",IBPAG
  1. W !,"For Patients treated for the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)_" ('*' = Had inpatient care)"
  1. I IBX W !?94,"Policy Entered By Date Entered"
  1. W !,"Patient",?33,"SSN",?47,"Date of Death"
  1. W ?62,"Insurance Company",?94,"Policy ",$S(IBX:"Verified",1:"Entered")," By",?120,"Date ",$S(IBX:"Verif'd",1:"Entered")
  1. W !,$$DASH(132),!!
  1. S IBQ=$$STOP^IBOUTL("Insurance Policies Not Verified")
  1. Q
  1. ;
  1. EXCHDR ; Excel format
  1. W !,"Insurance Policies ",$S(IBX:"Verified Over a Year Ago",1:"Not Verified")
  1. w !,"Run Date: ",IBRUN
  1. W !,"For Patients treated for the period "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT)_" ('*' = Had inpatient care)"
  1. W !,"Patient"_U_"SSN"_U_"Date of Death"_U_"Insurance Company"_U_"Policy ",$S(IBX:"Verified",1:"Entered")," By"_U_"Date ",$S(IBX:"Verif'd",1:"Entered"),!
  1. Q
  1. ;
  1. SUM ; - Print the summary report.
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
  1. S IBPAG=IBPAG+1
  1. W !!?$S(IBVER:14,1:24),"INSURANCE POLICIES NOT VERIFIED",$S(IBVER:"/VERIFIED OVER 1 YEAR",1:"")
  1. W !?32,"SUMMARY REPORT",!!?17,"For Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
  1. W !!?24,"Run Date: ",IBRUN,!?24,$$DASH(31),!!
  1. ;
  1. S IBPER=$S('IB("TOT"):0,1:$J(IB("VER")/IB("TOT")*100,0,2))
  1. W ?24,"Number of Patients Treated:",?53,$J(IB("TOT"),5)
  1. W !?23,"Number of Policies Verified:",?53,$J(IB("VER"),5),?62,"(",IBPER,"%)"
  1. I IBVER W !?7,"Number of Policies Verified Over a Year Ago:",?53,$J(IB("VERO"),5),?62,"(",$S('IB("VERO"):0,1:$J(IB("VERO")/IB("TOT")*100,0,2)),"%)"
  1. W !?19,"Number of Policies Not Verified:",?53,$J(IB("NOT"),5),?62,"(",$S('IB("TOT"):0,1:$J(100-IBPER,0,2)),"%)"
  1. Q
  1. ;
  1. EXCSUM ;excell format
  1. W !!,"INSURANCE POLICIES NOT VERIFIED",$S(IBVER:"/VERIFIED OVER 1 YEAR",1:"")
  1. W !,"SUMMARY REPORT"
  1. W !,"For Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
  1. W !,"Run Date: ",IBRUN
  1. ;
  1. S IBPER=$S('IB("TOT"):0,1:IB("VER")/IB("TOT")*100)
  1. W !,"Number of Patients Treated:"_U_IB("TOT")
  1. W !,"Number of Policies Verified:"_U_IB("VER")_U_"(",IBPER,"%)"
  1. I IBVER W !,"Number of Policies Verified Over a Year Ago:"_U_IB("VERO")_U_"(",$S('IB("VERO"):0,1:IB("VERO")/IB("TOT")*100),"%)"
  1. W !,"Number of Policies Not Verified:"_U_IB("NOT")_U_"("_$S('IB("TOT"):0,1:(100-IBPER))_"%)"
  1. Q
  1. ;
  1. DASH(X) ; - Return a dashed line.
  1. Q $TR($J("",X)," ","=")
  1. ;
  1. PAUSE ; - Page break.
  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. 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:"")
  1. ;
  1. OUT() ; Prompt to allow users to select output format
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  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) S STOP=1 Q ""
  1. Q Y