Routine: APCLBRH

APCLBRH ; IHS/CMI/LAB - list holders of medicare a, b, medicaid or priv ins ;

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

 I '$D(APCLRPT) W !,$C(7),$C(7),"REPORT TYPE MISSING!!  NOTIFY PROGRAMMER",! Q

 D GETINFO G:$D(APCLQ) QUIT

 W !!,"This option will print a list of Patients who are registered at",!,"the facility that you select who are currently enrolled in ",APCLINF,".",!

 W !,"You will be asked to enter an 'As of' date to be used in determining",!,"those patients who are 'actively' enrolled.",!

 W !,"The report will be sorted alphabetically by Patient Name.",!

F ;

 S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 QUIT

 S APCLSU=+Y

AOD ;

 S %DT("A")="Patients are to be considered ACTIVE as of what date: ",%DT="AEPX" W ! D ^%DT

 I Y=-1 G F

 S APCLACE=Y X ^DD("DD") S APCLACEY=Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G AOD

 S XBRP="^APCLBRH1",XBRC="^APCLBRH2",XBRX="QUIT^APCLBRH",XBNS="APCL"

 D ^XBDBQUE

 D QUIT

QUIT ;

 K POP,ZTSK,ZTQUEUED,DFN,%DT,%,X,Y,DIRUT,J,K,%XX,%YY,DDBN,DDBT,DDBX,HS,IX,C,H,M,S,TS

 K APCLACE,APCLSU,APCLINFO,APCL80D,APCLACEY,DOB,APCLGOT,APCLINF,APCLLENG,APCLMDFN,APCLMDOB,APCLMEDN,APCLMN,APCLPG,APCLPN,APCLPROC,APCLR,APCLRPT,APCLTITL,APCLTOT,APCLVAL,APCLHRN,APCLQ,APCLDDFN,APCLBT,APCLNAME,APCLNDFN,APCLNREC,APCLJOB

GETINFO ;

 I $T(@(APCLRPT))="" W !!,$C(7),$C(7),"REPORT INFORMATION MISSING!! NOTIFY PROGRAMMER!",!! S APCLQ="" Q

 S APCLINFO=$T(@(APCLRPT)),APCLVAL=$P(APCLINFO,";;",2),APCLPROC=$P(APCLINFO,";;",4),APCLINF=$P(APCLINFO,";;",3),APCLTITL=$P(APCLINFO,";;",5)

MCD ;;X;;Medicaid;;MCD;;ACTIVE MEDICAID ENROLLEES

MCRA ;;A;;Medicare Part A;;MCRA;;ACTIVE MEDICARE PART A ENROLLEES

MCRB ;;B;;Medicare Part B;;MCRA;;ACTIVE MEDICARE PART B ENROLLEES

PI ;;X;;Private Insurance;;PI;;ACTIVE PRIVATE INSURANCE ENROLLEES

APCLBRH   ; IHS/CMI/LAB - list holders of medicare a, b, medicaid or priv ins ;

 +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        IF '$DATA(APCLRPT)

               WRITE !,$CHAR(7),$CHAR(7),"REPORT TYPE MISSING!!  NOTIFY PROGRAMMER",!

               QUIT

 +4        DO GETINFO

           IF $DATA(APCLQ)

               GOTO QUIT

 +5        WRITE !!,"This option will print a list of Patients who are registered at",!,"the facility that you select who are currently enrolled in ",APCLINF,".",!

 +6        WRITE !,"You will be asked to enter an 'As of' date to be used in determining",!,"those patients who are 'actively' enrolled.",!

 +7        WRITE !,"The report will be sorted alphabetically by Patient Name.",!

F         ;

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

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO QUIT

 +2        SET APCLSU=+Y

AOD       ;

 +1        SET %DT("A")="Patients are to be considered ACTIVE as of what date: "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +2        IF Y=-1

               GOTO F

 +3        SET APCLACE=Y

           XECUTE ^DD("DD")

           SET APCLACEY=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO AOD

 +3        SET XBRP="^APCLBRH1"

           SET XBRC="^APCLBRH2"

           SET XBRX="QUIT^APCLBRH"

           SET XBNS="APCL"

 +4        DO ^XBDBQUE

 +5        DO QUIT

 +6        QUIT

QUIT      ;

 +1        KILL POP,ZTSK,ZTQUEUED,DFN,%DT,%,X,Y,DIRUT,J,K,%XX,%YY,DDBN,DDBT,DDBX,HS,IX,C,H,M,S,TS

 +2        KILL APCLACE,APCLSU,APCLINFO,APCL80D,APCLACEY,DOB,APCLGOT,APCLINF,APCLLENG,APCLMDFN,APCLMDOB,APCLMEDN,APCLMN,APCLPG,APCLPN,APCLPROC,APCLR,APCLRPT,APCLTITL,APCLTOT,APCLVAL,APCLHRN,APCLQ,APCLDDFN,APCLBT,APCLNAME,APCLNDFN,APCLNREC,APCLJOB

 +3        QUIT

 +4       ;

GETINFO   ;

 +1        IF $TEXT(@(APCLRPT))=""

               WRITE !!,$CHAR(7),$CHAR(7),"REPORT INFORMATION MISSING!! NOTIFY PROGRAMMER!",!!

               SET APCLQ=""

               QUIT

 +2        SET APCLINFO=$TEXT(@(APCLRPT))

           SET APCLVAL=$PIECE(APCLINFO,";;",2)

           SET APCLPROC=$PIECE(APCLINFO,";;",4)

           SET APCLINF=$PIECE(APCLINFO,";;",3)

           SET APCLTITL=$PIECE(APCLINFO,";;",5)

 +3        QUIT

 +4       ;

MCD       ;;X;;Medicaid;;MCD;;ACTIVE MEDICAID ENROLLEES

MCRA      ;;A;;Medicare Part A;;MCRA;;ACTIVE MEDICARE PART A ENROLLEES

MCRB      ;;B;;Medicare Part B;;MCRA;;ACTIVE MEDICARE PART B ENROLLEES

PI        ;;X;;Private Insurance;;PI;;ACTIVE PRIVATE INSURANCE ENROLLEES

APCLBRH.m