ABMKIDS ; IHS/SD/SDR - Kidscare Report ;
;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
;IHS/SD/SDR - abm*2.6*1 - HEAT5296 - NEW ROUTINE to report KIDSCARE
;
EN ;
K ^TMP("ABM-KIDS",$J)
K ABMTOT
K DIR,DIC,DIE,DA,X,Y
S DIR(0)="DAO"
S DIR("A")="Enter eligibility date: "
D ^DIR K DIR
Q:X=""
S ABMDT=Y
;
K DIR,DIC,DIE,DA,X,Y
S DIR(0)="YAO"
S DIR("A")="Include detail? "
S DIR("B")="N"
D ^DIR K DIR
Q:X=""
S ABMDET=Y
;
K ABM,ABMY
S ABM("HD",0)="SCHIP ELIGIBILITY COUNTS BY AGE for "_$P($G(^AUTTLOC(DUZ(2),0)),U,2)
S Y=ABMDT
D DD^%DT
S ABM("HD",1)="Eligible on "_Y
S ABM("HD",2)="Report generated by "_$P($G(^VA(200,DUZ,0)),U)
S ABM("PG")=1
S ABMQ("RC")="COMPUTE^ABMKIDS",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
S ABMQ("RP")="WRITE^ABMKIDS"
D ^ABMDRDBQ
;
COMPUTE ;
;medicaid
S ABMTYP="MCD"
S ABMI=0
F S ABMI=$O(^AUPNMCD(ABMI)) Q:'ABMI D
.Q:($P($G(^AUPNMCD(ABMI,0)),U,10)="")
.Q:($P($G(^AUTNINS($P($G(^AUPNMCD(ABMI,0)),U,10),2)),U)'="K") ;Kidscare only
.S ABMIM=0
.F S ABMIM=$O(^AUPNMCD(ABMI,11,ABMIM)) Q:'ABMIM D
..Q:ABMIM>ABMDT ;start date after search date
..;end date and it is before search date
..I $P($G(^AUPNMCD(ABMI,11,ABMIM,0)),U,2)'="",($P($G(^AUPNMCD(ABMI,11,ABMIM,0)),U,2)<ABMDT) Q
..S ABMAGE=$$GET1^DIQ(9000001,$P($G(^AUPNMCD(ABMI,0)),U),1102.99,"")
..D AGE
..D:ABMDET DETAIL
;private
S ABMTYP="PI"
S ABMI=0
F S ABMI=$O(^AUPNPRVT(ABMI)) Q:'ABMI D
.S ABMMIEN=0
.F S ABMMIEN=$O(^AUPNPRVT(ABMI,11,ABMMIEN)) Q:'ABMMIEN D
..S ABMINS=$P($G(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U)
..Q:($P($G(^AUTNINS(ABMINS,2)),U)'="K")
..Q:$P($G(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,6)>ABMDT
..I $P($G(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,7)'="",($P($G(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,7)<ABMDT) Q
..S ABMAGE=$$GET1^DIQ(9000001,ABMI,1102.99,"")
..D AGE
..D:ABMDET DETAIL
Q
AGE ;
I ABMTYP="MCD" D
.S ABMPT=$P($G(^AUPNMCD(ABMI,0)),U)
I ABMTYP="PI" S ABMPT=ABMI
Q:$D(^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP,ABMPT)) ;counted pt once; don't count again
S ABMTOT=+$G(ABMTOT)+1
I ABMAGE<5 S ABM("0-4")=+$G(ABM("0-4"))+1,ABMFLG="0-4" Q
I ABMAGE>4,(ABMAGE<10) S ABM("5-9")=+$G(ABM("5-9"))+1,ABMFLG="5-9" Q
I ABMAGE>9,(ABMAGE<15) S ABM("10-14")=+$G(ABM("10-14"))+1,ABMFLG="10-14" Q
I ABMAGE>14,(ABMAGE<19) S ABM("15-18")=+$G(ABM("15-18"))+1,ABMFLG="15-18" Q
I ABMAGE>18,(ABMAGE<22) S ABM("19-21")=+$G(ABM("19-21"))+1,ABMFLG="19-21" Q
I ABMAGE>21 S ABM("OVER 21")=+$G(ABM("OVER 21"))+1,ABMFLG="OVER 21"
Q
DETAIL ;
S ^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP,ABMPT)=ABMI_"^"_$S(ABMTYP="MCD":ABMIM,1:ABMMIEN)
Q
WRITE ;
D WHD^ABMDRHD
W !,"RANGE",?10,"COUNT"
W !,"0-4",?10,$J(+$G(ABM("0-4")),"6R")
W !,"5-9",?10,$J(+$G(ABM("5-9")),"6R")
W !,"10-14",?10,$J(+$G(ABM("10-14")),"6R")
W !,"15-18",?10,$J(+$G(ABM("15-18")),"6R")
W !,"19-21",?10,$J(+$G(ABM("19-21")),"6R")
W !,"OVER 21",?10,$J(+$G(ABM("OVER 21")),"6R")
W !,"=====",?10,"======"
W !,"TOTAL",?9,$J(+$G(ABMTOT),"7R")
;
I $D(^TMP("ABM-KIDS",$J)) D
.D HD
.S ABMAGE=""
.F S ABMAGE=$O(^TMP("ABM-KIDS",$J,ABMAGE)) Q:ABMAGE="" D
..S ABMTYP=""
..F ABMTYP=$O(^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP)) Q:ABMTYP="" D
...S ABMPT=0
...F S ABMPT=$O(^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP,ABMPT)) Q:'ABMPT D
....S ABMI=$P($G(^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP,ABMPT)),U)
....S ABMMI=$P($G(^TMP("ABM-KIDS",$J,ABMAGE,ABMTYP,ABMPT)),U,2)
....I ABMTYP="MCD" D
.....S ABMPLAN=$P($G(^AUTNINS($P($G(^AUPNMCD(ABMI,0)),U,10),0)),U)
.....S ABMEFFDT=$P($G(^AUPNMCD(ABMI,11,ABMMI,0)),U)
.....S ABMENDDT=$P($G(^AUPNMCD(ABMI,11,ABMMI,0)),U,2)
.....S ABMCTYP=$P($G(^AUPNMCD(ABMI,11,ABMMI,0)),U,3)
....;
....I ABMTYP="PI" D
.....S ABMPLAN=$P($G(^AUTNINS($P($G(^AUPNPRVT(ABMPT,11,ABMMI,0)),U),0)),U)
.....S ABMEFFDT=$P($G(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,6)
.....S ABMCTYP="",ABMPH=""
.....S ABMPH=$P($G(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,8)
.....S:ABMPH'=""&($P($G(^AUPN3PPH(ABMPH,0)),U,5)'="") ABMCTYP=$P($G(^AUTTPIC($P($G(^AUPN3PPH(ABMPH,0)),U,5),0)),U,3)
.....S ABMENDDT=$P($G(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,7)
....;
....W !,ABMAGE
....W ?4,$P($G(^AUPNPAT(ABMPT,41,DUZ(2),0)),U,2)
....W ?11,$E($P($G(^DPT(ABMPT,0)),U),1,29)
....W ?42,$E(ABMTYP,1)
....W ?44,$E(ABMPLAN,1,14)
....W ?60,$$SDTO^ABMDUTL(ABMEFFDT)
....W ?69,ABMCTYP
....W ?74,$$SDTO^ABMDUTL(ABMENDDT)
....I $Y>(IOSL-5) D WHD^ABMDRHD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D HD W " (cont)"
Q
HD ;
S ABM("PG")=+ABM("PG")+1
W !!,"AGE",?4,"PT HRN",?11,"PT NAME",?42,"I",?44,"PLAN NAME",?60,"EFF DT",?69,"CTYP",?74,"END DT"
Q
ABMKIDS ; IHS/SD/SDR - Kidscare Report ;
+1 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
+2 ;IHS/SD/SDR - abm*2.6*1 - HEAT5296 - NEW ROUTINE to report KIDSCARE
+3 ;
EN ;
+1 KILL ^TMP("ABM-KIDS",$JOB)
+2 KILL ABMTOT
+3 KILL DIR,DIC,DIE,DA,X,Y
+4 SET DIR(0)="DAO"
+5 SET DIR("A")="Enter eligibility date: "
+6 DO ^DIR
KILL DIR
+7 IF X=""
QUIT
+8 SET ABMDT=Y
+9 ;
+10 KILL DIR,DIC,DIE,DA,X,Y
+11 SET DIR(0)="YAO"
+12 SET DIR("A")="Include detail? "
+13 SET DIR("B")="N"
+14 DO ^DIR
KILL DIR
+15 IF X=""
QUIT
+16 SET ABMDET=Y
+17 ;
+18 KILL ABM,ABMY
+19 SET ABM("HD",0)="SCHIP ELIGIBILITY COUNTS BY AGE for "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+20 SET Y=ABMDT
+21 DO DD^%DT
+22 SET ABM("HD",1)="Eligible on "_Y
+23 SET ABM("HD",2)="Report generated by "_$PIECE($GET(^VA(200,DUZ,0)),U)
+24 SET ABM("PG")=1
+25 SET ABMQ("RC")="COMPUTE^ABMKIDS"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
+26 SET ABMQ("RP")="WRITE^ABMKIDS"
+27 DO ^ABMDRDBQ
+28 ;
COMPUTE ;
+1 ;medicaid
+2 SET ABMTYP="MCD"
+3 SET ABMI=0
+4 FOR
SET ABMI=$ORDER(^AUPNMCD(ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+5 IF ($PIECE($GET(^AUPNMCD(ABMI,0)),U,10)="")
QUIT
+6 ;Kidscare only
IF ($PIECE($GET(^AUTNINS($PIECE($GET(^AUPNMCD(ABMI,0)),U,10),2)),U)'="K")
QUIT
+7 SET ABMIM=0
+8 FOR
SET ABMIM=$ORDER(^AUPNMCD(ABMI,11,ABMIM))
IF 'ABMIM
QUIT
Begin DoDot:2
+9 ;start date after search date
IF ABMIM>ABMDT
QUIT
+10 ;end date and it is before search date
+11 IF $PIECE($GET(^AUPNMCD(ABMI,11,ABMIM,0)),U,2)'=""
IF ($PIECE($GET(^AUPNMCD(ABMI,11,ABMIM,0)),U,2)<ABMDT)
QUIT
+12 SET ABMAGE=$$GET1^DIQ(9000001,$PIECE($GET(^AUPNMCD(ABMI,0)),U),1102.99,"")
+13 DO AGE
+14 IF ABMDET
DO DETAIL
End DoDot:2
End DoDot:1
+15 ;private
+16 SET ABMTYP="PI"
+17 SET ABMI=0
+18 FOR
SET ABMI=$ORDER(^AUPNPRVT(ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+19 SET ABMMIEN=0
+20 FOR
SET ABMMIEN=$ORDER(^AUPNPRVT(ABMI,11,ABMMIEN))
IF 'ABMMIEN
QUIT
Begin DoDot:2
+21 SET ABMINS=$PIECE($GET(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U)
+22 IF ($PIECE($GET(^AUTNINS(ABMINS,2)),U)'="K")
QUIT
+23 IF $PIECE($GET(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,6)>ABMDT
QUIT
+24 IF $PIECE($GET(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,7)'=""
IF ($PIECE($GET(^AUPNPRVT(ABMI,11,ABMMIEN,0)),U,7)<ABMDT)
QUIT
+25 SET ABMAGE=$$GET1^DIQ(9000001,ABMI,1102.99,"")
+26 DO AGE
+27 IF ABMDET
DO DETAIL
End DoDot:2
End DoDot:1
+28 QUIT
AGE ;
+1 IF ABMTYP="MCD"
Begin DoDot:1
+2 SET ABMPT=$PIECE($GET(^AUPNMCD(ABMI,0)),U)
End DoDot:1
+3 IF ABMTYP="PI"
SET ABMPT=ABMI
+4 ;counted pt once; don't count again
IF $DATA(^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP,ABMPT))
QUIT
+5 SET ABMTOT=+$GET(ABMTOT)+1
+6 IF ABMAGE<5
SET ABM("0-4")=+$GET(ABM("0-4"))+1
SET ABMFLG="0-4"
QUIT
+7 IF ABMAGE>4
IF (ABMAGE<10)
SET ABM("5-9")=+$GET(ABM("5-9"))+1
SET ABMFLG="5-9"
QUIT
+8 IF ABMAGE>9
IF (ABMAGE<15)
SET ABM("10-14")=+$GET(ABM("10-14"))+1
SET ABMFLG="10-14"
QUIT
+9 IF ABMAGE>14
IF (ABMAGE<19)
SET ABM("15-18")=+$GET(ABM("15-18"))+1
SET ABMFLG="15-18"
QUIT
+10 IF ABMAGE>18
IF (ABMAGE<22)
SET ABM("19-21")=+$GET(ABM("19-21"))+1
SET ABMFLG="19-21"
QUIT
+11 IF ABMAGE>21
SET ABM("OVER 21")=+$GET(ABM("OVER 21"))+1
SET ABMFLG="OVER 21"
+12 QUIT
DETAIL ;
+1 SET ^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP,ABMPT)=ABMI_"^"_$SELECT(ABMTYP="MCD":ABMIM,1:ABMMIEN)
+2 QUIT
WRITE ;
+1 DO WHD^ABMDRHD
+2 WRITE !,"RANGE",?10,"COUNT"
+3 WRITE !,"0-4",?10,$JUSTIFY(+$GET(ABM("0-4")),"6R")
+4 WRITE !,"5-9",?10,$JUSTIFY(+$GET(ABM("5-9")),"6R")
+5 WRITE !,"10-14",?10,$JUSTIFY(+$GET(ABM("10-14")),"6R")
+6 WRITE !,"15-18",?10,$JUSTIFY(+$GET(ABM("15-18")),"6R")
+7 WRITE !,"19-21",?10,$JUSTIFY(+$GET(ABM("19-21")),"6R")
+8 WRITE !,"OVER 21",?10,$JUSTIFY(+$GET(ABM("OVER 21")),"6R")
+9 WRITE !,"=====",?10,"======"
+10 WRITE !,"TOTAL",?9,$JUSTIFY(+$GET(ABMTOT),"7R")
+11 ;
+12 IF $DATA(^TMP("ABM-KIDS",$JOB))
Begin DoDot:1
+13 DO HD
+14 SET ABMAGE=""
+15 FOR
SET ABMAGE=$ORDER(^TMP("ABM-KIDS",$JOB,ABMAGE))
IF ABMAGE=""
QUIT
Begin DoDot:2
+16 SET ABMTYP=""
+17 FOR ABMTYP=$ORDER(^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP))
IF ABMTYP=""
QUIT
Begin DoDot:3
+18 SET ABMPT=0
+19 FOR
SET ABMPT=$ORDER(^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP,ABMPT))
IF 'ABMPT
QUIT
Begin DoDot:4
+20 SET ABMI=$PIECE($GET(^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP,ABMPT)),U)
+21 SET ABMMI=$PIECE($GET(^TMP("ABM-KIDS",$JOB,ABMAGE,ABMTYP,ABMPT)),U,2)
+22 IF ABMTYP="MCD"
Begin DoDot:5
+23 SET ABMPLAN=$PIECE($GET(^AUTNINS($PIECE($GET(^AUPNMCD(ABMI,0)),U,10),0)),U)
+24 SET ABMEFFDT=$PIECE($GET(^AUPNMCD(ABMI,11,ABMMI,0)),U)
+25 SET ABMENDDT=$PIECE($GET(^AUPNMCD(ABMI,11,ABMMI,0)),U,2)
+26 SET ABMCTYP=$PIECE($GET(^AUPNMCD(ABMI,11,ABMMI,0)),U,3)
End DoDot:5
+27 ;
+28 IF ABMTYP="PI"
Begin DoDot:5
+29 SET ABMPLAN=$PIECE($GET(^AUTNINS($PIECE($GET(^AUPNPRVT(ABMPT,11,ABMMI,0)),U),0)),U)
+30 SET ABMEFFDT=$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,6)
+31 SET ABMCTYP=""
SET ABMPH=""
+32 SET ABMPH=$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,8)
+33 IF ABMPH'=""&($PIECE($GET(^AUPN3PPH(ABMPH,0)),U,5)'="")
SET ABMCTYP=$PIECE($GET(^AUTTPIC($PIECE($GET(^AUPN3PPH(ABMPH,0)),U,5),0)),U,3)
+34 SET ABMENDDT=$PIECE($GET(^AUPNPRVT(ABMPT,11,ABMMI,0)),U,7)
End DoDot:5
+35 ;
+36 WRITE !,ABMAGE
+37 WRITE ?4,$PIECE($GET(^AUPNPAT(ABMPT,41,DUZ(2),0)),U,2)
+38 WRITE ?11,$EXTRACT($PIECE($GET(^DPT(ABMPT,0)),U),1,29)
+39 WRITE ?42,$EXTRACT(ABMTYP,1)
+40 WRITE ?44,$EXTRACT(ABMPLAN,1,14)
+41 WRITE ?60,$$SDTO^ABMDUTL(ABMEFFDT)
+42 WRITE ?69,ABMCTYP
+43 WRITE ?74,$$SDTO^ABMDUTL(ABMENDDT)
+44 IF $Y>(IOSL-5)
DO WHD^ABMDRHD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
DO HD
WRITE " (cont)"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+45 QUIT
HD ;
+1 SET ABM("PG")=+ABM("PG")+1
+2 WRITE !!,"AGE",?4,"PT HRN",?11,"PT NAME",?42,"I",?44,"PLAN NAME",?60,"EFF DT",?69,"CTYP",?74,"END DT"
+3 QUIT
