Routine: APCLBV

APCLBV ; IHS/CMI/LAB - print billable visits ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START ;

 I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! Q

 W:$D(IOF) @IOF

 W !!,"This Option prints a list of Potentially Billable Visits for all patients",!,"registered at the Facility that you select.",!

 W "The user will select which third party coverage type that they are interested",!,"in seeing billable visits for."

 W !,"This report displays visits during a period when this patient had third",!,"party coverage, but does not consider the diagnostic category which may be",!,"excluded by some types of coverage.",!

 W "Only visits at the location where the patient is registered will be displayed.",!

F ;

 S DIC("A")="Run the report for which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 EOJ

 S APCLSU=+Y

SD ;

W !

 S Y=DT X ^DD("DD") S APCLDTP=Y

 S %DT("A")="Starting Visit Date for Billable Visits: ",%DT="AEPX" W ! D ^%DT

 I Y=-1 G F

 S APCLSD=Y X ^DD("DD") S APCLSDY=Y

ED S %DT("A")="Ending Visit Date for Billable Visits: " W ! D ^%DT K %DT

 I Y=-1 G SD

 S APCLED=Y X ^DD("DD") S APCLEDY=Y

 I APCLED<APCLSD W !!,"Ending Date cannot be before Starting Date! Please reenter.",! G SD

SC ;

 K DIR,APCLSC,APCLSCP

 W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")="Do you want a particular SERVICE CATEGORY",DIR("?")="" D ^DIR K DIR

 I $E(X)=U!($D(DTOUT)) G SD

 I $E(X)="N" S APCLSC="AIHOS",APCLSCP="ALL VISIT SERVICE CATEGORIES" G CLIN

SC1 S DIR(0)="9000010,.07",DIR("A")="Which Service Category" D ^DIR K DIR

 I $D(DTOUT)!($E(X)=U) G SC

 I "AHIOS"'[Y W !!,$C(7),$C(7),"Sorry, we only display visits for the following service categories: ",!,"H - Hospitalizations, A - Ambulatory, I - In Hospital, O - Observation",!,"and S - Day Surgery.  Please re-enter your choice.",! G SC1

 S APCLSC=Y,APCLSCP=Y(0)

CLIN ;CLIN Screening

 S APCLCLN=""

 W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")="Do you want a particular CLINIC",DIR("?")="" D ^DIR K DIR

 I $E(X)=U!($D(DTOUT)) G SD

 I Y=0 G CT

CLIN1 ;CLIN1 SubRoutine

 S DIC("A")="Which Clinic: ",DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 CLIN

 S APCLCLN=+Y

CT ;

 S DIR(0)="SO^1:Commissioned Officers/Dependents;2:Medicare Part A;3:Medicare Part B;4:Medicaid;5:Private Insurance;6:Non-Indians;7:All Above Coverages",DIR("A")="     Select Third Party Coverage"

 D ^DIR K DIR W !!

 G:$D(DIRUT) SD

 S APCLNAR(1)="Commissioned Officers/Dependents"

 S APCLNAR(2)="Medicare Part A"

 S APCLNAR(3)="Medicare Part B"

 S APCLNAR(4)="Medicaid"

 S APCLNAR(5)="Private Insurance"

 S APCLNAR(6)="Non-Indians"

 I Y=7 S APCLPALL=Y,APCLRNUM=1

 I Y<7 S (APCLPROC,APCLRNUM)=Y,APCLNAR=APCLNAR(APCLRNUM)

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G CT

 S XBRP="^APCLBV1",XBRC="^APCLBV2",XBRX="EOJ^APCLBV",XBNS="APCL"

 D ^XBDBQUE

 D EOJ

EOJ ;ENTRY POINT

 K POP,ZTSK,ZTQUEUED,DFN,%DT,%,X,Y,DIRUT,DTOUT,J,K,%XX,%YY,DDBN,DDBX,HS,C,IO("Q"),DIR,DIRUT,DIC,DA,DR,DIQ,SSN,H,M,S,TS

 K APCLSD,APCLSDY,APCLED,APCLEDY,APCLPROC,APCLNAR,APCL,APCLSU,APCLLENG,APCLDTP,APCLCAT,APCLMDFN,APCLGOT,APCLBT,APCLET,APCLNAME,APCLSC,APCLSCP,APCLJOB,APCLCLN

 K APCLS,APCLCOAR,APCLCOPN,APCLVDFN,APCLVN0,APCLCOP,APCLPN,APCLVAL,APCLTRI,APCLTRIC

 K APCLCHMP,APCL80E,APCL80D,APCLPG,APCLEOJ,APCLX,APCLVDFN,APCLVREC,APCLDATE,APCL1,APCL2,APCLAP,APCLDISC,APCLY,APCLSKIP,APCLMN,APCLMDOB,APCLMEDN,DOB,APCLHRN,APCLVAL

 K APCLERCO,APCLPALL,APCLRNUM,APCLCNTR,APCLSAVE,APCLQUIT

 K APCLNDFN,APCLREC,APCLNREC

APCLBV    ; IHS/CMI/LAB - print billable visits ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START     ;

 +1        IF '$GET(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!

               QUIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This Option prints a list of Potentially Billable Visits for all patients",!,"registered at the Facility that you select.",!

 +4        WRITE "The user will select which third party coverage type that they are interested",!,"in seeing billable visits for."

 +5        WRITE !,"This report displays visits during a period when this patient had third",!,"party coverage, but does not consider the diagnostic category which may be",!,"excluded by some types of coverage.",!

 +6        WRITE "Only visits at the location where the patient is registered will be displayed.",!

F         ;

 +1        SET DIC("A")="Run the report for which Facility: "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO EOJ

 +2        SET APCLSU=+Y

SD        ;

 +1        WRITE !

 +2        SET Y=DT

           XECUTE ^DD("DD")

           SET APCLDTP=Y

 +3        SET %DT("A")="Starting Visit Date for Billable Visits: "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +4        IF Y=-1

               GOTO F

 +5        SET APCLSD=Y

           XECUTE ^DD("DD")

           SET APCLSDY=Y

ED         SET %DT("A")="Ending Visit Date for Billable Visits: "

           WRITE !

           DO ^%DT

           KILL %DT

 +1        IF Y=-1

               GOTO SD

 +2        SET APCLED=Y

           XECUTE ^DD("DD")

           SET APCLEDY=Y

 +3        IF APCLED<APCLSD

               WRITE !!,"Ending Date cannot be before Starting Date! Please reenter.",!

               GOTO SD

 +4       ;

SC        ;

 +1        KILL DIR,APCLSC,APCLSCP

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("B")="NO"

           SET DIR("A")="Do you want a particular SERVICE CATEGORY"

           SET DIR("?")=""

           DO ^DIR

           KILL DIR

 +3        IF $EXTRACT(X)=U!($DATA(DTOUT))

               GOTO SD

 +4        IF $EXTRACT(X)="N"

               SET APCLSC="AIHOS"

               SET APCLSCP="ALL VISIT SERVICE CATEGORIES"

               GOTO CLIN

SC1        SET DIR(0)="9000010,.07"

           SET DIR("A")="Which Service Category"

           DO ^DIR

           KILL DIR

 +1        IF $DATA(DTOUT)!($EXTRACT(X)=U)

               GOTO SC

 +2        IF "AHIOS"'[Y

               WRITE !!,$CHAR(7),$CHAR(7),"Sorry, we only display visits for the following service categories: ",!,"H - Hospitalizations, A - Ambulatory, I - In Hospital, O - Observation",!,"and S - Day Surgery.  Please re-enter your choice.",!

               GOTO SC1

 +3        SET APCLSC=Y

           SET APCLSCP=Y(0)

 +4       ;

CLIN      ;CLIN Screening

 +1        SET APCLCLN=""

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("B")="NO"

           SET DIR("A")="Do you want a particular CLINIC"

           SET DIR("?")=""

           DO ^DIR

           KILL DIR

 +3        IF $EXTRACT(X)=U!($DATA(DTOUT))

               GOTO SD

 +4        IF Y=0

               GOTO CT

CLIN1     ;CLIN1 SubRoutine

 +1        SET DIC("A")="Which Clinic: "

           SET DIC="^DIC(40.7,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO CLIN

 +2        SET APCLCLN=+Y

CT        ;

 +1        SET DIR(0)="SO^1:Commissioned Officers/Dependents;2:Medicare Part A;3:Medicare Part B;4:Medicaid;5:Private Insurance;6:Non-Indians;7:All Above Coverages"

           SET DIR("A")="     Select Third Party Coverage"

 +2        DO ^DIR

           KILL DIR

           WRITE !!

 +3        IF $DATA(DIRUT)

               GOTO SD

 +4        SET APCLNAR(1)="Commissioned Officers/Dependents"

 +5        SET APCLNAR(2)="Medicare Part A"

 +6        SET APCLNAR(3)="Medicare Part B"

 +7        SET APCLNAR(4)="Medicaid"

 +8        SET APCLNAR(5)="Private Insurance"

 +9        SET APCLNAR(6)="Non-Indians"

 +10       IF Y=7

               SET APCLPALL=Y

               SET APCLRNUM=1

 +11       IF Y<7

               SET (APCLPROC,APCLRNUM)=Y

               SET APCLNAR=APCLNAR(APCLRNUM)

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO CT

 +3        SET XBRP="^APCLBV1"

           SET XBRC="^APCLBV2"

           SET XBRX="EOJ^APCLBV"

           SET XBNS="APCL"

 +4        DO ^XBDBQUE

 +5        DO EOJ

 +6        QUIT

EOJ       ;ENTRY POINT

 +1        KILL POP,ZTSK,ZTQUEUED,DFN,%DT,%,X,Y,DIRUT,DTOUT,J,K,%XX,%YY,DDBN,DDBX,HS,C,IO("Q"),DIR,DIRUT,DIC,DA,DR,DIQ,SSN,H,M,S,TS

 +2        KILL APCLSD,APCLSDY,APCLED,APCLEDY,APCLPROC,APCLNAR,APCL,APCLSU,APCLLENG,APCLDTP,APCLCAT,APCLMDFN,APCLGOT,APCLBT,APCLET,APCLNAME,APCLSC,APCLSCP,APCLJOB,APCLCLN

 +3        KILL APCLS,APCLCOAR,APCLCOPN,APCLVDFN,APCLVN0,APCLCOP,APCLPN,APCLVAL,APCLTRI,APCLTRIC

 +4        KILL APCLCHMP,APCL80E,APCL80D,APCLPG,APCLEOJ,APCLX,APCLVDFN,APCLVREC,APCLDATE,APCL1,APCL2,APCLAP,APCLDISC,APCLY,APCLSKIP,APCLMN,APCLMDOB,APCLMEDN,DOB,APCLHRN,APCLVAL

 +5        KILL APCLERCO,APCLPALL,APCLRNUM,APCLCNTR,APCLSAVE,APCLQUIT

 +6        KILL APCLNDFN,APCLREC,APCLNREC

 +7        QUIT

APCLBV.m