| [613] | 1 | IBCOMN ;ALB/CMS - PATIENTS NO COVERAGE VERIFIED REPORT; 10-09-98 | 
|---|
|  | 2 | ;;2.0;INTEGRATED BILLING;**103**;21-MAR-94 | 
|---|
|  | 3 | Q | 
|---|
|  | 4 | EN ;Entry point from option | 
|---|
|  | 5 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT | 
|---|
|  | 6 | N IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBQUIT,X,Y | 
|---|
|  | 7 | S (IBAIB,IBBDT,IBEDT,IBRF,IBRL)="" | 
|---|
|  | 8 | ; | 
|---|
|  | 9 | VR ; Ask Verification Date Range | 
|---|
|  | 10 | W !!,?2,"Patients with No Insurance Coverage Verification" | 
|---|
|  | 11 | W !!,"Enter Verification Date Range" | 
|---|
|  | 12 | D DATE^IBOUTL | 
|---|
|  | 13 | I IBBDT=""!(IBEDT="") W "     <Date Range not entered>" G EXIT | 
|---|
|  | 14 | ; | 
|---|
|  | 15 | W ! S DIR("A",1)="Sort report by" | 
|---|
|  | 16 | S DIR("A",2)="1  - Patient Name Range" | 
|---|
|  | 17 | S DIR("A",3)="2  - Terminal Digit Range" | 
|---|
|  | 18 | S DIR("A",4)="  " | 
|---|
|  | 19 | S DIR(0)="SAXB^1:Patient Name;2:Terminal Digit" | 
|---|
|  | 20 | S DIR("A")=" Select Number: ",DIR("B")="1",DIR("??")="^D ENH^IBCOMN" D ^DIR | 
|---|
|  | 21 | I +Y'>0 S IBQUIT=1 G EXIT | 
|---|
|  | 22 | S IBAIB=+Y | 
|---|
|  | 23 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT | 
|---|
|  | 24 | W !! D @$S(IBAIB=1:"NR",1:"TR") | 
|---|
|  | 25 | I $G(IBQUIT)=1 G EXIT | 
|---|
|  | 26 | ; | 
|---|
|  | 27 | W !! D QUE | 
|---|
|  | 28 | ; | 
|---|
|  | 29 | EXIT Q | 
|---|
|  | 30 | ; | 
|---|
|  | 31 | NR ; Ask Name Range | 
|---|
|  | 32 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y | 
|---|
|  | 33 | NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")="START WITH PATIENT NAME" | 
|---|
|  | 34 | D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q | 
|---|
|  | 35 | S:Y="FIRST" Y="A" S IBRF=Y | 
|---|
|  | 36 | S DIR(0)="FO",DIR("B")="LAST",DIR("A")="GO TO PATIENT NAME" | 
|---|
|  | 37 | D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q | 
|---|
|  | 38 | S:Y="LAST" Y="zzzzzz" S IBRL=Y | 
|---|
|  | 39 | I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR | 
|---|
|  | 40 | Q | 
|---|
|  | 41 | ; | 
|---|
|  | 42 | TR ; Ask Terminal Digit Range | 
|---|
|  | 43 | N DIR,DIRUT,DUOUT,DTOUT,X,Y | 
|---|
|  | 44 | S DIR(0)="FO^1:9^K:X'?1.9N X" | 
|---|
|  | 45 | S DIR("?")="Enter up to 9 digits of the Terminal Digit to include in Report" | 
|---|
|  | 46 | S DIR("B")="0000",DIR("A")="Start with Terminal Digit" | 
|---|
|  | 47 | D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q | 
|---|
|  | 48 | S IBRF=$E((Y_"000000000"),1,9) | 
|---|
|  | 49 | S DIR("B")="9999",DIR("A")="GO to Terminal Digit" | 
|---|
|  | 50 | D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q | 
|---|
|  | 51 | S IBRL=$E((Y_"999999999"),1,9) | 
|---|
|  | 52 | I IBRF>IBRL W !!,?5,"* The Go to Terminal Digit must follow after the Start with Digit. *",! G TR | 
|---|
|  | 53 | Q | 
|---|
|  | 54 | ; | 
|---|
|  | 55 | ENH ; Sort help Text | 
|---|
|  | 56 | W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)" | 
|---|
|  | 57 | W !!,?5,"Enter 2 to search by Terminal Digit.  The output will be sorted" | 
|---|
|  | 58 | W !,"by the 8th and 9th digits and then the 6th and 7th digits of the" | 
|---|
|  | 59 | W !,"Patient's SSN.",! | 
|---|
|  | 60 | Q | 
|---|
|  | 61 | ; | 
|---|
|  | 62 | QUE ; Ask Device | 
|---|
|  | 63 | N %ZIS,ZTRTN,ZTSAVE,ZTDESC | 
|---|
|  | 64 | W !,?10,"You may want to queue this report!",! | 
|---|
|  | 65 | S %ZIS="QM" D ^%ZIS G:POP QUEQ | 
|---|
|  | 66 | I $D(IO("Q")) K IO("Q") D  G QUEQ | 
|---|
|  | 67 | .S ZTRTN="BEG^IBCOMN1",ZTSAVE("IBRF")="",ZTSAVE("IBRL")="" | 
|---|
|  | 68 | .S ZTSAVE("IBAIB")="",ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")="" | 
|---|
|  | 69 | .S ZTDESC="IB - Patients w/no Coverage Verification" | 
|---|
|  | 70 | .D ^%ZTLOAD K ZTSK D HOME^%ZIS | 
|---|
|  | 71 | ; | 
|---|
|  | 72 | U IO | 
|---|
|  | 73 | I $E(IOST,1,2)["C-" W !!,?15,"... One Moment Please ..." | 
|---|
|  | 74 | D BEG^IBCOMN1 | 
|---|
|  | 75 | ; | 
|---|
|  | 76 | QUEQ ; Exit clean-UP | 
|---|
|  | 77 | W ! D ^%ZISC K IBTMP,IBAIB,IBRF,IBRL,VA,VAERR,VADM,VAPA,^TMP("IBCOMN",$J) | 
|---|
|  | 78 | Q | 
|---|
|  | 79 | ;IBCOMN | 
|---|