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.
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