Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOEMP

IBOEMP.m

Go to the documentation of this file. 
  1. IBOEMP	;ALB/ARH - EMPLOYER REPORT ; 6/19/92
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. 	;Included in Report:
  1. 	;                Employer Name Range can be choosen
  1. 	;    All:        Patient must NOT have active insurance on date of event
  1. 	;                Patient must not be dead
  1. 	;                Patients (2,.31115) or Spouses (2,.2515) Eployment Status is:
  1. 	;                       1 - EMPLOYED FULL TIME
  1. 	;                       2 - EMPLOYED PART TIME
  1. 	;                       4 - SELF EMPLOYED
  1. 	;                       5 - RETIRED
  1. 	;     or
  1. 	;                Patient (2,.3111) or Spouse (2,.251) (VAOA(9)) Employer Name is defined
  1. 	;
  1. 	;    Inpatient:  Admission Movements (405,.02=1):
  1. 	;
  1. 	;    Outpatient: division can be choosen by the user
  1. 	;                Scheduling Visits (409.5), unscheduled visits
  1. 	;                Scheduled visits:
  1. 	;                        Hospital Location must be "C" Clinic (44,2.1)
  1. 	;                        Patient visit Outpatient, not cancelled or no-showed (2,1900,3="")
  1. 	;                Dispositions, that are not Application Without Exam ((2,1000,1)<2)
  1. 	;
  1. 	;Printed on Report: Report is sorted by employer name, within employers, by patient name
  1. 	;                   For employers to match their name, address, and  phone number must match exactly
  1. 	;    All:        Employer Name, phone, address
  1. 	;                if employment status is employed but no employer name use {unspecified} for employer name
  1. 	;                Patient Name, SSN, Primary Eligibility, home ph number
  1. 	;    Inpatient:  Admission Date, Transaction (405,.02)
  1. 	;    Outpatient: Appointment Date, Appointment Type (409.5,5) or "DIPSOSITION"
  1. 	;    For Employed: Name, SSN, Occupation, Employment Status, for patient-work ph number
  1. 	;              
  1. 	;               
  1. EN	;report on employers of patients with no insurance at time of care
  1. 	D HOME^%ZIS S IBHDR="EMPLOYER REPORT" W @IOF,?27,IBHDR,!!!!
  1. RG	S DIR("?",1)="Specify the employers to list in the report by entering:",DIR("?",2)=" 1. the first character in the Employer's Name"
  1. 	S DIR("?",3)=" 2.""-"" for patients who indicated they were employed but who have no employer"
  1. 	S DIR("?",4)=" 3.""+"" for all employers.",DIR("?")="Enter one character only"
  1. 	S DIR(0)="FO^1:1",DIR("A")="Beginning Value",DIR("B")="+"
  1. 	D ^DIR K DIR G:$D(DIRUT) EXIT I Y="+" S IBRGB=-1,IBRGE=999 G NX
  1. 	I Y="-" S (IBRGB,IBRGE)=-1 G NX
  1. 	S IBRGB=$A(Y) S DIR("?")="Enter the last character in the Employer Name range to include"
  1. 	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)
  1. 	I IBRGB<65!(IBRGE>90) W "??" G RG
  1. NX	I IBRGE<IBRGB W "??" G RG
  1. 	;
  1. 	S DIR("?")="The Employer Report can be printed for either INPATIENT MOVEMENTS or OUTPATIENT VISITS.  Enter the code cooresponding to your choice."
  1. 	S DIR(0)="SOB^INPT:Inpatient;OPT:Outpatient",DIR("A")="Select PATIENT TYPE"
  1. 	D ^DIR K DIR G:$D(DIRUT) EXIT S IBCH=Y I IBCH="OPT" D ASK2^IBODIV G:Y<0 EXIT
  1. 	S IBFLD="Date" D RANGE G:IBQUIT EXIT
  1. 	;
  1. DEV	;get the device
  1. 	W !!,"Report requires 132 columns."
  1. 	S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
  1. 	I $D(IO("Q")) S ZTRTN="EN1^IBOEMP",ZTDESC=IBHDR,ZTSAVE("IB*")="",ZTSAVE("VAUTD")="" D ^%ZTLOAD K IO("Q") G EXIT
  1. 	U IO
  1. 	;
  1. EN1	;tasked entry point
  1. 	S IBES="FULL TIME^PART TIME^NOT EMPL'D^SELF EMPL'D^RETIRED^ACTIVE DUTY^^^UNKNOWN"
  1. 	D ^IBOEMP1 I 'IBQ D PHDR,^IBOEMP2
  1. 	K IBES,VAUTD,VAERR,IBHDR1,IBPGN,IBQ,IBLN,IBDSH,IBI,IBDIV,IBCDT,IBX,IBY,X,Y
  1. 	;
  1. EXIT	K ^TMP("IBEMP",$J) I $D(ZTQUEUED) S ZTREQ="@" Q
  1. 	D ^%ZISC
  1. 	K X,Y,VA,DTOUT,DUOUT,DIRUT,DIROUT,DIOEND,IBCH,IBEND,IBBEG,IBQUIT,IBBEGE,IBENDE,IBFLD,IBHDR,IBRGB,IBRGE
  1. 	Q
  1. 	;
  1. PHDR	;create print header
  1. 	D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_"  "_$P(Y,"@",2)
  1. 	S (IBPGN,IBQ,IBLN)=0,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-"
  1. 	S (IBHDR1,IBDIV)="" I $D(VAUTD) S:VAUTD=1 IBHDR1="ALL DIVISIONS" I $D(VAUTD)=11 D
  1. 	. S IBDIV=$O(VAUTD(IBDIV)),IBHDR1="DIVISION: "_VAUTD(IBDIV)
  1. 	. F  S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV=""  S IBHDR1=IBHDR1_", "_VAUTD(IBDIV)
  1. 	Q
  1. 	;
  1. 	;
  1. RANGE	;get date range
  1. 	S DIR(0)="D^:NOW:EX",DIR("A")="START WITH "_IBFLD
  1. 	D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
  1. 	S IBBEG=Y X ^DD("DD") S IBBEGE=Y
  1. 	S DIR(0)="D^"_IBBEG_":NOW:EX",DIR("A")="GO TO "_IBFLD,DIR("B")="TODAY"
  1. 	D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 Q
  1. 	S IBEND=Y X ^DD("DD") S IBENDE=Y,IBQUIT=0
  1. 	Q