AGMCDPC.m

AGMCDPC ; IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS BY COUNTY;

 ;;7.1;PATIENT REGISTRATION;**12**;AUG 25,2005;Build 1

 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 ;

 ;Modified so user can select one/many/all plans

 ;

 ;variables:

 ;   AGACCTS-who is on report (elig); contains O,C,T,A

 ;   AGPTS  -all patients or just active; 1 if all; 0 if not

 ;   AGFRMDT-from date for elig.

 ;   AGTODT -thru date for elig.

 ;   AGST   -state code for Medicaid number

 ;

 S AGIO=IO,AG("HAT")=""

 N AGST

 D NOW^%DTC

 S AGTODAY=X-1

ACCTS ;

 S DIR(0)="S^A:ALL ACCOUNTS (all patients);O:OPEN ACCOUNTS (anyone with coverage in date range);T:TERMED ACCOUNTS(people termed in range);C:CURRENT ACCOUNTS(anyone covered at this time)"

 S DIR("A")="Select desired accounts"

 D ^DIR K DIR

 S AGACCTS=Y

 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

 I "OT"[AGACCTS D FROM   ;do date range if OPEN or TERMED is selected

 Q:$G(AGFRMDT)["^"!($G(AGTODT)["^")

PLANS ;

 K AG("PLANS")

PLAN2 ;

 W !

 F  D  Q:+Y<0!(X["^")

 .S DIR(0)="FO"

 .I '$D(AG("PLANS")) D

 ..S DIR("A")="Enter PLAN NAME (type NONE for ones with no name)"

 ..S DIR("B")="ALL"

 .E  S DIR("A")="Enter another PLAN NAME"

 .D ^DIR K DIR

 .Q:+Y<0

 .Q:$D(DUOUT)!$D(DIROUT)!$D(DTOUT)

 .I Y="NONE" S AG("PLANS",Y)="" S Y=1 Q

 .I Y="ALL" K AG("PLANS") S Y=-1 Q

 .S DIC="^AUTNINS("

 .S X=Y

 .S DIC(0)="EMQ"

 .;S DIC("S")="I ""DK""[$P($G(^(2)),""^"",1)"

 .S DIC("S")="I ""DK""[$$INSTYP^AGUTL(Y)"  ;IHS/OIT/NKD AG*7.1*12

 .D ^DIC

 .Q:X["^"

 .S AG("PLANS",+Y)=$P(Y,"^",2)

 Q:$D(DUOUT)

PTS ;

 S DIR(0)="Y"

 S DIR("A",1)="Unless specified, ONLY ACTIVE PATIENTS will be included."

 S DIR("A")="Do you want to include inactive/deceased patients?"

 S DIR("B")="N"

 D ^DIR K DIR

 S AGPTS=Y

 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

 ;

DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q

 G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 X ^%ZOSF("UCI")

 S ZTRTN="START^AGMCDPC"

 S ZTUCI=Y,ZTIO=""

 S ZTDESC="MCAID Accounts by County for  "_$P(^AUTTLOC(DUZ(2),0),U,2)_"."

 S AGQIO=IO F G="AGQIO" S ZTSAVE(G)=""

 S ZTSAVE("AG*")=""

 D ^%ZTLOAD

 G:'$D(ZTSK) DEV K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC

 Q

 ;

START ;EP - From TaskMan.

 S DFN=0

 S AGST=""

 S (AGIMID,AGMID)=""

 K ^TMP($J)

 F  S DFN=$O(^AUPNMCD("AB",DFN)) Q:+DFN<1  D

 .F  S AGST=$O(^AUPNMCD("AB",DFN,AGST))  Q:AGST=""  D

 ..F  S AGMID=$O(^AUPNMCD("AB",DFN,AGST,AGMID))  Q:AGMID=""  D

 ...F  S AGIMID=$O(^AUPNMCD("AB",DFN,AGST,AGMID,AGIMID))  Q:AGIMID=""  D

 ....S AGFLAG=0

 ....I AGPTS["0" D ACTIVE       ;if only active

 ....I AGPTS["1" D ALL       ;if everyone

 D WRITE

 I 'AGEND D END

 Q

 ;

WRITE D NOW^AG S X=AGTIME D CTR^AG S AGTIME=X

 I $D(AGQIO) F AGZ("I")=1:1 S IOP=AGQIO D ^%ZIS Q:'POP  H 30

 S AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4

 S (AGTOT,AGPGPG)=0

 S AG("LOC")=$P(^DIC(4,DUZ(2),0),U)

 S AG("USR")=$P(^VA(200,DUZ,0),U)

 S AG("USRLOC")=AG("USR")_$J("",40-($L(AG("LOC"))\2)-$L(AG("USR")))

 S AG("USRLOC")=AG("USRLOC")_AG("LOC") X ^%ZOSF("UCI")

 S X="UCI: "_$P(Y,",",1) D CTR^AG S AGUCI=X,AGNM=""

 U IO D HDR

 S (AGST,AGNM,AGCTY,DFN,AGEND)=""

 F  S AGCTY=$O(^TMP($J,AGCTY)) Q:AGCTY=""  D  Q:AGEND

 .F  S AGNM=$O(^TMP($J,AGCTY,AGNM)) Q:AGNM=""  D  Q:AGEND

 ..F  S AGST=$O(^TMP($J,AGCTY,AGNM,AGST))  Q:AGST=""  D  Q:AGEND

 ...F  S DFN=$O(^TMP($J,AGCTY,AGNM,AGST,DFN)) Q:DFN=""  D  Q:AGEND

 ....W AGNM

 ....I AGACCTS="T" W ?30,$P($G(^DPT(DFN,.13)),U)

 ....W ?45 W:$D(^AUPNPAT(DFN,41,DUZ(2),0)) $P(^(0),U,2)

 ....W ?55,AGCTY

 ....W ?77,$P($G(^DIC(5,AGST,0)),U,2)   ;STATE ABBREV.

 ....F  S AGMID=$O(^TMP($J,AGCTY,AGNM,AGST,DFN,AGMID))  Q:AGMID=""  D

 .....S AGELGBEG=""

 .....F  S AGELGBEG=$O(^TMP($J,AGCTY,AGNM,AGST,DFN,AGMID,AGELGBEG))  Q:AGELGBEG=""  D

 ......S AGREC=$G(^TMP($J,AGCTY,AGNM,AGST,DFN,AGMID,AGELGBEG))

 ......S (AGELGBG1,AGELGED1,AGPLAN,AGRATE,AGCOV)=""

 ......S AGELGBG1=$$DT(AGELGBEG)

 ......S AGELGED1=$$DT($P(AGREC,U))

 ......S AGPLAN=$P(AGREC,U,2)

 ......I $G(AGPLAN)'="" S AGPLAN=$E($P($G(^AUTNINS(AGPLAN,0)),U),1,22)

 ......S AGRATE=$P(AGREC,U,3)

 ......S AGCOV=$P(AGREC,U,4)

 ......W !,?3,AGPLAN,?26,AGELGBG1,?37,$E(AGMID,1,20),?50,AGELGED1,?61,AGRATE,?71,AGCOV

 ....W !

 ....F A=1:1:80 W "-"

 ..S AGTOT=AGTOT+1

 ..W !      ;space between states,counties

 ..I $Y>AGBM D

 ...D RTRN^AG

 ...I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) S AGEND=1 G END

 ...D HDR

 Q

 ;

END W !!!,"TOTAL MEDICAID PATIENTS: ",AGTOT K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")

 D ^%ZISC

 K ^TMP($J),AG,AGBM,AGIO,AGTIME,AGCP,AGCTY,DA,DFN,DIC,DR,G,AGL,I

 K AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),AGNM,AGNUM,AGPCC

 K AGPGPG,AGPT,AGST,AGTOT,AGUCI,AG("USR"),AG("USRLOC"),X,Y

 D:$D(ZTQUEUED) KILL^%ZTLOAD

 Q

 ;

HDR ;

 I $D(AGFRMDT),$D(AGTODT) D

 .S AGFRMDT1=$$DT(AGFRMDT)

 .S AGTODT1=$$DT(AGTODT)

 S AGPGPG=AGPGPG+1 D

 .W $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG

 .I AGPTS["1" S AGPTS1="ACTIVE/INACTIVE/DECEASED"

 .E  S AGPTS1="ACTIVE"

 .W !?8,AGPTS1_" PATIENTS - MEDICAID ACCOUNTS BY COUNTY"

 .I AGACCTS["A" S AGACCTS1="ALL ACCOUNTS"

 .I AGACCTS["C" S AGACCTS1="CURRENT ACCOUNTS"

 .I AGACCTS["O" S AGACCTS1="OPEN ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1

 .I AGACCTS["T" S AGACCTS1="TERMED ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1

 .W !?8,"FOR "_AGACCTS1

 .S (AGPLNNM,AGPLN,AGPLNS)=""

 .F  S AGPLNNM=$O(AG("PLANS",AGPLNNM)) Q:AGPLNNM=""  D

 ..S AGPLN=$G(AG("PLANS",AGPLNNM))

 ..I AGPLNNM="NONE" S AGPLN="WITH NO PLAN NAME"

 ..I AGPLNS="" S AGPLNS=AGPLN

 ..E  S AGPLNS=AGPLNS_" and "_AGPLN

 .W " FOR "_AGPLNS

 .I '$D(AG("PLANS")) W " FOR ALL PLANS"

 .W !,AGUCI

 .W !!,AGTIME,!!,?1,"PATIENT NAME"

 .I AGACCTS="T" W ?30,"HOME PHONE"

 .W ?45,"IHS #",?55,"COUNTY(RES)",?77,"ST."

 .W !,?3,"PLAN NAME",?26,"ELIG BEGIN",?37,"NUMBER",?50,"ELIG END",?61,"RATE CODE",?71,"COV.TYPE"

 .S AG("LINE")="=" D LINE^AG

 Q

FROM ;

 S DIR(0)="D"

 S DIR("A")="ENTER FROM DATE"

 D ^DIR K DIR

 S AGFRMDT=Y

 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

TO ;

 S DIR(0)="D"

 S DIR("A")="ENTER THRU DATE"

 D ^DIR K DIR

 S AGTODT=Y

 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

 Q

ACTIVE ;if they have HRN, are active, and have info in VA PATIENT

 I $D(^AUPNPAT(DFN,41,DUZ(2))),$P(^(DUZ(2),0),U,3)="",$D(^DPT(DFN)),'$D(^DPT(DFN,.35)) D

 .I AGACCTS="O" D OPEN

 .I AGACCTS="C" D CURRENT

 .I AGACCTS="T" D TERM

 .I AGACCTS="A" D ALL

 Q

ALL ;

 S AGELGDT=0

 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D

 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))

 .S AGELGBEG=$P(AGELG,U)

 .S AGELGEND=$P(AGELG,U,2)

 .S AGCOV=$P(AGELG,U,3)

 .S AGELG2=$G(^AUPNMCD(AGIMID,0))

 .S AGPLAN=$P(AGELG2,U,10)

 .S AGFLG=0

 .I $D(AG("PLANS")) D  Q:AGFLG

 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q

 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q

 .S AGRATE=$P(AGELG2,U,11)

 .D COUNTY

 .S ^TMP($J,AGCTY,$P(^DPT(DFN,0),U),AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV

 Q

OPEN ;

 S AGELGDT=0

 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D

 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))

 .S AGELGBEG=$P(AGELG,U)

 .S AGELGEND=$P(AGELG,U,2)

 .S AGCOV=$P(AGELG,U,3)

 .S AGELG2=$G(^AUPNMCD(AGIMID,0))

 .S AGPLAN=$P(AGELG2,U,10)

 .S AGFLG=0

 .I $D(AG("PLANS")) D  Q:AGFLG

 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q

 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q

 .S AGRATE=$P(AGELG2,U,11)

 .I +$G(AGELGEND)'=0 Q

 .I $D(AGELGBEG),AGELGBEG<AGTODT,AGELGBEG>AGFRMDT D

 ..D COUNTY

 ..S ^TMP($J,AGCTY,$P(^DPT(DFN,0),U),AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV

 Q

CURRENT ;

 S AGELGDT=0

 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D

 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))

 .S AGELGBEG=$P(AGELG,U)

 .S AGELGEND=$P(AGELG,U,2)

 .S AGCOV=$P(AGELG,U,3)

 .S AGELG2=$G(^AUPNMCD(AGIMID,0))

 .S AGPLAN=$P(AGELG2,U,10)

 .S AGFLG=0

 .I $D(AG("PLANS")) D  Q:AGFLG

 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q

 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q

 .S AGRATE=$P(AGELG2,U,11)

 .;Checks if they already have a term date but it isn't until later

 .I AGELGEND>AGTODAY!(+$G(AGELGEND)=0) D

 ..D COUNTY

 ..S ^TMP($J,AGCTY,$P(^DPT(DFN,0),U),AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV

 Q

TERM ;

 S AGELGDT=0

 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D

 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))

 .S AGELGBEG=$P(AGELG,U)

 .S AGELGEND=$P(AGELG,U,2)

 .S AGCOV=$P(AGELG,U,3)

 .S AGELG2=$G(^AUPNMCD(AGIMID,0))

 .S AGPLAN=$P(AGELG2,U,10)

 .S AGFLG=0

 .I $D(AG("PLANS")) D  Q:AGFLG

 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q

 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q

 .S AGRATE=$P(AGELG2,U,11)

 .I +$G(AGELGEND)=0 Q

 .I AGELGEND<AGTODT,AGELGEND>AGFRMDT D

 ..D COUNTY

 ..S ^TMP($J,AGCTY,$P(^DPT(DFN,0),U),AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV

 Q

B1 I $Y>AGBM D RTRN^AG G END:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR

 W !!

 Q

DT(DT) ;

 I DT="" Q ""

 S DT1=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"

 S DT1=DT1_$S($E(DT,1)=3:20,$E(DT,1)=2:19)_$E(DT,2,3)

 Q DT1

COUNTY ;

 S DA=DFN

 S DIC=9000001.51

 S DR=.03

 S AG("DRENT")=0

 S AGCTY=""

 D ^AGDICLK

 I '$D(AG("LKERR")),AG("LKDATA")]"",$D(^AUTTCOM(AG("LKDATA"),0)) D

 .S AGCP=$P(^AUTTCOM(AG("LKDATA"),0),U,2)

 .I AGCP,$D(^AUTTCTY(AGCP,0)) S AGCTY=$E($P(^(0),U),1,12)

 Q

AGMCDPC   ; IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS BY COUNTY;

 +1       ;;7.1;PATIENT REGISTRATION;**12**;AUG 25,2005;Build 1

 +2       ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 +3       ;

 +4       ;Modified so user can select one/many/all plans

 +5       ;

 +6       ;variables:

 +7       ;   AGACCTS-who is on report (elig); contains O,C,T,A

 +8       ;   AGPTS  -all patients or just active; 1 if all; 0 if not

 +9       ;   AGFRMDT-from date for elig.

 +10      ;   AGTODT -thru date for elig.

 +11      ;   AGST   -state code for Medicaid number

 +12      ;

 +13       SET AGIO=IO

           SET AG("HAT")=""

 +14       NEW AGST

 +15       DO NOW^%DTC

 +16       SET AGTODAY=X-1

ACCTS     ;

 +1        SET DIR(0)="S^A:ALL ACCOUNTS (all patients);O:OPEN ACCOUNTS (anyone with coverage in date range);T:TERMED ACCOUNTS(people termed in range);C:CURRENT ACCOUNTS(anyone covered at this time)"

 +2        SET DIR("A")="Select desired accounts"

 +3        DO ^DIR

           KILL DIR

 +4        SET AGACCTS=Y

 +5        IF $DATA(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

               QUIT 

 +6       ;do date range if OPEN or TERMED is selected

           IF "OT"[AGACCTS

               DO FROM

 +7        IF $GET(AGFRMDT)["^"!($GET(AGTODT)["^")

               QUIT 

PLANS     ;

 +1        KILL AG("PLANS")

PLAN2     ;

 +1        WRITE !

 +2        FOR 

               Begin DoDot:1

 +3                SET DIR(0)="FO"

 +4                IF '$DATA(AG("PLANS"))

                       Begin DoDot:2

 +5                        SET DIR("A")="Enter PLAN NAME (type NONE for ones with no name)"

 +6                        SET DIR("B")="ALL"

                       End DoDot:2

 +7               IF '$TEST

                       SET DIR("A")="Enter another PLAN NAME"

 +8                DO ^DIR

                   KILL DIR

 +9                IF +Y<0

                       QUIT 

 +10               IF $DATA(DUOUT)!$DATA(DIROUT)!$DATA(DTOUT)

                       QUIT 

 +11               IF Y="NONE"

                       SET AG("PLANS",Y)=""

                       SET Y=1

                       QUIT 

 +12               IF Y="ALL"

                       KILL AG("PLANS")

                       SET Y=-1

                       QUIT 

 +13               SET DIC="^AUTNINS("

 +14               SET X=Y

 +15               SET DIC(0)="EMQ"

 +16      ;S DIC("S")="I ""DK""[$P($G(^(2)),""^"",1)"

 +17      ;IHS/OIT/NKD AG*7.1*12

                   SET DIC("S")="I ""DK""[$$INSTYP^AGUTL(Y)"

 +18               DO ^DIC

 +19               IF X["^"

                       QUIT 

 +20               SET AG("PLANS",+Y)=$PIECE(Y,"^",2)

               End DoDot:1

               IF +Y<0!(X["^")

                   QUIT 

 +21       IF $DATA(DUOUT)

               QUIT 

PTS       ;

 +1        SET DIR(0)="Y"

 +2        SET DIR("A",1)="Unless specified, ONLY ACTIVE PATIENTS will be included."

 +3        SET DIR("A")="Do you want to include inactive/deceased patients?"

 +4        SET DIR("B")="N"

 +5        DO ^DIR

           KILL DIR

 +6        SET AGPTS=Y

 +7        IF $DATA(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

               QUIT 

 +8       ;

DEV        SET %ZIS="OPQ"

           DO ^%ZIS

           IF POP

               SET IOP=ION

               DO ^%ZIS

               QUIT 

 +1        IF '$DATA(IO("Q"))

               GOTO START

           KILL IO("Q")

           IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +2        XECUTE ^%ZOSF("UCI")

 +3        SET ZTRTN="START^AGMCDPC"

 +4        SET ZTUCI=Y

           SET ZTIO=""

 +5        SET ZTDESC="MCAID Accounts by County for  "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."

 +6        SET AGQIO=IO

           FOR G="AGQIO"

               SET ZTSAVE(G)=""

 +7        SET ZTSAVE("AG*")=""

 +8        DO ^%ZTLOAD

 +9        IF '$DATA(ZTSK)

               GOTO DEV

           KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI

           DO ^%ZISC

 +10       QUIT 

 +11      ;

START     ;EP - From TaskMan.

 +1        SET DFN=0

 +2        SET AGST=""

 +3        SET (AGIMID,AGMID)=""

 +4        KILL ^TMP($JOB)

 +5        FOR 

               SET DFN=$ORDER(^AUPNMCD("AB",DFN))

               IF +DFN<1

                   QUIT 

               Begin DoDot:1

 +6                FOR 

                       SET AGST=$ORDER(^AUPNMCD("AB",DFN,AGST))

                       IF AGST=""

                           QUIT 

                       Begin DoDot:2

 +7                        FOR 

                               SET AGMID=$ORDER(^AUPNMCD("AB",DFN,AGST,AGMID))

                               IF AGMID=""

                                   QUIT 

                               Begin DoDot:3

 +8                                FOR 

                                       SET AGIMID=$ORDER(^AUPNMCD("AB",DFN,AGST,AGMID,AGIMID))

                                       IF AGIMID=""

                                           QUIT 

                                       Begin DoDot:4

 +9                                        SET AGFLAG=0

 +10      ;if only active

                                           IF AGPTS["0"

                                               DO ACTIVE

 +11      ;if everyone

                                           IF AGPTS["1"

                                               DO ALL

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       DO WRITE

 +13       IF 'AGEND

               DO END

 +14       QUIT 

 +15      ;

WRITE      DO NOW^AG

           SET X=AGTIME

           DO CTR^AG

           SET AGTIME=X

 +1        IF $DATA(AGQIO)

               FOR AGZ("I")=1:1

                   SET IOP=AGQIO

                   DO ^%ZIS

                   IF 'POP

                       QUIT 

                   HANG 30

 +2        SET AGBM=IOSL-10

           IF $DATA(AGIO)

               IF AGIO=IO

                   SET AGBM=IOSL-4

 +3        SET (AGTOT,AGPGPG)=0

 +4        SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)

 +5        SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)

 +6        SET AG("USRLOC")=AG("USR")_$JUSTIFY("",40-($LENGTH(AG("LOC"))\2)-$LENGTH(AG("USR")))

 +7        SET AG("USRLOC")=AG("USRLOC")_AG("LOC")

           XECUTE ^%ZOSF("UCI")

 +8        SET X="UCI: "_$PIECE(Y,",",1)

           DO CTR^AG

           SET AGUCI=X

           SET AGNM=""

 +9        USE IO

           DO HDR

 +10       SET (AGST,AGNM,AGCTY,DFN,AGEND)=""

 +11       FOR 

               SET AGCTY=$ORDER(^TMP($JOB,AGCTY))

               IF AGCTY=""

                   QUIT 

               Begin DoDot:1

 +12               FOR 

                       SET AGNM=$ORDER(^TMP($JOB,AGCTY,AGNM))

                       IF AGNM=""

                           QUIT 

                       Begin DoDot:2

 +13                       FOR 

                               SET AGST=$ORDER(^TMP($JOB,AGCTY,AGNM,AGST))

                               IF AGST=""

                                   QUIT 

                               Begin DoDot:3

 +14                               FOR 

                                       SET DFN=$ORDER(^TMP($JOB,AGCTY,AGNM,AGST,DFN))

                                       IF DFN=""

                                           QUIT 

                                       Begin DoDot:4

 +15                                       WRITE AGNM

 +16                                       IF AGACCTS="T"

                                               WRITE ?30,$PIECE($GET(^DPT(DFN,.13)),U)

 +17                                       WRITE ?45

                                           IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))

                                               WRITE $PIECE(^(0),U,2)

 +18                                       WRITE ?55,AGCTY

 +19      ;STATE ABBREV.

                                           WRITE ?77,$PIECE($GET(^DIC(5,AGST,0)),U,2)

 +20                                       FOR 

                                               SET AGMID=$ORDER(^TMP($JOB,AGCTY,AGNM,AGST,DFN,AGMID))

                                               IF AGMID=""

                                                   QUIT 

                                               Begin DoDot:5

 +21                                               SET AGELGBEG=""

 +22                                               FOR 

                                                       SET AGELGBEG=$ORDER(^TMP($JOB,AGCTY,AGNM,AGST,DFN,AGMID,AGELGBEG))

                                                       IF AGELGBEG=""

                                                           QUIT 

                                                       Begin DoDot:6

 +23                                                       SET AGREC=$GET(^TMP($JOB,AGCTY,AGNM,AGST,DFN,AGMID,AGELGBEG))

 +24                                                       SET (AGELGBG1,AGELGED1,AGPLAN,AGRATE,AGCOV)=""

 +25                                                       SET AGELGBG1=$$DT(AGELGBEG)

 +26                                                       SET AGELGED1=$$DT($PIECE(AGREC,U))

 +27                                                       SET AGPLAN=$PIECE(AGREC,U,2)

 +28                                                       IF $GET(AGPLAN)'=""

                                                               SET AGPLAN=$EXTRACT($PIECE($GET(^AUTNINS(AGPLAN,0)),U),1,22)

 +29                                                       SET AGRATE=$PIECE(AGREC,U,3)

 +30                                                       SET AGCOV=$PIECE(AGREC,U,4)

 +31                                                       WRITE !,?3,AGPLAN,?26,AGELGBG1,?37,$EXTRACT(AGMID,1,20),?50,AGELGED1,?61,AGRATE,?71,AGCOV

                                                       End DoDot:6

                                               End DoDot:5

 +32                                       WRITE !

 +33                                       FOR A=1:1:80

                                               WRITE "-"

                                       End DoDot:4

                                       IF AGEND

                                           QUIT 

                               End DoDot:3

                               IF AGEND

                                   QUIT 

 +34                       SET AGTOT=AGTOT+1

 +35      ;space between states,counties

                           WRITE !

 +36                       IF $Y>AGBM

                               Begin DoDot:3

 +37                               DO RTRN^AG

 +38                               IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)

                                       SET AGEND=1

                                       GOTO END

 +39                               DO HDR

                               End DoDot:3

                       End DoDot:2

                       IF AGEND

                           QUIT 

               End DoDot:1

               IF AGEND

                   QUIT 

 +40       QUIT 

 +41      ;

END        WRITE !!!,"TOTAL MEDICAID PATIENTS: ",AGTOT

           KILL AG("HAT")

           DO RTRN^AG

           WRITE $$S^AGVDF("IOF")

 +1        DO ^%ZISC

 +2        KILL ^TMP($JOB),AG,AGBM,AGIO,AGTIME,AGCP,AGCTY,DA,DFN,DIC,DR,G,AGL,I

 +3        KILL AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),AGNM,AGNUM,AGPCC

 +4        KILL AGPGPG,AGPT,AGST,AGTOT,AGUCI,AG("USR"),AG("USRLOC"),X,Y

 +5        IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +6        QUIT 

 +7       ;

HDR       ;

 +1        IF $DATA(AGFRMDT)

               IF $DATA(AGTODT)

                   Begin DoDot:1

 +2                    SET AGFRMDT1=$$DT(AGFRMDT)

 +3                    SET AGTODT1=$$DT(AGTODT)

                   End DoDot:1

 +4        SET AGPGPG=AGPGPG+1

           Begin DoDot:1

 +5            WRITE $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG

 +6            IF AGPTS["1"

                   SET AGPTS1="ACTIVE/INACTIVE/DECEASED"

 +7           IF '$TEST

                   SET AGPTS1="ACTIVE"

 +8            WRITE !?8,AGPTS1_" PATIENTS - MEDICAID ACCOUNTS BY COUNTY"

 +9            IF AGACCTS["A"

                   SET AGACCTS1="ALL ACCOUNTS"

 +10           IF AGACCTS["C"

                   SET AGACCTS1="CURRENT ACCOUNTS"

 +11           IF AGACCTS["O"

                   SET AGACCTS1="OPEN ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1

 +12           IF AGACCTS["T"

                   SET AGACCTS1="TERMED ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1

 +13           WRITE !?8,"FOR "_AGACCTS1

 +14           SET (AGPLNNM,AGPLN,AGPLNS)=""

 +15           FOR 

                   SET AGPLNNM=$ORDER(AG("PLANS",AGPLNNM))

                   IF AGPLNNM=""

                       QUIT 

                   Begin DoDot:2

 +16                   SET AGPLN=$GET(AG("PLANS",AGPLNNM))

 +17                   IF AGPLNNM="NONE"

                           SET AGPLN="WITH NO PLAN NAME"

 +18                   IF AGPLNS=""

                           SET AGPLNS=AGPLN

 +19                  IF '$TEST

                           SET AGPLNS=AGPLNS_" and "_AGPLN

                   End DoDot:2

 +20           WRITE " FOR "_AGPLNS

 +21           IF '$DATA(AG("PLANS"))

                   WRITE " FOR ALL PLANS"

 +22           WRITE !,AGUCI

 +23           WRITE !!,AGTIME,!!,?1,"PATIENT NAME"

 +24           IF AGACCTS="T"

                   WRITE ?30,"HOME PHONE"

 +25           WRITE ?45,"IHS #",?55,"COUNTY(RES)",?77,"ST."

 +26           WRITE !,?3,"PLAN NAME",?26,"ELIG BEGIN",?37,"NUMBER",?50,"ELIG END",?61,"RATE CODE",?71,"COV.TYPE"

 +27           SET AG("LINE")="="

               DO LINE^AG

           End DoDot:1

 +28       QUIT 

FROM      ;

 +1        SET DIR(0)="D"

 +2        SET DIR("A")="ENTER FROM DATE"

 +3        DO ^DIR

           KILL DIR

 +4        SET AGFRMDT=Y

 +5        IF $DATA(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

               QUIT 

TO        ;

 +1        SET DIR(0)="D"

 +2        SET DIR("A")="ENTER THRU DATE"

 +3        DO ^DIR

           KILL DIR

 +4        SET AGTODT=Y

 +5        IF $DATA(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")

               QUIT 

 +6        QUIT 

ACTIVE    ;if they have HRN, are active, and have info in VA PATIENT

 +1        IF $DATA(^AUPNPAT(DFN,41,DUZ(2)))

               IF $PIECE(^(DUZ(2),0),U,3)=""

                   IF $DATA(^DPT(DFN))

                       IF '$DATA(^DPT(DFN,.35))

                           Begin DoDot:1

 +2                            IF AGACCTS="O"