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