source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOUNP4.m@ 711

Last change on this file since 711 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1IBOUNP4 ;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
11MAIN ;
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
19QUEUED ; 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
25EXIT ;
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
34DRANGE ; 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
38DEVICE ;
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
46CATGRY ; 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
57DIVISION ; 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
62PICK ; 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
73SORTBY ;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
Note: See TracBrowser for help on using the repository browser.