IBOUNP1.m

IBOUNP1 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992

 ;;2.0;INTEGRATED BILLING;**249,528**;21-MAR-94;Build 163

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; 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 unknown 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

 ; IBOUT = "E" if output should be in Excel format, = "R" otherwise

MAIN ;

 ;***

 ;

 N IBOQUIT,IBOUI,IBOEXP,IBOUK,IBOUT,IBOPICK

 S IBOQUIT=0 K ^TMP($J,"SDAMA301"),^TMP("IBOUNP",$J)

 D CLINIC,CATGRY:'IBOQUIT,DRANGE:'IBOQUIT

 ;

 S IBOUT=$$OUT G:IBOUT="" EXIT

 ;

 D:'IBOQUIT DEVICE

 G:IBOQUIT EXIT

QUEUED ; entry point if queued

 ;

 ;

 D LCLINIC

 ;

 ; look up info from scheduling

 S IBARRAY(1)=IBOBEG_";"_IBOEND_".99"

 S:$D(VAUTC)>9 IBARRAY(2)="VAUTC("

 S IBARRAY(3)="R"

 S IBARRAY("FLDS")="2;4"

 S IBARRAY("SORT")="P"

 S IBCOUNT=$$SDAPI^SDAMA301(.IBARRAY)

 I IBCOUNT<0 U IO W !!,"Scheduling Information not Available",! S IBOQUIT=1 F  S IBCOUNT=$O(^TMP($J,"SDAMA301",IBCOUNT)) Q:'IBCOUNT  W !?10,IBCOUNT,?20,$G(^TMP($J,"SDAMA301",IBCOUNT))

 ;

 D:'IBOQUIT LOOPPT^IBOUNP2,REPORT^IBOUNP3

EXIT ; 

 K ^TMP($J,"SDAMA301"),^TMP("IBOUNP",$J)

 ;

 ;

 I $D(ZTQUEUED) S ZTREQ="@" Q

 D ^%ZISC

 K IBOQUIT,IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTC,VAUTD,IBARRAY,IBCOUNT,IBOUT

 K Y,POP,X1,X2,X,VAEL,VAERR,IBSDDAT,IBODIV,IBOCLN,DIRUT,VADM,VAOA,VAPD

 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

 I IBOUT="R" 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

 ; IA#664

 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 included and ALL divisions

 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

 ;

OUT() ;

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 W !

 S DIR(0)="SA^E:Excel;R:Report"

 S DIR("A")="(E)xcel Format or (R)eport Format: "

 S DIR("B")="Report"

 D ^DIR I $D(DIRUT) Q ""

 Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBOUNP1   3779     printed  Mar 13, 2025@21:31:16                                                                                                                                                                                                     Page 2

IBOUNP1   ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992

 +1       ;;2.0;INTEGRATED BILLING;**249,528**;21-MAR-94;Build 163

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; VAUTD =1 if all divisions selected

 +5       ; VAUTD() - list of selected divisions

 +6       ; VAUTC =1 if all clinics selected in selected divisions

 +7       ; VAUTC() - list of selected clinics, indexed by record number

 +8       ; IBOEND - end of the date range for the report

 +9       ; IBOBEG - start of the date range for report

 +10      ; IBOQUIT - flag to exit

 +11      ; IBOUK =1 if vets whose insurance is unknown should be included

 +12      ; IBOUI =1 if vets that are no insured should be included

 +13      ; IBOEXP = 1 if vets whose insurance is expiring should be included

 +14      ; IBOUT = "E" if output should be in Excel format, = "R" otherwise

MAIN      ;

 +1       ;***

 +2       ;

 +3        NEW IBOQUIT,IBOUI,IBOEXP,IBOUK,IBOUT,IBOPICK

 +4        SET IBOQUIT=0

           KILL ^TMP($JOB,"SDAMA301"),^TMP("IBOUNP",$JOB)

 +5        DO CLINIC

           if 'IBOQUIT

               DO CATGRY

           if 'IBOQUIT

               DO DRANGE

 +6       ;

 +7        SET IBOUT=$$OUT

           if IBOUT=""

               GOTO EXIT

 +8       ;

 +9        if 'IBOQUIT

               DO DEVICE

 +10       if IBOQUIT

               GOTO EXIT

QUEUED    ; entry point if queued

 +1       ;

 +2       ;

 +3        DO LCLINIC

 +4       ;

 +5       ; look up info from scheduling

 +6        SET IBARRAY(1)=IBOBEG_";"_IBOEND_".99"

 +7        if $DATA(VAUTC)>9

               SET IBARRAY(2)="VAUTC("

 +8        SET IBARRAY(3)="R"

 +9        SET IBARRAY("FLDS")="2;4"

 +10       SET IBARRAY("SORT")="P"

 +11       SET IBCOUNT=$$SDAPI^SDAMA301(.IBARRAY)

 +12       IF IBCOUNT<0

               USE IO

               WRITE !!,"Scheduling Information not Available",!

               SET IBOQUIT=1

               FOR 

                   SET IBCOUNT=$ORDER(^TMP($JOB,"SDAMA301",IBCOUNT))

                   if 'IBCOUNT

                       QUIT 

                   WRITE !?10,IBCOUNT,?20,$GET(^TMP($JOB,"SDAMA301",IBCOUNT))

 +13      ;

 +14       if 'IBOQUIT

               DO LOOPPT^IBOUNP2

               DO REPORT^IBOUNP3

EXIT      ; 

 +1        KILL ^TMP($JOB,"SDAMA301"),^TMP("IBOUNP",$JOB)

 +2       ;

 +3       ;

 +4        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT 

 +5        DO ^%ZISC

 +6        KILL IBOQUIT,IBOBEG,IBOEND,IBOUK,IBOUI,IBOEXP,VAUTC,VAUTD,IBARRAY,IBCOUNT,IBOUT

 +7        KILL Y,POP,X1,X2,X,VAEL,VAERR,IBSDDAT,IBODIV,IBOCLN,DIRUT,VADM,VAOA,VAPD

 +8        QUIT 

 +9       ;

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 

 +5       ;

DEVICE    ;

 +1        IF $DATA(ZTQUEUED)

               QUIT 

 +2        IF IBOUT="R"

               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

 +7        QUIT 

 +8       ;

CLINIC    ; gets list of selected clinics,or sets VAUTC=1 if all selected

 +1       ; IA#664

 +2        NEW VAUTNI

           SET VAUTNI=2

           SET IBOQUIT=1

 +3        DO DIVISION^VAUTOMA

           if Y<0

               QUIT 

           SET VAUTNI=2

           DO CLINIC^VAUTOMA

           if Y<0

               QUIT 

 +4        SET IBOQUIT=0

 +5        QUIT 

 +6       ;

LCLINIC   ; lists clinics if not ALL included and ALL divisions

 +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 

 +10      ;

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 

 +11      ;

OUT()     ;

 +1        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +2        WRITE !

 +3        SET DIR(0)="SA^E:Excel;R:Report"

 +4        SET DIR("A")="(E)xcel Format or (R)eport Format: "

 +5        SET DIR("B")="Report"

 +6        DO ^DIR

           IF $DATA(DIRUT)

               QUIT ""

 +7        QUIT Y