- 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
