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

IBCOMC2.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ENH ; Sort help Text
  1. W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
  1. W !,?5,"Enter 2 to search by Terminal Digit. The output will be sorted"
  1. W !,?5,"by the 8th and 9th digits and then the 6th and 7th digits of the"
  1. W !,?5,"Patient's SSN.",!
  1. Q
  1. ;
  1. INSH ; Search criteria help Text
  1. W !!,?5,"Enter 1 to List patients covered by policies in Insurance Co. Name Range"
  1. W !,?15,"(i.e. Sort By: MEDICARE To: MEDICAREZZZ)"
  1. W !,?5,"Enter 2 to List patients covered by policies of the selected Insurance Co."
  1. W !,?15,"(User may enter up to six Companies.)"
  1. W !,?5,"Enter 3 to list patients with NO Coverage on file."
  1. Q
  1. ;
  1. AGEH ; Sort AGE help text
  1. W !!,?5,"Enter an Age Range to sort by (1-250). Or press return at the Start Age"
  1. W !,?5,"prompt to not include Age range in search criteria."
  1. Q
  1. ;
  1. HD ;Write Heading
  1. N IBX S IBPAGE=IBPAGE+1
  1. ;IB*752/DTG add full header in for excel
  1. ;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
  1. I IBOUT="E" D Q
  1. .I IBPAGE>1 Q
  1. .I $E(IOST,1,2)["C-" W !
  1. .W "Patients "_$S(IBSIN=3:"Without",1:"With")_" Insurance Report "_$$FMTE^XLFDT($$NOW^XLFDT,"Z"),!
  1. .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
  1. .W "Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z"),!
  1. .I IBSIN=1 W "Insurance Company Range: "_$S(IBSINF="":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL),!
  1. .I IBSIN=3 W "Patients with no Insurance on File",!
  1. .I IBAGEF W "Age Range: "_IBAGEF_" to "_IBAGEL,!
  1. .W "* - Patient Deceased",!
  1. .I IBSIN=2 D
  1. ..W "Active Policies with selected Insurance Companies:",!
  1. ..S IBX=0 F S IBX=$O(IBSIN(IBX)) Q:'IBX W $P(IBSIN(IBX),U,2),!
  1. .W "Patient Name^SSN^Age^DOB^Means Test?^Inp/Out^Last Visit^Insurance Name^Reimb VA?^Plan Name"
  1. ;
  1. W @IOF,!,"Patients "_$S(IBSIN=3:"Without",1:"With")_" Insurance Report",?50,$$FMTE^XLFDT($$NOW^XLFDT,"Z"),?70," Page ",IBPAGE
  1. I IBPAGE=1 D
  1. .;IB*743/TAZ - Modified Range Choice for beginning
  1. .;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)
  1. .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
  1. .W !,?5,"Date Last Treated Range: "_$$FMTE^XLFDT(IBBDT,"Z")_" to "_$$FMTE^XLFDT(IBEDT,"Z")
  1. .;IB*743/TAZ - Modified Range Choice for beginning
  1. .;I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="A":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
  1. .I IBSIN=1 W !,?5,"Insurance Company Range: "_$S(IBSINF="":"FIRST",1:IBSINF)_" to "_$S(IBSINL="zzzzzz":"LAST",1:IBSINL)
  1. .I IBSIN=3 W !,?5,"Patients with no Insurance on File"
  1. .I IBAGEF W !,?5,"Age Range: "_IBAGEF_" to "_IBAGEL
  1. .W !,?5,"* - Patient Deceased"
  1. .;IB*752/DTG change from 6 insurances to many
  1. .;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)
  1. .I IBSIN=2 D
  1. ..W !,?5,"Active Policies with selected Insurance Companies:"
  1. ..S IBX=0 F S IBX=$O(IBSIN(IBX)) Q:'IBX W !,?10,$P(IBSIN(IBX),U,2)
  1. W !!?58,"Means",!,"Patient Name (SSN)",?39,"Age",?44,"DOB",?58,"Test?",?70,"Last Visit"
  1. W ! F IBX=1:1:80 W "="
  1. Q
  1. ;
  1. WRT ;Write data lines
  1. N IBCDA,IBDA,IBDFN,IBINS,IBNA,IBPOL,IBPT,X,Y S IBQUIT=0
  1. S IBNA="" F S IBNA=$O(^TMP("IBCOMC",$J,1,IBNA)) Q:(IBNA="")!(IBQUIT=1) D
  1. .S IBDFN=0 F S IBDFN=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN)) Q:('IBDFN)!(IBQUIT=1) D
  1. ..S IBPT=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN))
  1. ..;
  1. ..I ($Y+5)>IOSL,(IBOUT="R") D I IBQUIT=1 Q
  1. ...D ASK I IBQUIT=1 Q
  1. ...D HD
  1. ..;
  1. ..; Excel Output
  1. ..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)
  1. ..; Report Output
  1. ..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)
  1. ..;
  1. ..S IBDA=0 F S IBDA=$O(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA)) Q:('IBDA)!(IBQUIT=1) D
  1. ...S IBINS=$G(^TMP("IBCOMC",$J,1,IBNA,IBDFN,IBDA))
  1. ...I IBSIN=3 W:IBOUT="R" ! W:IBOUT="E" U W IBINS Q
  1. ...; Excel Output
  1. ...I IBOUT="E" W U_$P(IBINS,U,1,3)
  1. ...; Report Output
  1. ...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)
  1. ...;
  1. ;I 'IBQUIT D ASK ;IB*752/DTG - remove the extra pause
  1. Q
  1. ;
  1. ASK ; Ask to Continue with display
  1. ; also called from IBCNSUR1 and IBCOMA1
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E" D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1
  1. Q