[613] | 1 | IBOUNP4 ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992
|
---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
---|
| 3 | ; VAUTD =1 if all divisions selected
|
---|
| 4 | ; VAUTD() - list of selected divisions
|
---|
| 5 | ; IBOEND - end of the date range for the report
|
---|
| 6 | ; IBOBEG - start of the date range for report
|
---|
| 7 | ; IBOUK =1 if vets whose insurance is unknow should be included
|
---|
| 8 | ; IBOUI =1 if vets that are no insured should be included
|
---|
| 9 | ; IBOEXP = 1 if vets whose insurance is expiring should be included
|
---|
| 10 | ; IBOBYWRD = 1 if report should be sorted by ward, = 0 otherwise
|
---|
| 11 | MAIN ;
|
---|
| 12 | ;***
|
---|
| 13 | ;S XRTL=$ZU(0),XRTN="IBOUNP4-1" D T0^%ZOSV ;start rt clock
|
---|
| 14 | ;
|
---|
| 15 | N QUIT S QUIT=0,IBOBYWRD=0 K ^TMP($J)
|
---|
| 16 | D DIVISION,PICK:'QUIT,CATGRY:'QUIT,SORTBY:'QUIT
|
---|
| 17 | D:'$G(QUIT) DEVICE
|
---|
| 18 | G:QUIT EXIT
|
---|
| 19 | QUEUED ; entry point if queued
|
---|
| 20 | ;***
|
---|
| 21 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP4" D T1^%ZOSV ;stop rt clock
|
---|
| 22 | ;S XRTL=$ZU(0),XRTN="IBOUNP4-2" D T0^%ZOSV ;start rt clock
|
---|
| 23 | ;
|
---|
| 24 | D LOOP^IBOUNP5,REPORT^IBOUNP6
|
---|
| 25 | EXIT ;
|
---|
| 26 | K ^TMP($J)
|
---|
| 27 | ;***
|
---|
| 28 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP4" D T1^%ZOSV ;stop rt clock
|
---|
| 29 | ;
|
---|
| 30 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
---|
| 31 | D ^%ZISC
|
---|
| 32 | K IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTD,IBOPICK,IBOBYWRD
|
---|
| 33 | Q
|
---|
| 34 | DRANGE ; select a date range for report
|
---|
| 35 | S DIR(0)="D^::EX",DIR("A")="Start with DATE" D ^DIR I $D(DIRUT) S QUIT=1 K DIR Q
|
---|
| 36 | S IBOBEG=Y,DIR("A")="Go to DATE" F D ^DIR S:$D(DIRUT) QUIT=1 Q:(Y>IBOBEG)!(Y=IBOBEG)!QUIT W !,*7,"ENDING DATE must follow or be the same as the STARTING DATE"
|
---|
| 37 | S IBOEND=Y K DIR Q
|
---|
| 38 | DEVICE ;
|
---|
| 39 | I $D(ZTQUEUED) Q
|
---|
| 40 | W !!,*7,"*** Margin width of this output is 132 ***"
|
---|
| 41 | W !,"*** This output should be queued ***"
|
---|
| 42 | S %ZIS="MQ" D ^%ZIS I POP S QUIT=1 Q
|
---|
| 43 | I $D(IO("Q")) S ZTRTN="QUEUED^IBOUNP4",ZTIO=ION,ZTSAVE("VA*")="",ZTSAVE("IBO*")="",ZTDESC="INPATIENT INSURANCE REPORT" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS S QUIT=1 Q
|
---|
| 44 | U IO
|
---|
| 45 | Q
|
---|
| 46 | CATGRY ; allows user to select categories to include in report
|
---|
| 47 | S DIR(0)="Y",DIR("A")="Include veterans whose insurance is unknown"
|
---|
| 48 | S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
---|
| 49 | S IBOUK=Y
|
---|
| 50 | S DIR(0)="Y",DIR("A")="Include veterans whose insurance is expiring"
|
---|
| 51 | S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
---|
| 52 | S IBOEXP=Y
|
---|
| 53 | S DIR(0)="Y",DIR("A")="Include veterans who have no insurance"
|
---|
| 54 | S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
---|
| 55 | S IBOUI=Y
|
---|
| 56 | Q
|
---|
| 57 | DIVISION ; gets list of selected divisions,or sets VAUTC=1 if all select
|
---|
| 58 | N VAUTNI S VAUTNI=2,QUIT=1
|
---|
| 59 | D DIVISION^VAUTOMA Q:Y<0
|
---|
| 60 | S QUIT=0
|
---|
| 61 | Q
|
---|
| 62 | PICK ; gets user's choice of all current inpatients or all admitted in range
|
---|
| 63 | S DIR(0)="S^D:(D)ATE RANGE;C:(C)URRENT DATE;"
|
---|
| 64 | S DIR("?",1)="C for CURRENT DATE- Report will display only those patients that are "
|
---|
| 65 | S DIR("?",2)="inpatients in hospital today."
|
---|
| 66 | S DIR("?",3)=""
|
---|
| 67 | S DIR("?",4)="D for DATE RANGE - to display all patients that were admitted "
|
---|
| 68 | S DIR("?")="to the hospital during that period."
|
---|
| 69 | S DIR("A")="Display report for"
|
---|
| 70 | D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q
|
---|
| 71 | S IBOPICK=Y D:IBOPICK="D" DRANGE
|
---|
| 72 | Q
|
---|
| 73 | SORTBY ;sets IBOBYWRD=1 if user wants the output sorted by ward
|
---|
| 74 | K DIR S DIR(0)="Y",DIR("A")="Do you want the report sorted by WARD, as well as by division and patient"
|
---|
| 75 | D ^DIR I $D(DIRUT) S QUIT=1 Q
|
---|
| 76 | S IBOBYWRD=Y
|
---|
| 77 | Q
|
---|