| 1 | IBCOMA ;ALB/CMS - IDENTIFY ACTIVE POLICIES W/NO EFFECTIVE DATE; 08-03-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,IBSIN,IBSTR,X,Y
 | 
|---|
| 7 |  S (IBAIB,IBBDT,IBEDT,IBRF,IBRL,IBSIN,IBSTR)=""
 | 
|---|
| 8 |  W !!,?10,"Identify Active Policies with NO Effective Date",!
 | 
|---|
| 9 |  S DIR("A",1)="Sort report by"
 | 
|---|
| 10 |  S DIR("A",2)="  1  - Patient Name Range"
 | 
|---|
| 11 |  S DIR("A",3)="  2  - Terminal Digit Range"
 | 
|---|
| 12 |  S DIR("A",4)="  "
 | 
|---|
| 13 |  S DIR(0)="SAXB^1:Patient Name;2:Terminal Digit"
 | 
|---|
| 14 |  S DIR("A")="  Select Number: ",DIR("B")="1",DIR("??")="^D ENH^IBCOMA" D ^DIR
 | 
|---|
| 15 |  I +Y'>0 S IBQUIT=1 G EXIT
 | 
|---|
| 16 |  S IBAIB=+Y
 | 
|---|
| 17 |  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
 | 
|---|
| 18 |  W !! D @$S(IBAIB=1:"NR",1:"TR")
 | 
|---|
| 19 |  I $G(IBQUIT)=1 G EXIT
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 | VER W !!
 | 
|---|
| 22 |  S DIR("A",1)="    Within "_$S(IBAIB=1:"Patient Name",1:"Terminal Digit")_" Include:"
 | 
|---|
| 23 |  S DIR("A",2)="      1  - Verified Policies"
 | 
|---|
| 24 |  S DIR("A",3)="      2  - Non-Verified Policies"
 | 
|---|
| 25 |  S DIR("A",4)="      3  - Both"
 | 
|---|
| 26 |  S DIR("A",5)="  "
 | 
|---|
| 27 |  S DIR(0)="SAXB^1:Verified Policies;2:Non-Verified Policies;3:Both"
 | 
|---|
| 28 |  S DIR("A")="      Select Number: ",DIR("B")="1",DIR("??")="^D ICH^IBCOMA" D ^DIR
 | 
|---|
| 29 |  I +Y'>0 S IBQUIT=1 G EXIT
 | 
|---|
| 30 |  S IBSIN=+Y
 | 
|---|
| 31 |  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
 | 
|---|
| 32 |  I IBSIN'=2 D VR I IBBDT=""!(IBEDT="") W "     <Date Range not entered>" G VER
 | 
|---|
| 33 |  I $G(IBQUIT)=1 G EXIT
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  W !! D QUE
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 | EXIT Q
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | NR ; Ask Name Range
 | 
|---|
| 40 |  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 | 
|---|
| 41 | NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")="  START WITH PATIENT NAME"
 | 
|---|
| 42 |  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
 | 
|---|
| 43 |  S:Y="FIRST" Y="A" S IBRF=Y
 | 
|---|
| 44 |  S DIR(0)="FO",DIR("B")="LAST",DIR("A")="  GO TO PATIENT NAME"
 | 
|---|
| 45 |  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
 | 
|---|
| 46 |  S:Y="LAST" Y="zzzzzz" S IBRL=Y
 | 
|---|
| 47 |  I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
 | 
|---|
| 48 |  Q
 | 
|---|
| 49 |  ;
 | 
|---|
| 50 | TR ; Ask Terminal Digit Range
 | 
|---|
| 51 |  N DIR,DIRUT,DUOUT,DTOUT,X,Y
 | 
|---|
| 52 |  S DIR(0)="FO^1:9^K:X'?1.9N X"
 | 
|---|
| 53 |  S DIR("?")="Enter up to 9 digits of the Terminal Digit to include in Report"
 | 
|---|
| 54 |  S DIR("B")="0000",DIR("A")="  Start with Terminal Digit"
 | 
|---|
| 55 |  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
 | 
|---|
| 56 |  S IBRF=$E((Y_"000000000"),1,9)
 | 
|---|
| 57 |  S DIR("B")="9999",DIR("A")="  GO to Terminal Digit"
 | 
|---|
| 58 |  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
 | 
|---|
| 59 |  S IBRL=$E((Y_"999999999"),1,9)
 | 
|---|
| 60 |  I IBRF>IBRL W !!,?5,"* The Go to Terminal Digit must follow after the Start with Digit. *",! G TR
 | 
|---|
| 61 |  Q
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | VR ; Ask Verification Date Range
 | 
|---|
| 64 |  N %DT,X,Y
 | 
|---|
| 65 |  W !!,"      Please enter Policy Verification Dates:"
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 | VRBDT ; - get begin date
 | 
|---|
| 68 |  S (IBBDT,IBEDT)=""
 | 
|---|
| 69 |  S %DT="AEX",%DT("A")="        Start with DATE: " D ^%DT K %DT G VRQ:Y<0 S IBBDT=Y
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 | VREDT ; - get ending date
 | 
|---|
| 72 |  S %DT="EX" R !,"        Go to DATE: ",X:DTIME S:X=" " X=IBBDT G VRQ:(X="")!(X["^") D ^%DT G VREDT:Y<0 S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G VRBDT
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | VRQ Q
 | 
|---|
| 75 |  ;
 | 
|---|
| 76 | ENH ; Sort help Text
 | 
|---|
| 77 |  W !!,?5,"Enter 1 to search by a Patient Name Range. (i.e. ADAMS to ADAMSZ)"
 | 
|---|
| 78 |  W !!,?5,"Enter 2 to search by Terminal Digit.  The output will be sorted"
 | 
|---|
| 79 |  W !?5,"by the 8th and 9th digits and then the 6th and 7th digits"
 | 
|---|
| 80 |  W !?5,"of the Patient's SSN.",!
 | 
|---|
| 81 |  Q
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 | ICH ; Search criteria help Text
 | 
|---|
| 84 |  W !!,?5,"Enter 1 to list active policies by Verification Date Range"
 | 
|---|
| 85 |  W !,?15,"(i.e. Sort Date By: 10-1-96  Go to Date: 01-1-97)"
 | 
|---|
| 86 |  W !,?5,"Enter 2 to list active policies with no Verification Date."
 | 
|---|
| 87 |  W !,?5,"Enter 3 to include active policies with or without a Verification Date."
 | 
|---|
| 88 |  Q
 | 
|---|
| 89 | QUE ; Ask Device
 | 
|---|
| 90 |  N %ZIS,ZTRTN,ZTSAVE,ZTDESC
 | 
|---|
| 91 |  W !,?10,"You may want to queue this report!",!
 | 
|---|
| 92 |  S %ZIS="QM" D ^%ZIS G:POP QUEQ
 | 
|---|
| 93 |  I $D(IO("Q")) K IO("Q") D  G QUEQ
 | 
|---|
| 94 |  .S ZTRTN="BEG^IBCOMA1",ZTSAVE("IBRF")="",ZTSAVE("IBRL")=""
 | 
|---|
| 95 |  .S ZTSAVE("IBAIB")="",ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")="",ZTSAVE("IBSIN")=""
 | 
|---|
| 96 |  .S ZTDESC="IB - Identify Active Policies w/no Effective Date"
 | 
|---|
| 97 |  .D ^%ZTLOAD K ZTSK D HOME^%ZIS
 | 
|---|
| 98 |  ;
 | 
|---|
| 99 |  U IO
 | 
|---|
| 100 |  I $E(IOST,1,2)["C-" W !!,?15,"... One Moment Please ..."
 | 
|---|
| 101 |  D BEG^IBCOMA1
 | 
|---|
| 102 |  ;
 | 
|---|
| 103 | QUEQ ; EXIT CLEAN-UP
 | 
|---|
| 104 |  W ! D ^%ZISC K IBAIB,IBRF,IBRL,IBSIN,IBSTR,^TMP("IBCOMA",$J)
 | 
|---|
| 105 |  Q
 | 
|---|
| 106 |  ;IBCOMA
 | 
|---|