source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOUNP1.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1IBOUNP1 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
2 ;;2.0;INTEGRATED BILLING;**249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; VAUTD =1 if all divisions selected
6 ; VAUTD() - list of selected divisions
7 ; VAUTC =1 if all clinics selected in selected divisions
8 ; VAUTC() - list of selected clinics, indexed by record number
9 ; IBOEND - end of the date range for the report
10 ; IBOBEG - start of the date range for report
11 ; IBOQUIT - flag to exit
12 ; IBOUK =1 if vets whose insurance is unknow should be included
13 ; IBOUI =1 if vets that are no insured should be included
14 ; IBOEXP = 1 if vets whose insurance is expiring should be included
15MAIN ;
16 ;***
17 ;
18 S IBOQUIT=0 K ^TMP($J,"SDAMA301"),^TMP("IBOUNP",$J)
19 D CLINIC,CATGRY:'IBOQUIT,DRANGE:'IBOQUIT
20 D:'IBOQUIT DEVICE
21 G:IBOQUIT EXIT
22QUEUED ; entry point if queued
23 ;
24 ;
25 D LCLINIC
26 ;
27 ; look up info from scheduling
28 S IBARRAY(1)=IBOBEG_";"_IBOEND_".99"
29 S:$D(VAUTC)>9 IBARRAY(2)="VAUTC("
30 S IBARRAY(3)="R"
31 S IBARRAY("FLDS")="2;4"
32 S IBARRAY("SORT")="P"
33 S IBCOUNT=$$SDAPI^SDAMA301(.IBARRAY)
34 I IBCOUNT<0 U IO W !!,"Scheduling Information not Available",! S IBOQUIT=1 F S IBCOUNT=$O(^TMP($J,"SDAMA301",IBCOUNT)) Q:'IBCOUNT W !?10,IBCOUNT,?20,$G(^TMP($J,"SDAMA301",IBCOUNT))
35 ;
36 D:'IBOQUIT LOOPPT^IBOUNP2,REPORT^IBOUNP3
37EXIT ;
38 K ^TMP($J,"SDAMA301")
39 ;
40 ;
41 I $D(ZTQUEUED) S ZTREQ="@" Q
42 D ^%ZISC
43 K IBOQUIT,IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTC,VAUTD,IBARRAY,IBCOUNT
44 K Y,POP,X1,X2,X,VAEL,VAERR,IBSDDAT,IBODIV,IBOCLN,DIRUT,VADM,VAOA,VAPD
45 Q
46 ;
47DRANGE ; select a date range for report
48 S DIR(0)="D^::EX",DIR("A")="Start with DATE" D ^DIR I $D(DIRUT) S IBOQUIT=1 K DIR Q
49 S IBOBEG=Y,DIR("A")="Go to DATE" F D ^DIR S:$D(DIRUT) IBOQUIT=1 Q:(Y>IBOBEG)!(Y=IBOBEG)!IBOQUIT W !,*7,"ENDING DATE must follow or be the same as the STARTING DATE"
50 S IBOEND=Y K DIR
51 Q
52 ;
53DEVICE ;
54 I $D(ZTQUEUED) Q
55 W !!,*7,"*** Margin width of this output is 132 ***"
56 W !,"*** This output should be queued ***"
57 S %ZIS="MQ" D ^%ZIS I POP S IBOQUIT=1 Q
58 I $D(IO("Q")) S ZTRTN="QUEUED^IBOUNP1",ZTIO=ION,ZTSAVE("VA*")="",ZTSAVE("IBO*")="",ZTDESC="OUTPATIENT INSURANCE REPORT" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS S IBOQUIT=1 Q
59 Q
60 ;
61CLINIC ; gets list of selected clinics,or sets VAUTC=1 if all selected
62 ; IA#664
63 N VAUTNI S VAUTNI=2,IBOQUIT=1
64 D DIVISION^VAUTOMA Q:Y<0 S VAUTNI=2 D CLINIC^VAUTOMA Q:Y<0
65 S IBOQUIT=0
66 Q
67 ;
68LCLINIC ; lists clinics if not ALL included and ALL divisions
69 N IBCLN,NODE
70 I VAUTD'=1&(VAUTC=1) S VAUTC=0,IBCLN="" F S IBCLN=$O(^SC(IBCLN)) Q:IBCLN="" D
71 .S NODE=$G(^SC(IBCLN,0))
72 .;make sure it's the one of selected divisions division
73 .Q:'$D(VAUTD(+$P(NODE,"^",15)))
74 .;check that location is a clinic
75 .Q:$P(NODE,"^",3)'="C"
76 .S VAUTC(IBCLN)=""
77 Q
78 ;
79CATGRY ; allows user to select categories to include in report
80 S DIR(0)="Y",DIR("A")="Include veterans whose insurance is unknown"
81 S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
82 S IBOUK=Y
83 S DIR(0)="Y",DIR("A")="Include veterans whose insurance is expiring"
84 S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
85 S IBOEXP=Y
86 S DIR(0)="Y",DIR("A")="Include veterans who have no insurance"
87 S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
88 S IBOUI=Y
89 Q
Note: See TracBrowser for help on using the repository browser.