IBOUNP1.m

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