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