- 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 Jan 18, 2025@03:24:32 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