AGMCDPCM ; IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS BY COMMUNITY;
;;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^AGMCDPCM"
S ZTUCI=Y,ZTIO=""
S ZTDESC="MCAID Accounts by Community 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,AGCOMM,AGNM,AGCTY,DFN,AGEND)=""
F S AGCOMM=$O(^TMP($J,AGCOMM)) Q:AGCOMM="" D Q:AGEND
.F S AGNM=$O(^TMP($J,AGCOMM,AGNM)) Q:AGNM="" D Q:AGEND
..F S AGCTY=$O(^TMP($J,AGCOMM,AGNM,AGCTY)) Q:AGCTY="" D Q:AGEND
...F S AGST=$O(^TMP($J,AGCOMM,AGNM,AGCTY,AGST)) Q:AGST="" D Q:AGEND
....F S DFN=$O(^TMP($J,AGCOMM,AGNM,AGCTY,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(^DIC(5,AGST,0),U,2) ;STATE ABBREV.
.....F S AGMID=$O(^TMP($J,AGCOMM,AGNM,AGCTY,AGST,DFN,AGMID)) Q:AGMID="" D
......S AGELGBEG=""
......F S AGELGBEG=$O(^TMP($J,AGCOMM,AGNM,AGCTY,AGST,DFN,AGMID,AGELGBEG)) Q:AGELGBEG="" D
.......S AGREC=$G(^TMP($J,AGCOMM,AGNM,AGCTY,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 !
....S AGTOT=AGTOT+1
....F A=1:1:80 W "-"
..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 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 COMMUNITY"
.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 AGCOMM=$P($G(^AUPNPAT(DFN,11)),U,18)
.Q:AGCOMM']""
.S ^TMP($J,AGCOMM,$P(^DPT(DFN,0),U),AGCTY,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 AGCOMM=$P($G(^AUPNPAT(DFN,11)),U,18)
..Q:AGCOMM']""
..S ^TMP($J,AGCOMM,$P(^DPT(DFN,0),U),AGCTY,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)
.I AGELGEND>AGTODAY!(+$G(AGELGEND)=0) D
..D COUNTY
..S AGCOMM=$P($G(^AUPNPAT(DFN,11)),U,18)
..Q:AGCOMM']""
..S ^TMP($J,AGCOMM,$P(^DPT(DFN,0),U),AGCTY,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 AGCOMM=$P($G(^AUPNPAT(DFN,11)),U,18)
..Q:AGCOMM']""
..S ^TMP($J,AGCOMM,$P(^DPT(DFN,0),U),AGCTY,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 AGCTY=$P(^AUTTCOM(AG("LKDATA"),0),U,2) Q:AGCTY']""
.I $D(^AUTTCTY(AGCTY,0)) S AGCTY=$P(^AUTTCTY(AGCTY,0),U)
Q
AGMCDPCM ; IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS BY COMMUNITY;
+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
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^AGMCDPCM"
+4 SET ZTUCI=Y
SET ZTIO=""
+5 SET ZTDESC="MCAID Accounts by Community 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
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
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,AGCOMM,AGNM,AGCTY,DFN,AGEND)=""
+11 FOR
SET AGCOMM=$ORDER(^TMP($JOB,AGCOMM))
IF AGCOMM=""
QUIT
Begin DoDot:1
+12 FOR
SET AGNM=$ORDER(^TMP($JOB,AGCOMM,AGNM))
IF AGNM=""
QUIT
Begin DoDot:2
+13 FOR
SET AGCTY=$ORDER(^TMP($JOB,AGCOMM,AGNM,AGCTY))
IF AGCTY=""
QUIT
Begin DoDot:3
+14 FOR
SET AGST=$ORDER(^TMP($JOB,AGCOMM,AGNM,AGCTY,AGST))
IF AGST=""
QUIT
Begin DoDot:4
+15 FOR
SET DFN=$ORDER(^TMP($JOB,AGCOMM,AGNM,AGCTY,AGST,DFN))
IF DFN=""
QUIT
Begin DoDot:5
+16 WRITE AGNM
+17 IF AGACCTS="T"
WRITE ?30,$PIECE($GET(^DPT(DFN,.13)),U)
+18 WRITE ?45
IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))
WRITE $PIECE(^(0),U,2)
+19 WRITE ?55,AGCTY
+20 ;STATE ABBREV.
WRITE ?77,$PIECE(^DIC(5,AGST,0),U,2)
+21 FOR
SET AGMID=$ORDER(^TMP($JOB,AGCOMM,AGNM,AGCTY,AGST,DFN,AGMID))
IF AGMID=""
QUIT
Begin DoDot:6
+22 SET AGELGBEG=""
+23 FOR
SET AGELGBEG=$ORDER(^TMP($JOB,AGCOMM,AGNM,AGCTY,AGST,DFN,AGMID,AGELGBEG))
IF AGELGBEG=""
QUIT
Begin DoDot:7
+24 SET AGREC=$GET(^TMP($JOB,AGCOMM,AGNM,AGCTY,AGST,DFN,AGMID,AGELGBEG))
+25 SET (AGELGBG1,AGELGED1,AGPLAN,AGRATE,AGCOV)=""
+26 SET AGELGBG1=$$DT(AGELGBEG)
+27 SET AGELGED1=$$DT($PIECE(AGREC,U))
+28 SET AGPLAN=$PIECE(AGREC,U,2)
+29 IF $GET(AGPLAN)'=""
SET AGPLAN=$EXTRACT($PIECE($GET(^AUTNINS(AGPLAN,0)),U),1,22)
+30 SET AGRATE=$PIECE(AGREC,U,3)
+31 SET AGCOV=$PIECE(AGREC,U,4)
+32 WRITE !,?3,AGPLAN,?26,AGELGBG1,?37,$EXTRACT(AGMID,1,20),?50,AGELGED1,?61,AGRATE,?71,AGCOV
End DoDot:7
End DoDot:6
+33 WRITE !
End DoDot:5
IF AGEND
QUIT
+34 SET AGTOT=AGTOT+1
+35 FOR A=1:1:80
WRITE "-"
End DoDot:4
IF AGEND
QUIT
End DoDot:3
IF AGEND
QUIT
+36 ;space between states,counties
WRITE !
+37 IF $Y>AGBM
Begin DoDot:3
+38 DO RTRN^AG
+39 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
SET AGEND=1
GOTO END
+40 DO HDR
End DoDot:3
End DoDot:2
IF AGEND
QUIT
End DoDot:1
IF AGEND
QUIT
+41 QUIT
END WRITE !!!,"TOTAL MEDICAID PATIENTS: ",AGTOT
KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
+1 DO ^%ZISC
+2 KILL AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),AGNM,AGNUM,AGPCC
+3 KILL AGPGPG,AGPT,AGST,AGTOT,AGUCI,AG("USR"),AG("USRLOC"),X,Y
+4 IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+5 QUIT
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 COMMUNITY"
+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"
DO OPEN
+3 IF AGACCTS="C"
DO CURRENT
+4 IF AGACCTS="T"
DO TERM
+5 IF AGACCTS="A"
DO ALL
End DoDot:1
+6 QUIT
ALL ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF AGELGDT=""
QUIT
Begin DoDot:1
+3 SET AGELG=$GET(^AUPNMCD(AGIMID,11,AGELGDT,0))
+4 SET AGELGBEG=$PIECE(AGELG,U)
+5 SET AGELGEND=$PIECE(AGELG,U,2)
+6 SET AGCOV=$PIECE(AGELG,U,3)
+7 SET AGELG2=$GET(^AUPNMCD(AGIMID,0))
+8 SET AGPLAN=$PIECE(AGELG2,U,10)
+9 SET AGFLG=0
+10 IF $DATA(AG("PLANS"))
Begin DoDot:2
+11 IF $GET(AGPLAN)=""
IF '$DATA(AG("PLANS","NONE"))
SET AGFLG=1
QUIT
+12 IF $GET(AGPLAN)'=""
IF '$DATA(AG("PLANS",AGPLAN))
SET AGFLG=1
QUIT
End DoDot:2
IF AGFLG
QUIT
+13 SET AGRATE=$PIECE(AGELG2,U,11)
+14 DO COUNTY
+15 SET AGCOMM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+16 IF AGCOMM']""
QUIT
+17 SET ^TMP($JOB,AGCOMM,$PIECE(^DPT(DFN,0),U),AGCTY,AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:1
+18 QUIT
OPEN ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF AGELGDT=""
QUIT
Begin DoDot:1
+3 SET AGELG=$GET(^AUPNMCD(AGIMID,11,AGELGDT,0))
+4 SET AGELGBEG=$PIECE(AGELG,U)
+5 SET AGELGEND=$PIECE(AGELG,U,2)
+6 SET AGCOV=$PIECE(AGELG,U,3)
+7 SET AGELG2=$GET(^AUPNMCD(AGIMID,0))
+8 SET AGPLAN=$PIECE(AGELG2,U,10)
+9 SET AGFLG=0
+10 IF $DATA(AG("PLANS"))
Begin DoDot:2
+11 IF $GET(AGPLAN)=""
IF '$DATA(AG("PLANS","NONE"))
SET AGFLG=1
QUIT
+12 IF $GET(AGPLAN)'=""
IF '$DATA(AG("PLANS",AGPLAN))
SET AGFLG=1
QUIT
End DoDot:2
IF AGFLG
QUIT
+13 SET AGRATE=$PIECE(AGELG2,U,11)
+14 IF +$GET(AGELGEND)'=0
QUIT
+15 IF $DATA(AGELGBEG)
IF AGELGBEG<AGTODT
IF AGELGBEG>AGFRMDT
Begin DoDot:2
+16 DO COUNTY
+17 SET AGCOMM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+18 IF AGCOMM']""
QUIT
+19 SET ^TMP($JOB,AGCOMM,$PIECE(^DPT(DFN,0),U),AGCTY,AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+20 QUIT
CURRENT ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF AGELGDT=""
QUIT
Begin DoDot:1
+3 SET AGELG=$GET(^AUPNMCD(AGIMID,11,AGELGDT,0))
+4 SET AGELGBEG=$PIECE(AGELG,U)
+5 SET AGELGEND=$PIECE(AGELG,U,2)
+6 SET AGCOV=$PIECE(AGELG,U,3)
+7 SET AGELG2=$GET(^AUPNMCD(AGIMID,0))
+8 SET AGPLAN=$PIECE(AGELG2,U,10)
+9 SET AGFLG=0
+10 IF $DATA(AG("PLANS"))
Begin DoDot:2
+11 IF $GET(AGPLAN)=""
IF '$DATA(AG("PLANS","NONE"))
SET AGFLG=1
QUIT
+12 IF $GET(AGPLAN)'=""
IF '$DATA(AG("PLANS",AGPLAN))
SET AGFLG=1
QUIT
End DoDot:2
IF AGFLG
QUIT
+13 SET AGRATE=$PIECE(AGELG2,U,11)
+14 IF AGELGEND>AGTODAY!(+$GET(AGELGEND)=0)
Begin DoDot:2
+15 DO COUNTY
+16 SET AGCOMM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+17 IF AGCOMM']""
QUIT
+18 SET ^TMP($JOB,AGCOMM,$PIECE(^DPT(DFN,0),U),AGCTY,AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+19 QUIT
TERM ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF AGELGDT=""
QUIT
Begin DoDot:1
+3 SET AGELG=$GET(^AUPNMCD(AGIMID,11,AGELGDT,0))
+4 SET AGELGBEG=$PIECE(AGELG,U)
+5 SET AGELGEND=$PIECE(AGELG,U,2)
+6 SET AGCOV=$PIECE(AGELG,U,3)
+7 SET AGELG2=$GET(^AUPNMCD(AGIMID,0))
+8 SET AGPLAN=$PIECE(AGELG2,U,10)
+9 SET AGFLG=0
+10 IF $DATA(AG("PLANS"))
Begin DoDot:2
+11 IF $GET(AGPLAN)=""
IF '$DATA(AG("PLANS","NONE"))
SET AGFLG=1
QUIT
+12 IF $GET(AGPLAN)'=""
IF '$DATA(AG("PLANS",AGPLAN))
SET AGFLG=1
QUIT
End DoDot:2
IF AGFLG
QUIT
+13 SET AGRATE=$PIECE(AGELG2,U,11)
+14 IF +$GET(AGELGEND)=0
QUIT
+15 IF AGELGEND<AGTODT
IF AGELGEND>AGFRMDT
Begin DoDot:2
+16 DO COUNTY
+17 SET AGCOMM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+18 IF AGCOMM']""
QUIT
+19 SET ^TMP($JOB,AGCOMM,$PIECE(^DPT(DFN,0),U),AGCTY,AGST,DFN,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+20 QUIT
B1 IF $Y>AGBM
DO RTRN^AG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO END
DO HDR
+1 WRITE !!
+2 QUIT
DT(DT) ;
+1 IF DT=""
QUIT ""
+2 SET DT1=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"
+3 SET DT1=DT1_$SELECT($EXTRACT(DT,1)=3:20,$EXTRACT(DT,1)=2:19)_$EXTRACT(DT,2,3)
+4 QUIT DT1
COUNTY ;
+1 SET DA=DFN
+2 SET DIC=9000001.51
+3 SET DR=.03
+4 SET AG("DRENT")=0
+5 SET AGCTY=""
+6 DO ^AGDICLK
+7 IF '$DATA(AG("LKERR"))
IF AG("LKDATA")]""
IF $DATA(^AUTTCOM(AG("LKDATA"),0))
Begin DoDot:1
+8 SET AGCTY=$PIECE(^AUTTCOM(AG("LKDATA"),0),U,2)
IF AGCTY']""
QUIT
+9 IF $DATA(^AUTTCTY(AGCTY,0))
SET AGCTY=$PIECE(^AUTTCTY(AGCTY,0),U)
End DoDot:1
+10 QUIT
