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 ---[H[J[2J[HIBOUNP1 3779 printed Nov 22, 2024@17:36:19 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
