IBOUNP1 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
; VAUTD =1 if all divisions selected
; VAUTD() - list of selected divisions
; VAUTC =1 if all clinics selected in selected divisions
; VAUTC() - list of selected clinics, indexed by record number
; IBOEND - end of the date range for the report
; IBOBEG - start of the date range for report
; IBOQUIT - flag to exit
; IBOUK =1 if vets whose insurance is unknow should be included
; IBOUI =1 if vets that are no insured should be included
; IBOEXP = 1 if vets whose insurance is expiring should be included
MAIN ;
;***
;S XRTL=$ZU(0),XRTN="IBOUNP1-1" D T0^%ZOSV ;start rt clock
;
S IBOQUIT=0 K ^TMP($J)
D CLINIC,CATGRY:'IBOQUIT,DRANGE:'IBOQUIT
D:'IBOQUIT DEVICE
G:IBOQUIT EXIT
QUEUED ; entry point if queued
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP1" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBOUNP1-2" D T0^%ZOSV ;start rt clock
;
D:'IBOQUIT LCLINIC,LOOPCLNC^IBOUNP2,REPORT^IBOUNP3
EXIT ;
K ^TMP($J)
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP1" D T1^%ZOSV ;stop rt clock
;
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K IBOQUIT,IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTC,VAUTD
Q
DRANGE ; select a date range for report
S DIR(0)="D^::EX",DIR("A")="Start with DATE" D ^DIR I $D(DIRUT) S IBOQUIT=1 K DIR Q
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"
S IBOEND=Y K DIR
Q
DEVICE ;
I $D(ZTQUEUED) Q
W !!,*7,"*** Margin width of this output is 132 ***"
W !,"*** This output should be queued ***"
S %ZIS="MQ" D ^%ZIS I POP S IBOQUIT=1 Q
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
U IO Q
CLINIC ; gets list of selected clinics,or sets VAUTC=1 if all selected
N VAUTNI S VAUTNI=2,IBOQUIT=1
D DIVISION^VAUTOMA Q:Y<0 S VAUTNI=2 D CLINIC^VAUTOMA Q:Y<0
S IBOQUIT=0 Q
LCLINIC ; lists clinics if not all divisions were chosen
N IBCLN,NODE
I VAUTD'=1&(VAUTC=1) S VAUTC=0,IBCLN="" F S IBCLN=$O(^SC(IBCLN)) Q:IBCLN="" D
.S NODE=$G(^SC(IBCLN,0))
.;make sure it's the one of selected divisions division
.Q:'$D(VAUTD(+$P(NODE,"^",15)))
.;check that location is a clinic
.Q:$P(NODE,"^",3)'="C"
.S VAUTC(IBCLN)=""
Q
CATGRY ; allows user to select categories to include in report
S DIR(0)="Y",DIR("A")="Include veterans whose insurance is unknown"
S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
S IBOUK=Y
S DIR(0)="Y",DIR("A")="Include veterans whose insurance is expiring"
S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
S IBOEXP=Y
S DIR(0)="Y",DIR("A")="Include veterans who have no insurance"
S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S IBOQUIT=1 Q
S IBOUI=Y
Q
IBOUNP1 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ; VAUTD =1 if all divisions selected
+3 ; VAUTD() - list of selected divisions
+4 ; VAUTC =1 if all clinics selected in selected divisions
+5 ; VAUTC() - list of selected clinics, indexed by record number
+6 ; IBOEND - end of the date range for the report
+7 ; IBOBEG - start of the date range for report
+8 ; IBOQUIT - flag to exit
+9 ; IBOUK =1 if vets whose insurance is unknow should be included
+10 ; IBOUI =1 if vets that are no insured should be included
+11 ; IBOEXP = 1 if vets whose insurance is expiring should be included
MAIN ;
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOUNP1-1" D T0^%ZOSV ;start rt clock
+3 ;
+4 SET IBOQUIT=0
KILL ^TMP($JOB)
+5 DO CLINIC
IF 'IBOQUIT
DO CATGRY
IF 'IBOQUIT
DO DRANGE
+6 IF 'IBOQUIT
DO DEVICE
+7 IF IBOQUIT
GOTO EXIT
QUEUED ; entry point if queued
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP1" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBOUNP1-2" D T0^%ZOSV ;start rt clock
+4 ;
+5 IF 'IBOQUIT
DO LCLINIC
DO LOOPCLNC^IBOUNP2
DO REPORT^IBOUNP3
EXIT ;
+1 KILL ^TMP($JOB)
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOUNP1" D T1^%ZOSV ;stop rt clock
+4 ;
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+6 DO ^%ZISC
+7 KILL IBOQUIT,IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTC,VAUTD
+8 QUIT
DRANGE ; select a date range for report
+1 SET DIR(0)="D^::EX"
SET DIR("A")="Start with DATE"
DO ^DIR
IF $DATA(DIRUT)
SET IBOQUIT=1
KILL DIR
QUIT
+2 SET IBOBEG=Y
SET DIR("A")="Go to DATE"
FOR
DO ^DIR
IF $DATA(DIRUT)
SET IBOQUIT=1
IF (Y>IBOBEG)!(Y=IBOBEG)!IBOQUIT
QUIT
WRITE !,*7,"ENDING DATE must follow or be the same as the STARTING DATE"
+3 SET IBOEND=Y
KILL DIR
+4 QUIT
DEVICE ;
+1 IF $DATA(ZTQUEUED)
QUIT
+2 WRITE !!,*7,"*** Margin width of this output is 132 ***"
+3 WRITE !,"*** This output should be queued ***"
+4 SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET IBOQUIT=1
QUIT
+5 IF $DATA(IO("Q"))
SET ZTRTN="QUEUED^IBOUNP1"
SET ZTIO=ION
SET ZTSAVE("VA*")=""
SET ZTSAVE("IBO*")=""
SET ZTDESC="OUTPATIENT INSURANCE REPORT"
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
DO HOME^%ZIS
SET IBOQUIT=1
QUIT
+6 USE IO
QUIT
CLINIC ; gets list of selected clinics,or sets VAUTC=1 if all selected
+1 NEW VAUTNI
SET VAUTNI=2
SET IBOQUIT=1
+2 DO DIVISION^VAUTOMA
IF Y<0
QUIT
SET VAUTNI=2
DO CLINIC^VAUTOMA
IF Y<0
QUIT
+3 SET IBOQUIT=0
QUIT
LCLINIC ; lists clinics if not all divisions were chosen
+1 NEW IBCLN,NODE
+2 IF VAUTD'=1&(VAUTC=1)
SET VAUTC=0
SET IBCLN=""
FOR
SET IBCLN=$ORDER(^SC(IBCLN))
IF IBCLN=""
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^SC(IBCLN,0))
+4 ;make sure it's the one of selected divisions division
+5 IF '$DATA(VAUTD(+$PIECE(NODE,"^",15)))
QUIT
+6 ;check that location is a clinic
+7 IF $PIECE(NODE,"^",3)'="C"
QUIT
+8 SET VAUTC(IBCLN)=""
End DoDot:1
+9 QUIT
CATGRY ; allows user to select categories to include in report
+1 SET DIR(0)="Y"
SET DIR("A")="Include veterans whose insurance is unknown"
+2 SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBOQUIT=1
QUIT
+3 SET IBOUK=Y
+4 SET DIR(0)="Y"
SET DIR("A")="Include veterans whose insurance is expiring"
+5 SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBOQUIT=1
QUIT
+6 SET IBOEXP=Y
+7 SET DIR(0)="Y"
SET DIR("A")="Include veterans who have no insurance"
+8 SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBOQUIT=1
QUIT
+9 SET IBOUI=Y
+10 QUIT
