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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1IBOEMP ;ALB/ARH - EMPLOYER REPORT ; 6/19/92
2 ;;Version 2.0 ; INTEGRATED BILLING ;**33**; 21-MAR-94
3 ;
4 ;Included in Report:
5 ; Employer Name Range can be choosen
6 ; All: Patient must NOT have active insurance on date of event
7 ; Patient must not be dead
8 ; Patients (2,.31115) or Spouses (2,.2515) Eployment Status is:
9 ; 1 - EMPLOYED FULL TIME
10 ; 2 - EMPLOYED PART TIME
11 ; 4 - SELF EMPLOYED
12 ; 5 - RETIRED
13 ; or
14 ; Patient (2,.3111) or Spouse (2,.251) (VAOA(9)) Employer Name is defined
15 ;
16 ; Inpatient: Admission Movements (405,.02=1):
17 ;
18 ; Outpatient: division can be choosen by the user
19 ; Scheduling Visits (409.5), unscheduled visits
20 ; Scheduled visits:
21 ; Hospital Location must be "C" Clinic (44,2.1)
22 ; Patient visit Outpatient, not cancelled or no-showed (2,1900,3="")
23 ; Dispositions, that are not Application Without Exam ((2,1000,1)<2)
24 ;
25 ;Printed on Report: Report is sorted by employer name, within employers, by patient name
26 ; For employers to match their name, address, and phone number must match exactly
27 ; All: Employer Name, phone, address
28 ; if employment status is employed but no employer name use {unspecified} for employer name
29 ; Patient Name, SSN, Primary Eligibility, home ph number
30 ; Inpatient: Admission Date, Transaction (405,.02)
31 ; Outpatient: Appointment Date, Appointment Type (409.5,5) or "DIPSOSITION"
32 ; For Employed: Name, SSN, Occupation, Employment Status, for patient-work ph number
33 ;
34 ;
35EN ;report on employers of patients with no insurance at time of care
36 D HOME^%ZIS S IBHDR="EMPLOYER REPORT" W @IOF,?27,IBHDR,!!!!
37RG S DIR("?",1)="Specify the employers to list in the report by entering:",DIR("?",2)=" 1. the first character in the Employer's Name"
38 S DIR("?",3)=" 2.""-"" for patients who indicated they were employed but who have no employer"
39 S DIR("?",4)=" 3.""+"" for all employers.",DIR("?")="Enter one character only"
40 S DIR(0)="FO^1:1",DIR("A")="Beginning Value",DIR("B")="+"
41 D ^DIR K DIR G:$D(DIRUT) EXIT I Y="+" S IBRGB=-1,IBRGE=999 G NX
42 I Y="-" S (IBRGB,IBRGE)=-1 G NX
43 S IBRGB=$A(Y) S DIR("?")="Enter the last character in the Employer Name range to include"
44 S DIR(0)="FO^1:15",DIR("A")="Ending Value",DIR("B")="Z" D ^DIR K DIR G:$D(DIRUT) EXIT S IBRGE=$A(Y)
45 I IBRGB<65!(IBRGE>90) W "??" G RG
46NX I IBRGE<IBRGB W "??" G RG
47 ;
48 S DIR("?")="The Employer Report can be printed for either INPATIENT MOVEMENTS or OUTPATIENT VISITS. Enter the code cooresponding to your choice."
49 S DIR(0)="SOB^INPT:Inpatient;OPT:Outpatient",DIR("A")="Select PATIENT TYPE"
50 D ^DIR K DIR G:$D(DIRUT) EXIT S IBCH=Y I IBCH="OPT" D ASK2^IBODIV G:Y<0 EXIT
51 S IBFLD="Date" D RANGE G:IBQUIT EXIT
52 ;
53DEV ;get the device
54 W !!,"Report requires 132 columns."
55 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
56 I $D(IO("Q")) S ZTRTN="EN1^IBOEMP",ZTDESC=IBHDR,ZTSAVE("IB*")="",ZTSAVE("VAUTD*")="" D ^%ZTLOAD K IO("Q") G EXIT
57 U IO
58 ;
59EN1 ;tasked entry point
60 S IBES="FULL TIME^PART TIME^NOT EMPL'D^SELF EMPL'D^RETIRED^ACTIVE DUTY^^^UNKNOWN"
61 D ^IBOEMP1 I 'IBQ D PHDR,^IBOEMP2
62 K IBES,VAUTD,VAERR,IBHDR1,IBPGN,IBQ,IBLN,IBDSH,IBI,IBDIV,IBCDT,IBX,IBY,X,Y
63 ;
64EXIT K ^TMP("IBEMP",$J) I $D(ZTQUEUED) S ZTREQ="@" Q
65 D ^%ZISC
66 K X,Y,VA,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND,IBCH,IBEND,IBBEG,IBQUIT,IBBEGE,IBENDE,IBFLD,IBHDR,IBRGB,IBRGE
67 Q
68 ;
69PHDR ;create print header
70 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2)
71 S (IBPGN,IBQ,IBLN)=0,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-"
72 S (IBHDR1,IBDIV)="" I $D(VAUTD) S:VAUTD=1 IBHDR1="ALL DIVISIONS" I $D(VAUTD)=11 D
73 . S IBDIV=$O(VAUTD(IBDIV)),IBHDR1="DIVISION: "_VAUTD(IBDIV)
74 . F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" S IBHDR1=IBHDR1_", "_VAUTD(IBDIV)
75 Q
76 ;
77 ;
78RANGE ;get date range
79 S DIR(0)="D^:NOW:EX",DIR("A")="START WITH "_IBFLD
80 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
81 S IBBEG=Y X ^DD("DD") S IBBEGE=Y
82 S DIR(0)="D^"_IBBEG_":NOW:EX",DIR("A")="GO TO "_IBFLD,DIR("B")="TODAY"
83 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
84 S IBEND=Y X ^DD("DD") S IBENDE=Y,IBQUIT=0
85 Q
Note: See TracBrowser for help on using the repository browser.