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