IBCOMC2 ;ALB/CMS - IDENTIFY PT BY AGE WITH OR WITHOUT INSURANCE (CON'T) ;10-09-98
;;2.0;INTEGRATED BILLING;**103,153,516,528,743,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
Q
ENH ; Sort help Text
W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
W !,?5,"Enter 2 to search by Terminal Digit. The output will be sorted"
W !,?5,"by the 8th and 9th digits and then the 6th and 7th digits of the"
W !,?5,"Patient's SSN.",!
Q
;
INSH ; Search criteria help Text
W !!,?5,"Enter 1 to List patients covered by policies in Insurance Co. Name Range"
W !,?15,"(i.e. Sort By: MEDICARE To: MEDICAREZZZ)"
W !,?5,"Enter 2 to List patients covered by policies of the selected Insurance Co."
W !,?15,"(User may enter up to six Companies.)"
W !,?5,"Enter 3 to list patients with NO Coverage on file."
Q
;
AGEH ; Sort AGE help text
W !!,?5,"Enter an Age Range to sort by (1-250). Or press return at the Start Age"
W !,?5,"prompt to not include Age range in search criteria."
Q
;
HD ;Write Heading
N IBX S IBPAGE=IBPAGE+1
;IB*752/DTG add full header in for excel
;I IBOUT="E" W:($E(IOST,1,2)["C-") ! W "Patient Name^SSN^Age^DOB^Means Test?^Inp/Out^Last Visit^Insurance Name^Reimb VA?^Plan Name" Q
I IBOUT="E" D Q
.I IBPAGE>1 Q
.I $E(IOST,1,2)["C-" W !
.W "Patients "_$S(IBSIN=3:"Without",1:"With")_" Insurance Report "_$$FMTE^XLFDT($$NOW^XLFDT,"Z"),!
.W "Filtered by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL),! ;IB*752/DTG change sort to filter
.W "Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z"),!
.I IBSIN=1 W "Insurance Company Range: "_$S(IBSINF="":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL),!
.I IBSIN=3 W "Patients with no Insurance on File",!
.I IBAGEF W "Age Range: "_IBAGEF_" to "_IBAGEL,!
.W "* - Patient Deceased",!
.I IBSIN=2 D
..W "Active Policies with selected Insurance Companies:",!
..S IBX=0 F S IBX=$O(IBSIN(IBX)) Q:'IBX W $P(IBSIN(IBX),U,2),!
.W "Patient Name^SSN^Age^DOB^Means Test?^Inp/Out^Last Visit^Insurance Name^Reimb VA?^Plan Name"
;
W @IOF,!,"Patients "_$S(IBSIN=3:"Without",1:"With")_" Insurance Report",?50,$$FMTE^XLFDT($$NOW^XLFDT,"Z"),?70," Page ",IBPAGE
I IBPAGE=1 D
.;IB*743/TAZ - Modified Range Choice for beginning
.;W !,?5,"Sorted by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
.W !,?5,"Filtered by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL) ;IB*752/DTG change sort to filter
.W !,?5,"Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
.;IB*743/TAZ - Modified Range Choice for beginning
.;I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="A":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
.I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
.I IBSIN=3 W !,?5,"Patients with no Insurance on File"
.I IBAGEF W !,?5,"Age Range: "_IBAGEF_" to "_IBAGEL
.W !,?5,"* - Patient Deceased"
.;IB*752/DTG change from 6 insurances to many
.;I IBSIN=2 W !,?5,"Active Policies with selected Insurance Companies:" F IBX=1:1:6 Q:'$D(IBSIN(IBX)) W !,?10,$P(IBSIN(IBX),U,2)
.I IBSIN=2 D
..W !,?5,"Active Policies with selected Insurance Companies:"
..S IBX=0 F S IBX=$O(IBSIN(IBX)) Q:'IBX W !,?10,$P(IBSIN(IBX),U,2)
W !!?58,"Means",!,"Patient Name (SSN)",?39,"Age",?44,"DOB",?58,"Test?",?70,"Last Visit"
W ! F IBX=1:1:80 W "="
Q
;
WRT ;Write data lines
N IBCDA,IBDA,IBDFN,IBINS,IBNA,IBPOL,IBPT,X,Y S IBQUIT=0
S IBNA="" F S IBNA=$O(^TMP("IBCOMC",$J,1,IBNA)) Q:(IBNA="")!(IBQUIT=1) D
.S IBDFN=0 F S IBDFN=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN)) Q:('IBDFN)!(IBQUIT=1) D
..S IBPT=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN))
..;
..I ($Y+5)>IOSL,(IBOUT="R") D I IBQUIT=1 Q
...D ASK I IBQUIT=1 Q
...D HD
..;
..; Excel Output
..I IBOUT="E" W !,$P(IBPT,U,1)_U_$TR($TR($P(IBPT,U,2),"(",""),")","")_U_$P(IBPT,U,3,5)_U_$P($P(IBPT,U,6)," ")_U_$P($P(IBPT,U,6)," ",2)
..; Report Output
..I IBOUT="R" W !!,$E($P(IBPT,U,1),1,30)_" "_$P(IBPT,U,2),?39,$P(IBPT,U,3),?44,$P(IBPT,U,4),?58,$P(IBPT,U,5),?65,$P(IBPT,U,6)
..;
..S IBDA=0 F S IBDA=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA)) Q:('IBDA)!(IBQUIT=1) D
...S IBINS=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA))
...I IBSIN=3 W:IBOUT="R" ! W:IBOUT="E" U W IBINS Q
...; Excel Output
...I IBOUT="E" W U_$P(IBINS,U,1,3)
...; Report Output
...I IBOUT="R" W !?3,$E($P(IBINS,U,1),1,30),?35,"Reimb VA? ",$P(IBINS,U,2),!?4,"Plan Name: ",$E($P(IBINS,U,3),1,65)
...;
;I 'IBQUIT D ASK ;IB*752/DTG - remove the extra pause
Q
;
ASK ; Ask to Continue with display
; also called from IBCNSUR1 and IBCOMA1
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E" D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOMC2 5118 printed Sep 23, 2025@19:54:34 Page 2
IBCOMC2 ;ALB/CMS - IDENTIFY PT BY AGE WITH OR WITHOUT INSURANCE (CON'T) ;10-09-98
+1 ;;2.0;INTEGRATED BILLING;**103,153,516,528,743,752**;21-MAR-94;Build 20
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
ENH ; Sort help Text
+1 WRITE !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
+2 WRITE !,?5,"Enter 2 to search by Terminal Digit. The output will be sorted"
+3 WRITE !,?5,"by the 8th and 9th digits and then the 6th and 7th digits of the"
+4 WRITE !,?5,"Patient's SSN.",!
+5 QUIT
+6 ;
INSH ; Search criteria help Text
+1 WRITE !!,?5,"Enter 1 to List patients covered by policies in Insurance Co. Name Range"
+2 WRITE !,?15,"(i.e. Sort By: MEDICARE To: MEDICAREZZZ)"
+3 WRITE !,?5,"Enter 2 to List patients covered by policies of the selected Insurance Co."
+4 WRITE !,?15,"(User may enter up to six Companies.)"
+5 WRITE !,?5,"Enter 3 to list patients with NO Coverage on file."
+6 QUIT
+7 ;
AGEH ; Sort AGE help text
+1 WRITE !!,?5,"Enter an Age Range to sort by (1-250). Or press return at the Start Age"
+2 WRITE !,?5,"prompt to not include Age range in search criteria."
+3 QUIT
+4 ;
HD ;Write Heading
+1 NEW IBX
SET IBPAGE=IBPAGE+1
+2 ;IB*752/DTG add full header in for excel
+3 ;I IBOUT="E" W:($E(IOST,1,2)["C-") ! W "Patient Name^SSN^Age^DOB^Means Test?^Inp/Out^Last Visit^Insurance Name^Reimb VA?^Plan Name" Q
+4 IF IBOUT="E"
Begin DoDot:1
+5 IF IBPAGE>1
QUIT
+6 IF $EXTRACT(IOST,1,2)["C-"
WRITE !
+7 WRITE "Patients "_$SELECT(IBSIN=3:"Without",1:"With")_" Insurance Report "_$$FMTE^XLFDT($$NOW^XLFDT,"Z"),!
+8 ;IB*752/DTG change sort to filter
WRITE "Filtered by: "_$SELECT(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$SELECT(IBRF="":"FIRST",1:IBRF)_" to "_$SELECT(IBRL="zzzzzz":"LAST",1:IBRL),!
+9 WRITE "Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z"),!
+10 IF IBSIN=1
WRITE "Insurance Company Range: "_$SELECT(IBSINF="":"FIRST",1:IBSINF)_" to "_$SELECT(IBSINL="zzzzzz":"LAST",1:IBSINL),!
+11 IF IBSIN=3
WRITE "Patients with no Insurance on File",!
+12 IF IBAGEF
WRITE "Age Range: "_IBAGEF_" to "_IBAGEL,!
+13 WRITE "* - Patient Deceased",!
+14 IF IBSIN=2
Begin DoDot:2
+15 WRITE "Active Policies with selected Insurance Companies:",!
+16 SET IBX=0
FOR
SET IBX=$ORDER(IBSIN(IBX))
if 'IBX
QUIT
WRITE $PIECE(IBSIN(IBX),U,2),!
End DoDot:2
+17 WRITE "Patient Name^SSN^Age^DOB^Means Test?^Inp/Out^Last Visit^Insurance Name^Reimb VA?^Plan Name"
End DoDot:1
QUIT
+18 ;
+19 WRITE @IOF,!,"Patients "_$SELECT(IBSIN=3:"Without",1:"With")_" Insurance Report",?50,$$FMTE^XLFDT($$NOW^XLFDT,"Z"),?70," Page ",IBPAGE
+20 IF IBPAGE=1
Begin DoDot:1
+21 ;IB*743/TAZ - Modified Range Choice for beginning
+22 ;W !,?5,"Sorted by: "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$S(IBRF="A":"FIRST",1:IBRF)_" to "_$S(IBRL="zzzzzz":"LAST",1:IBRL)
+23 ;IB*752/DTG change sort to filter
WRITE !,?5,"Filtered by: "_$SELECT(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Range: "_$SELECT(IBRF="":"FIRST",1:IBRF)_" to "_$SELECT(IBRL="zzzzzz":"LAST",1:IBRL)
+24 WRITE !,?5,"Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
+25 ;IB*743/TAZ - Modified Range Choice for beginning
+26 ;I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="A":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
+27 IF IBSIN=1
WRITE !,?5,"Insurance Company Range: "_$SELECT(IBSINF="":"FIRST",1:IBSINF)_" to "_$SELECT(IBSINL="zzzzzz":"LAST",1:IBSINL)
+28 IF IBSIN=3
WRITE !,?5,"Patients with no Insurance on File"
+29 IF IBAGEF
WRITE !,?5,"Age Range: "_IBAGEF_" to "_IBAGEL
+30 WRITE !,?5,"* - Patient Deceased"
+31 ;IB*752/DTG change from 6 insurances to many
+32 ;I IBSIN=2 W !,?5,"Active Policies with selected Insurance Companies:" F IBX=1:1:6 Q:'$D(IBSIN(IBX)) W !,?10,$P(IBSIN(IBX),U,2)
+33 IF IBSIN=2
Begin DoDot:2
+34 WRITE !,?5,"Active Policies with selected Insurance Companies:"
+35 SET IBX=0
FOR
SET IBX=$ORDER(IBSIN(IBX))
if 'IBX
QUIT
WRITE !,?10,$PIECE(IBSIN(IBX),U,2)
End DoDot:2
End DoDot:1
+36 WRITE !!?58,"Means",!,"Patient Name (SSN)",?39,"Age",?44,"DOB",?58,"Test?",?70,"Last Visit"
+37 WRITE !
FOR IBX=1:1:80
WRITE "="
+38 QUIT
+39 ;
WRT ;Write data lines
+1 NEW IBCDA,IBDA,IBDFN,IBINS,IBNA,IBPOL,IBPT,X,Y
SET IBQUIT=0
+2 SET IBNA=""
FOR
SET IBNA=$ORDER(^TMP("IBCOMC",$JOB,1,IBNA))
if (IBNA="")!(IBQUIT=1)
QUIT
Begin DoDot:1
+3 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^TMP("IBCOMC",$JOB,1,IBNA,IBDFN))
if ('IBDFN)!(IBQUIT=1)
QUIT
Begin DoDot:2
+4 SET IBPT=$GET(^TMP("IBCOMC",$JOB,1,IBNA,IBDFN))
+5 ;
+6 IF ($Y+5)>IOSL
IF (IBOUT="R")
Begin DoDot:3
+7 DO ASK
IF IBQUIT=1
QUIT
+8 DO HD
End DoDot:3
IF IBQUIT=1
QUIT
+9 ;
+10 ; Excel Output
+11 IF IBOUT="E"
WRITE !,$PIECE(IBPT,U,1)_U_$TRANSLATE($TRANSLATE($PIECE(IBPT,U,2),"(",""),")","")_U_$PIECE(IBPT,U,3,5)_U_$PIECE($PIECE(IBPT,U,6)," ")_U_$PIECE($PIECE(IBPT,U,6)," ",2)
+12 ; Report Output
+13 IF IBOUT="R"
WRITE !!,$EXTRACT($PIECE(IBPT,U,1),1,30)_" "_$PIECE(IBPT,U,2),?39,$PIECE(IBPT,U,3),?44,$PIECE(IBPT,U,4),?58,$PIECE(IBPT,U,5),?65,$PIECE(IBPT,U,6)
+14 ;
+15 SET IBDA=0
FOR
SET IBDA=$ORDER(^TMP("IBCOMC",$JOB,1,IBNA,IBDFN,IBDA))
if ('IBDA)!(IBQUIT=1)
QUIT
Begin DoDot:3
+16 SET IBINS=$GET(^TMP("IBCOMC",$JOB,1,IBNA,IBDFN,IBDA))
+17 IF IBSIN=3
if IBOUT="R"
WRITE !
if IBOUT="E"
WRITE U
WRITE IBINS
QUIT
+18 ; Excel Output
+19 IF IBOUT="E"
WRITE U_$PIECE(IBINS,U,1,3)
+20 ; Report Output
+21 IF IBOUT="R"
WRITE !?3,$EXTRACT($PIECE(IBINS,U,1),1,30),?35,"Reimb VA? ",$PIECE(IBINS,U,2),!?4,"Plan Name: ",$EXTRACT($PIECE(IBINS,U,3),1,65)
+22 ;
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;I 'IBQUIT D ASK ;IB*752/DTG - remove the extra pause
+24 QUIT
+25 ;
ASK ; Ask to Continue with display
+1 ; also called from IBCNSUR1 and IBCOMA1
+2 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="E"
DO ^DIR
+5 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET IBQUIT=1
+6 QUIT
