AGMCDP ;IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS ;
;;7.1;PATIENT REGISTRATION;**4,12**;AUG 25,2005;Build 1
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;
;Modified so you could 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 ;get today's date
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^AGMCDP"
S ZTUCI=Y,ZTIO=""
S ZTDESC="MCAID Accounts by Name 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 (AGNM,DFN,AGEND)=""
F S AGNM=$O(^TMP($J,AGNM)) Q:AGNM="" D Q:AGEND
.S DFN=0
.W !,$E(AGNM,1,30)
.F S DFN=$O(^TMP($J,AGNM,DFN)) Q:DFN="" D Q:AGEND
..I AGACCTS="T" W ?30,$P($G(^DPT(DFN,.13)),U)
..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)
...W ?45 W:$D(^AUPNPAT(DFN,41,DUZ(2),0)) $P(^(0),U,2) W ?55,AGCTY
...S AGMID=""
...S AGST=""
...F S AGST=$O(^TMP($J,AGNM,DFN,AGST)) Q:AGST="" D
....W ?77,$P(^DIC(5,AGST,0),U,2) ;STATE ABBREV.
....F S AGMID=$O(^TMP($J,AGNM,DFN,AGST,AGMID)) Q:AGMID="" D
.....S AGELGBEG=""
.....F S AGELGBEG=$O(^TMP($J,AGNM,DFN,AGST,AGMID,AGELGBEG)) Q:AGELGBEG="" D
......S AGREC=$G(^TMP($J,AGNM,DFN,AGST,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
...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"),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 PATIENT NAME"
.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!(AGELGDT="") D
.S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))
.S AGELGBEG=$P(AGELG,U)
.Q:AGELGBEG=""
.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)
.S ^TMP($J,$P(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
Q
OPEN ;
S AGELGDT=0
F S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:'AGELGDT!(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 $D(AGELGBEG),AGELGBEG<AGTODT,AGELGBEG>AGFRMDT D
..S ^TMP($J,$P(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
Q
CURRENT ;
S AGELGDT=0
F S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:'AGELGDT!(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
..S ^TMP($J,$P(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
Q
TERM ;
S AGELGDT=0
F S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:'AGELGDT!(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
..S ^TMP($J,$P(^DPT(DFN,0),U),DFN,AGST,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) ;AG*7.1*6 IM30200 BAD USE OF SELECT
S Y=DT X ^DD("DD") S DT1=$P(Y,"@")
Q DT1
AGMCDP ;IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS ;
+1 ;;7.1;PATIENT REGISTRATION;**4,12**;AUG 25,2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+3 ;
+4 ;Modified so you could 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 ;get today's date
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 ;
+1 SET %ZIS="OPQ"
DO ^%ZIS
IF POP
SET IOP=ION
DO ^%ZIS
QUIT
+2 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
+3 XECUTE ^%ZOSF("UCI")
+4 SET ZTRTN="START^AGMCDP"
+5 SET ZTUCI=Y
SET ZTIO=""
+6 SET ZTDESC="MCAID Accounts by Name for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."
+7 SET AGQIO=IO
FOR G="AGQIO"
SET ZTSAVE(G)=""
+8 SET ZTSAVE("AG*")=""
+9 DO ^%ZTLOAD
+10 IF '$DATA(ZTSK)
GOTO DEV
+11 KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI
+12 DO ^%ZISC
+13 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 (AGNM,DFN,AGEND)=""
+11 FOR
SET AGNM=$ORDER(^TMP($JOB,AGNM))
IF AGNM=""
QUIT
Begin DoDot:1
+12 SET DFN=0
+13 WRITE !,$EXTRACT(AGNM,1,30)
+14 FOR
SET DFN=$ORDER(^TMP($JOB,AGNM,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+15 IF AGACCTS="T"
WRITE ?30,$PIECE($GET(^DPT(DFN,.13)),U)
+16 SET DA=DFN
+17 SET DIC=9000001.51
+18 SET DR=.03
+19 SET AG("DRENT")=0
+20 SET AGCTY=""
+21 DO ^AGDICLK
+22 IF '$DATA(AG("LKERR"))
IF AG("LKDATA")]""
IF $DATA(^AUTTCOM(AG("LKDATA"),0))
Begin DoDot:3
+23 SET AGCP=$PIECE(^AUTTCOM(AG("LKDATA"),0),U,2)
+24 IF AGCP
IF $DATA(^AUTTCTY(AGCP,0))
SET AGCTY=$EXTRACT($PIECE(^(0),U),1,12)
+25 WRITE ?45
IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))
WRITE $PIECE(^(0),U,2)
WRITE ?55,AGCTY
+26 SET AGMID=""
+27 SET AGST=""
+28 FOR
SET AGST=$ORDER(^TMP($JOB,AGNM,DFN,AGST))
IF AGST=""
QUIT
Begin DoDot:4
+29 ;STATE ABBREV.
WRITE ?77,$PIECE(^DIC(5,AGST,0),U,2)
+30 FOR
SET AGMID=$ORDER(^TMP($JOB,AGNM,DFN,AGST,AGMID))
IF AGMID=""
QUIT
Begin DoDot:5
+31 SET AGELGBEG=""
+32 FOR
SET AGELGBEG=$ORDER(^TMP($JOB,AGNM,DFN,AGST,AGMID,AGELGBEG))
IF AGELGBEG=""
QUIT
Begin DoDot:6
+33 SET AGREC=$GET(^TMP($JOB,AGNM,DFN,AGST,AGMID,AGELGBEG))
+34 SET (AGELGBG1,AGELGED1,AGPLAN,AGRATE,AGCOV)=""
+35 SET AGELGBG1=$$DT(AGELGBEG)
+36 SET AGELGED1=$$DT($PIECE(AGREC,U))
+37 SET AGPLAN=$PIECE(AGREC,U,2)
+38 IF $GET(AGPLAN)'=""
SET AGPLAN=$EXTRACT($PIECE($GET(^AUTNINS(AGPLAN,0)),U),1,22)
+39 SET AGRATE=$PIECE(AGREC,U,3)
+40 SET AGCOV=$PIECE(AGREC,U,4)
+41 WRITE !,?3,AGPLAN,?26,AGELGBG1,?37,$EXTRACT(AGMID,1,20),?50,AGELGED1,?61,AGRATE,?71,AGCOV
End DoDot:6
End DoDot:5
+42 WRITE !
End DoDot:4
+43 FOR A=1:1:80
WRITE "-"
+44 SET AGTOT=AGTOT+1
+45 IF $Y>AGBM
Begin DoDot:4
+46 DO RTRN^AG
+47 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
SET AGEND=1
GOTO END
+48 DO HDR
End DoDot:4
End DoDot:3
End DoDot:2
IF AGEND
QUIT
End DoDot:1
IF AGEND
QUIT
+49 QUIT
END ;
+1 WRITE !!!,"TOTAL MEDICAID PATIENTS: ",AGTOT
KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
+2 DO ^%ZISC
+3 KILL ^TMP($JOB),AG,AGBM,AGIO,AGTIME,AGCP,AGCTY,DA,DFN,DIC,DR,G,AGL,I
+4 KILL AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),AGNM,AGNUM,AGPCC
+5 KILL AGPGPG,AGPT,AGST,AGTOT,AGUCI,AG("USR"),AG("USRLOC"),Y
+6 IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+7 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 PATIENT NAME"
+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!(AGELGDT="")
QUIT
Begin DoDot:1
+3 SET AGELG=$GET(^AUPNMCD(AGIMID,11,AGELGDT,0))
+4 SET AGELGBEG=$PIECE(AGELG,U)
+5 IF AGELGBEG=""
QUIT
+6 SET AGELGEND=$PIECE(AGELG,U,2)
+7 SET AGCOV=$PIECE(AGELG,U,3)
+8 SET AGELG2=$GET(^AUPNMCD(AGIMID,0))
+9 SET AGPLAN=$PIECE(AGELG2,U,10)
+10 SET AGFLG=0
+11 IF $DATA(AG("PLANS"))
Begin DoDot:2
+12 IF $GET(AGPLAN)=""
IF '$DATA(AG("PLANS","NONE"))
SET AGFLG=1
QUIT
+13 IF $GET(AGPLAN)'=""
IF '$DATA(AG("PLANS",AGPLAN))
SET AGFLG=1
QUIT
End DoDot:2
IF AGFLG
QUIT
+14 SET AGRATE=$PIECE(AGELG2,U,11)
+15 SET ^TMP($JOB,$PIECE(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:1
+16 QUIT
OPEN ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF 'AGELGDT!(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 $DATA(AGELGBEG)
IF AGELGBEG<AGTODT
IF AGELGBEG>AGFRMDT
Begin DoDot:2
+15 SET ^TMP($JOB,$PIECE(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+16 QUIT
CURRENT ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF 'AGELGDT!(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 SET ^TMP($JOB,$PIECE(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+16 QUIT
TERM ;
+1 SET AGELGDT=0
+2 FOR
SET AGELGDT=$ORDER(^AUPNMCD(AGIMID,11,AGELGDT))
IF 'AGELGDT!(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 SET ^TMP($JOB,$PIECE(^DPT(DFN,0),U),DFN,AGST,AGMID,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
End DoDot:2
End DoDot:1
+17 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 ;S DT1=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"
+3 ;S DT1=DT1_$S($E(DT,1)=3:20,$E(DT,1)=2:19)_$E(DT,2,3) ;AG*7.1*6 IM30200 BAD USE OF SELECT
+4 SET Y=DT
XECUTE ^DD("DD")
SET DT1=$PIECE(Y,"@")
+5 QUIT DT1
