ABMM2ELG ;IHS/SD/SDR - Meaningful Use Report - count patients/eligibility ;
;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
;
W !!,"The date range selected will be used for: "
W !,?3,"1. Was the patient's record active during that range"
W !,?3,"2. Did the patient have eligibility in that range"
W !,?3,"3. How many encounters they had during that time"
W !!,"Detail information will be supplied for validation purposes but once validated"
W !,"the summary option should be used."
;
K ABMY,ABMP
K ^TMP($J,"ABM-M2RPT")
DT ;
W !!," ============ Entry of Date Range =============",!
D ^XBFMK
S DIR("A")="Enter STARTING Date"
S DIR(0)="DO^::EP"
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING Date"
D ^DIR
K DIR
G DT:$D(DIRUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
RTYPE ;summary or detail?
W !
K DIC,DIE,DIR,X,Y,DA
S DIR(0)="S^S:SUMMARY;D:DETAIL (will include Summary)"
S DIR("A")="SUMMARY OR DETAIL"
S DIR("B")="SUMMARY"
D ^DIR K DIR
S ABMSUMDT=Y
;D GETPTS
;D GETELIG
;D GETVSTS
;
SEL ;
; Select device
I ABMSUMDT="D" D
.W !!,"There will be two outputs, one for SUMMARY and one for DETAIL."
.W !,"The first one should be a terminal or a printer."
.W !,"The second forces an HFS file because it could be a large file",!
S %ZIS="NQ"
S %ZIS("A")="Enter DEVICE: "
D ^%ZIS Q:POP
U IO(0) W !!,"Searching...."
I IO=IO(0) D TOTALS S DIR(0)="E" D ^DIR K DIR
I IO'=IO(0) D QUE^ABMM2ELG,HOME^%ZIS S DIR(0)="E" D ^DIR K DIR Q
I $D(IO("S")) S IOP=ION D ^%ZIS
D ^%ZISC
D HOME^%ZIS
;
I ABMSUMDT="D" D
.W !!,"Will now write detail to file",!!
.D ^XBFMK
.S DIR(0)="F"
.S DIR("A")="Enter Path"
.S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
.D ^DIR K DIR
.Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABMPATH=Y
.S DIR(0)="F",DIR("A")="Enter File Name"
.D ^DIR K DIR
.Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABMFN=Y
.W !!,"Creating file..."
.D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
.Q:POP
.U IO
.D WRTPTS
.D WRTELIG
.D WRTVSTS
.D CLOSE^%ZISH("ABM")
.W "DONE"
XIT ;
K ^TMP($J,"ABM-M2RPT")
K ABMP,ABMY,ABMPTINA,ABMPT,ABMMFLG
Q
QUE ;QUE TO TASKMAN
S ZTRTN="TOTALS^ABMM2ELG"
S ZTDESC="3P MEANINGFUL USE ELIGIBILITY REPORT"
S ZTSAVE("ABM*")=""
K ZTSK
D ^%ZTLOAD
W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
Q
GETPTS ;
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^AUPNPAT(ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I $D(^AUPNPAT(ABMP("PDFN"),41,DUZ(2))) D
..S ABMPTINA=$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3) ;date inactive/deleted
..I ABMPTINA'=""&((ABMPTINA<ABMY("DT",1))!(ABMPTINA>ABMY("DT",2))) Q ;patient inactive prior to or after range of report
..S ^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))=""
..S ^TMP($J,"ABM-M2RPT","CNT","PTS")=+$G(^TMP($J,"ABM-M2RPT","CNT","PTS"))+1 ;count patients
Q
;
GETELIG ;
;medicaid
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I $D(^AUPNMCD("B",ABMP("PDFN"))) D ;patient has medicaid entry
..S ABMP("MDFN")=0
..F S ABMP("MDFN")=$O(^AUPNMCD("B",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN") D
...S ABMP("EFFDT")=0,ABMMFLG=0
...F S ABMP("EFFDT")=$O(^AUPNMCD(ABMP("MDFN"),11,ABMP("EFFDT"))) Q:'ABMP("EFFDT") D Q:(ABMMFLG=1)
....S ABMP("ENDDT")=$P($G(^AUPNMCD(ABMP("MDFN"),11,ABMP("EFFDT"),0)),U,2) ;end date
....;effective date after end of range or end date before start of range
....I (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1))) Q
....S ABMMFLG=1 ;if it gets here patient has eligibility in our window
...I ABMMFLG=1 D ;patient has at least one entry that's what we want
....S ^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN"))=""
....S ^TMP($J,"ABM-M2RPT","CNT","MCD")=+$G(^TMP($J,"ABM-M2RPT","CNT","MCD"))+1 ;count medicaid patients
;
;medicare
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I $D(^AUPNMCR(ABMP("PDFN"))) D ;patient had medicare entry
..S ABMP("MDFN")=0,ABMMFLG=0
..F S ABMP("MDFN")=$O(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN"))) Q:'ABMP("MDFN") D Q:(ABMMFLG=1)
...S ABMP("EFFDT")=$P($G(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN"),0)),U) ;effective date
...S ABMP("ENDDT")=$P($G(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,2) ;end date
...;effective date after end of range or end date before start of range
...I (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1))) Q
...S ABMMFLG=1 ;if it gets here patient has eligibility in our window
..I ABMMFLG=1 D ;patient has at least one entry that's what we want
...S ^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN"))=""
...S ^TMP($J,"ABM-M2RPT","CNT","MCR")=+$G(^TMP($J,"ABM-M2RPT","CNT","MCR"))+1 ;count medicare patients
;
;railroad
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I $D(^AUPNRRE(ABMP("PDFN"))) D ;patient had medicare entry
..S ABMP("MDFN")=0,ABMMFLG=0
..F S ABMP("MDFN")=$O(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN"))) Q:'ABMP("MDFN") D Q:(ABMMFLG=1)
...S ABMP("EFFDT")=$P($G(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN"),0)),U) ;effective date
...S ABMP("ENDDT")=$P($G(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,2) ;end date
...;effective date after end of range or end date before start of range
...I (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1))) Q
...S ABMMFLG=1 ;if it gets here patient has eligibility in our window
..I ABMMFLG=1 D ;patient has at least one entry that's what we want
...S ^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN"))=""
...S ^TMP($J,"ABM-M2RPT","CNT","RR")=+$G(^TMP($J,"ABM-M2RPT","CNT","RR"))+1 ;count railroad patients
;
;private
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I $D(^AUPNPRVT(ABMP("PDFN"))) D ;patient has private entry
..S ABMP("MDFN")=0,ABMMFLG=0
..F S ABMP("MDFN")=$O(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"))) Q:'ABMP("MDFN") D Q:(ABMMFLG=1)
...S ABMP("EFFDT")=$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,6) ;effective date
...S ABMP("ENDDT")=$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,7) ;end date
...;effective date after end of range or end date before start of range
...I (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1))) Q
...S ABMMFLG=1 ;if it gets here patient has eligibility in our window
..I ABMMFLG=1 D ;patient has at least one entry that's what we want
...S ^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN"))=""
...S ^TMP($J,"ABM-M2RPT","CNT","PI")=+$G(^TMP($J,"ABM-M2RPT","CNT","PI"))+1 ;count private patients
;
;no insurance
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.I '$D(^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN")))&'$D(^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN")))&'$D(^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN")))&'$D(^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"))) D
..S ^TMP($J,"ABM-M2RPT","CNT","NO")=+$G(^TMP($J,"ABM-M2RPT","CNT","NO"))+1 ;count no insurance patients
..S ^TMP($J,"ABM-M2RPT","NO",ABMP("PDFN"))=""
;
Q
;
GETVSTS ;
S ABMP("SDT")=ABMY("DT",1)-.5
S ABMP("EDT")=ABMY("DT",2)+.999999
F S ABMP("SDT")=$O(^AUPNVSIT("B",ABMP("SDT"))) Q:('ABMP("SDT")!(ABMP("SDT")>ABMP("EDT"))) D
.S ABMP("VDFN")=0
.F S ABMP("VDFN")=$O(^AUPNVSIT("B",ABMP("SDT"),ABMP("VDFN"))) Q:'ABMP("VDFN") D
..S ABMPT=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5) ;patient
..Q:ABMPT="" ;no patient on visit
..I '$D(^TMP($J,"ABM-M2RPT","PTS",ABMPT)) Q ;not one of our patients
..S ^TMP($J,"ABM-M2RPT","ENC",ABMP("VDFN"))=""
..S ^TMP($J,"ABM-M2RPT","CNT","ENC")=+$G(^TMP($J,"ABM-M2RPT","CNT","ENC"))+1 ;count encounters
..I '$D(^TMP($J,"ABM-M2RPT","UNQ",ABMPT)) D
...S ^TMP($J,"ABM-M2RPT","UNQ",ABMPT)=""
...S ^TMP($J,"ABM-M2RPT","CNT","UNQ")=+$G(^TMP($J,"ABM-M2RPT","CNT","UNQ"))+1 ;count unique patients
Q
;
TOTALS ;
;Practice Demographics
;# of Patient
;Encounters/Year
;# of Unique Patients/Year
S ABM("HD",0)="Meaningful Use Eligibility Report"
S ABM("PG")=1
D GETPTS
D GETELIG
D GETVSTS
D WHD
W !!,"Practice Demographics"
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")),7)_" Patients"
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","ENC")),7)_" Encounters"
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","UNQ")),7)_" Unique Patients"
;
;Patient Demographics
;% of Patients on Medicaid
;% of Patients on Medicare
;% of Patients on Private Insurance
;% of Patients Uninsured
;% of Patients on Managed Care
I +$G(^TMP($J,"ABM-M2RPT","CNT","PTS"))=0 W !!,"(REPORT COMPLETE)" Q ;no patients found so it cause a DIVIDE error if we continue
W !!,"Patient Demographics"
;medicaid
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","MCD")),7)_" Patients with Medicaid ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","MCD"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;medicare
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","MCR")),7)_" Patients with Medicare ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","MCR"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;railroad
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","RR")),7)_" Patients with Railroad ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","RR"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;private
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","PI")),7)_" Patients with Private ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","PI"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;no eligibility
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","NO")),7)_" Patients Uninsured ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","NO"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;start new code abm*2.6*11 VMBP#9 RQMT_103
;vmbp
W !?2,$J(+$G(^TMP($J,"ABM-M2RPT","CNT","VMBP")),7)_" Patients with VA Med B ( "_$J($FN((+$G(^TMP($J,"ABM-M2RPT","CNT","VMBP"))/(+$G(^TMP($J,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
;end new code VMBP#9 RQMT_103
W !!,"(REPORT COMPLETE)"
Q
;
WRTPTS ;^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))
W !!!,"PATIENTS PATIENTS PATIENTS PATIENTS PATIENTS"
W !?3,"PDFN",?15,"NAME",?50,"HRN",?60,"DATE INACTIVE"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2),?60,$$SDT^ABMDUTL($P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3))
;
;^TMP($J,"ABM-M2RPT","UNQ",ABMPT)
W !!!,"UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS"
W !?3,"PDFN",?15,"NAME",?50,"HRN"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","UNQ",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)
Q
;
WRTELIG ;
;^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN"))
W !!!,"MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID "
W !?3,"PDFN",?15,"NAME",?50,"MCD#",?62,"PLAN"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.S ABMP("MDFN")=0
.F S ABMP("MDFN")=$O(^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN") D
..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,3),?62,$P($G(^AUPNMCD(ABMP("MDFN"),0)),U,10)
;
;^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN"))
W !!!,"MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE "
W !?3,"PDFN",?15,"NAME",?50,"MCR#"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.S ABMP("MDFN")=0
.F S ABMP("MDFN")=$O(^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN") D
..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNMCR(ABMP("PDFN"),0)),U,3)
;
;^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN"))
W !!!,"RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD "
W !?3,"PDFN",?15,"NAME",?50,"RR#"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.S ABMP("MDFN")=0
.F S ABMP("MDFN")=$O(^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN") D
..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3)
;
;start new code abm*2.6*11 VMBP#9 RQMT_103
;^TMP($J,"ABM-M2RPT","VMBP",ABMP("PDFN"),ABMP("MDFN"))
W !!!,"VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP "
W !?3,"PDFN",?15,"NAME",?50,"HRN"
;end new code VMBP#9 RQMT_103
;
;^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN"))
W !!!,"PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE "
W !?3,"PDFN",?15,"NAME",?50,"INS",?62,"MEM#"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.S ABMP("MDFN")=0
.F S ABMP("MDFN")=$O(^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN"))) Q:'ABMP("MDFN") D
..W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U),?50,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),?62,$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)
;
;^TMP($J,"ABM-M2RPT","NO",ABMP("PDFN"))
W !!!,"NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED "
W !?3,"PDFN",?15,"NAME"
S ABMP("PDFN")=0
F S ABMP("PDFN")=$O(^TMP($J,"ABM-M2RPT","NO",ABMP("PDFN"))) Q:'ABMP("PDFN") D
.W !?3,ABMP("PDFN"),?15,$P($G(^DPT(ABMP("PDFN"),0)),U)
Q
;
WRTVSTS ;^TMP($J,"ABM-M2RPT","ENC",ABMP("VDFN"))
W !!!,"VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS "
W !?3,"VDFN",?13,"VISIT",?30,"PDFN",?40,"PATIENT"
S ABMP("VDFN")=0
F S ABMP("VDFN")=$O(^TMP($J,"ABM-M2RPT","ENC",ABMP("VDFN"))) Q:'ABMP("VDFN") D
.W !?3,ABMP("VDFN"),?13,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U),?30,$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?40,$P($G(^DPT($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)
Q
WHD ;EP for writing Report Header
W $$EN^ABMVDF("IOF"),!
K ABM("LINE") S $P(ABM("LINE"),"=",$S($D(ABM(132)):132,1:80))="" W ABM("LINE"),!
D NOW^%DTC ;abm*2.6*1 NO HEAT
W ABM("HD",0),?$S($D(ABM(132)):103,1:48) S Y=% X ^DD("DD") W Y," Page ",ABM("PG")
S ABM("HD",1)="For date range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2))
W:$G(ABM("HD",1))]"" !,ABM("HD",1)
W:$G(ABM("HD",2))]"" !,ABM("HD",2)
W !,"Billing Location: ",$P($G(^AUTTLOC(DUZ(2),0)),U,2)
W !,ABM("LINE") K ABM("LINE")
Q
ABMM2ELG ;IHS/SD/SDR - Meaningful Use Report - count patients/eligibility ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
+2 ;
+3 WRITE !!,"The date range selected will be used for: "
+4 WRITE !,?3,"1. Was the patient's record active during that range"
+5 WRITE !,?3,"2. Did the patient have eligibility in that range"
+6 WRITE !,?3,"3. How many encounters they had during that time"
+7 WRITE !!,"Detail information will be supplied for validation purposes but once validated"
+8 WRITE !,"the summary option should be used."
+9 ;
+10 KILL ABMY,ABMP
+11 KILL ^TMP($JOB,"ABM-M2RPT")
DT ;
+1 WRITE !!," ============ Entry of Date Range =============",!
+2 DO ^XBFMK
+3 SET DIR("A")="Enter STARTING Date"
+4 SET DIR(0)="DO^::EP"
+5 DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET ABMY("DT",1)=Y
+8 WRITE !
+9 SET DIR("A")="Enter ENDING Date"
+10 DO ^DIR
+11 KILL DIR
+12 IF $DATA(DIRUT)
GOTO DT
+13 SET ABMY("DT",2)=Y
+14 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DT
RTYPE ;summary or detail?
+1 WRITE !
+2 KILL DIC,DIE,DIR,X,Y,DA
+3 SET DIR(0)="S^S:SUMMARY;D:DETAIL (will include Summary)"
+4 SET DIR("A")="SUMMARY OR DETAIL"
+5 SET DIR("B")="SUMMARY"
+6 DO ^DIR
KILL DIR
+7 SET ABMSUMDT=Y
+8 ;D GETPTS
+9 ;D GETELIG
+10 ;D GETVSTS
+11 ;
SEL ;
+1 ; Select device
+2 IF ABMSUMDT="D"
Begin DoDot:1
+3 WRITE !!,"There will be two outputs, one for SUMMARY and one for DETAIL."
+4 WRITE !,"The first one should be a terminal or a printer."
+5 WRITE !,"The second forces an HFS file because it could be a large file",!
End DoDot:1
+6 SET %ZIS="NQ"
+7 SET %ZIS("A")="Enter DEVICE: "
+8 DO ^%ZIS
IF POP
QUIT
+9 USE IO(0)
WRITE !!,"Searching...."
+10 IF IO=IO(0)
DO TOTALS
SET DIR(0)="E"
DO ^DIR
KILL DIR
+11 IF IO'=IO(0)
DO QUE^ABMM2ELG
DO HOME^%ZIS
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+12 IF $DATA(IO("S"))
SET IOP=ION
DO ^%ZIS
+13 DO ^%ZISC
+14 DO HOME^%ZIS
+15 ;
+16 IF ABMSUMDT="D"
Begin DoDot:1
+17 WRITE !!,"Will now write detail to file",!!
+18 DO ^XBFMK
+19 SET DIR(0)="F"
+20 SET DIR("A")="Enter Path"
+21 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+22 DO ^DIR
KILL DIR
+23 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+24 SET ABMPATH=Y
+25 SET DIR(0)="F"
SET DIR("A")="Enter File Name"
+26 DO ^DIR
KILL DIR
+27 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+28 SET ABMFN=Y
+29 WRITE !!,"Creating file..."
+30 DO OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
+31 IF POP
QUIT
+32 USE IO
+33 DO WRTPTS
+34 DO WRTELIG
+35 DO WRTVSTS
+36 DO CLOSE^%ZISH("ABM")
+37 WRITE "DONE"
End DoDot:1
XIT ;
+1 KILL ^TMP($JOB,"ABM-M2RPT")
+2 KILL ABMP,ABMY,ABMPTINA,ABMPT,ABMMFLG
+3 QUIT
QUE ;QUE TO TASKMAN
+1 SET ZTRTN="TOTALS^ABMM2ELG"
+2 SET ZTDESC="3P MEANINGFUL USE ELIGIBILITY REPORT"
+3 SET ZTSAVE("ABM*")=""
+4 KILL ZTSK
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+7 QUIT
GETPTS ;
+1 SET ABMP("PDFN")=0
+2 FOR
SET ABMP("PDFN")=$ORDER(^AUPNPAT(ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+3 IF $DATA(^AUPNPAT(ABMP("PDFN"),41,DUZ(2)))
Begin DoDot:2
+4 ;date inactive/deleted
SET ABMPTINA=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3)
+5 ;patient inactive prior to or after range of report
IF ABMPTINA'=""&((ABMPTINA<ABMY("DT",1))!(ABMPTINA>ABMY("DT",2)))
QUIT
+6 SET ^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN"))=""
+7 ;count patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","PTS")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS"))+1
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
GETELIG ;
+1 ;medicaid
+2 SET ABMP("PDFN")=0
+3 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+4 ;patient has medicaid entry
IF $DATA(^AUPNMCD("B",ABMP("PDFN")))
Begin DoDot:2
+5 SET ABMP("MDFN")=0
+6 FOR
SET ABMP("MDFN")=$ORDER(^AUPNMCD("B",ABMP("PDFN"),ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:3
+7 SET ABMP("EFFDT")=0
SET ABMMFLG=0
+8 FOR
SET ABMP("EFFDT")=$ORDER(^AUPNMCD(ABMP("MDFN"),11,ABMP("EFFDT")))
IF 'ABMP("EFFDT")
QUIT
Begin DoDot:4
+9 ;end date
SET ABMP("ENDDT")=$PIECE($GET(^AUPNMCD(ABMP("MDFN"),11,ABMP("EFFDT"),0)),U,2)
+10 ;effective date after end of range or end date before start of range
+11 IF (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1)))
QUIT
+12 ;if it gets here patient has eligibility in our window
SET ABMMFLG=1
End DoDot:4
IF (ABMMFLG=1)
QUIT
+13 ;patient has at least one entry that's what we want
IF ABMMFLG=1
Begin DoDot:4
+14 SET ^TMP($JOB,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN"))=""
+15 ;count medicaid patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","MCD")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCD"))+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 ;medicare
+18 SET ABMP("PDFN")=0
+19 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+20 ;patient had medicare entry
IF $DATA(^AUPNMCR(ABMP("PDFN")))
Begin DoDot:2
+21 SET ABMP("MDFN")=0
SET ABMMFLG=0
+22 FOR
SET ABMP("MDFN")=$ORDER(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:3
+23 ;effective date
SET ABMP("EFFDT")=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN"),0)),U)
+24 ;end date
SET ABMP("ENDDT")=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,2)
+25 ;effective date after end of range or end date before start of range
+26 IF (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1)))
QUIT
+27 ;if it gets here patient has eligibility in our window
SET ABMMFLG=1
End DoDot:3
IF (ABMMFLG=1)
QUIT
+28 ;patient has at least one entry that's what we want
IF ABMMFLG=1
Begin DoDot:3
+29 SET ^TMP($JOB,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN"))=""
+30 ;count medicare patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","MCR")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCR"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ;railroad
+33 SET ABMP("PDFN")=0
+34 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+35 ;patient had medicare entry
IF $DATA(^AUPNRRE(ABMP("PDFN")))
Begin DoDot:2
+36 SET ABMP("MDFN")=0
SET ABMMFLG=0
+37 FOR
SET ABMP("MDFN")=$ORDER(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:3
+38 ;effective date
SET ABMP("EFFDT")=$PIECE($GET(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN"),0)),U)
+39 ;end date
SET ABMP("ENDDT")=$PIECE($GET(^AUPNRRE(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,2)
+40 ;effective date after end of range or end date before start of range
+41 IF (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1)))
QUIT
+42 ;if it gets here patient has eligibility in our window
SET ABMMFLG=1
End DoDot:3
IF (ABMMFLG=1)
QUIT
+43 ;patient has at least one entry that's what we want
IF ABMMFLG=1
Begin DoDot:3
+44 SET ^TMP($JOB,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN"))=""
+45 ;count railroad patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","RR")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","RR"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;
+47 ;private
+48 SET ABMP("PDFN")=0
+49 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+50 ;patient has private entry
IF $DATA(^AUPNPRVT(ABMP("PDFN")))
Begin DoDot:2
+51 SET ABMP("MDFN")=0
SET ABMMFLG=0
+52 FOR
SET ABMP("MDFN")=$ORDER(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:3
+53 ;effective date
SET ABMP("EFFDT")=$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,6)
+54 ;end date
SET ABMP("ENDDT")=$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U,7)
+55 ;effective date after end of range or end date before start of range
+56 IF (ABMP("EFFDT")>ABMY("DT",2))!((ABMP("ENDDT")'="")&(ABMP("ENDDT")<ABMY("DT",1)))
QUIT
+57 ;if it gets here patient has eligibility in our window
SET ABMMFLG=1
End DoDot:3
IF (ABMMFLG=1)
QUIT
+58 ;patient has at least one entry that's what we want
IF ABMMFLG=1
Begin DoDot:3
+59 SET ^TMP($JOB,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN"))=""
+60 ;count private patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","PI")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PI"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+61 ;
+62 ;no insurance
+63 SET ABMP("PDFN")=0
+64 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+65 IF '$DATA(^TMP($JOB,"ABM-M2RPT","PI",ABMP("PDFN")))&'$DATA(^TMP($JOB,"ABM-M2RPT","MCD",ABMP("PDFN")))&'$DATA(^TMP($JOB,"ABM-M2RPT","MCR",ABMP("PDFN")))&'$DATA(^TMP($JOB,"ABM-M2RPT","RR",ABMP("PDFN")))
Begin DoDot:2
+66 ;count no insurance patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","NO")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","NO"))+1
+67 SET ^TMP($JOB,"ABM-M2RPT","NO",ABMP("PDFN"))=""
End DoDot:2
End DoDot:1
+68 ;
+69 QUIT
+70 ;
GETVSTS ;
+1 SET ABMP("SDT")=ABMY("DT",1)-.5
+2 SET ABMP("EDT")=ABMY("DT",2)+.999999
+3 FOR
SET ABMP("SDT")=$ORDER(^AUPNVSIT("B",ABMP("SDT")))
IF ('ABMP("SDT")!(ABMP("SDT")>ABMP("EDT")))
QUIT
Begin DoDot:1
+4 SET ABMP("VDFN")=0
+5 FOR
SET ABMP("VDFN")=$ORDER(^AUPNVSIT("B",ABMP("SDT"),ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:2
+6 ;patient
SET ABMPT=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
+7 ;no patient on visit
IF ABMPT=""
QUIT
+8 ;not one of our patients
IF '$DATA(^TMP($JOB,"ABM-M2RPT","PTS",ABMPT))
QUIT
+9 SET ^TMP($JOB,"ABM-M2RPT","ENC",ABMP("VDFN"))=""
+10 ;count encounters
SET ^TMP($JOB,"ABM-M2RPT","CNT","ENC")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","ENC"))+1
+11 IF '$DATA(^TMP($JOB,"ABM-M2RPT","UNQ",ABMPT))
Begin DoDot:3
+12 SET ^TMP($JOB,"ABM-M2RPT","UNQ",ABMPT)=""
+13 ;count unique patients
SET ^TMP($JOB,"ABM-M2RPT","CNT","UNQ")=+$GET(^TMP($JOB,"ABM-M2RPT","CNT","UNQ"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
TOTALS ;
+1 ;Practice Demographics
+2 ;# of Patient
+3 ;Encounters/Year
+4 ;# of Unique Patients/Year
+5 SET ABM("HD",0)="Meaningful Use Eligibility Report"
+6 SET ABM("PG")=1
+7 DO GETPTS
+8 DO GETELIG
+9 DO GETVSTS
+10 DO WHD
+11 WRITE !!,"Practice Demographics"
+12 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")),7)_" Patients"
+13 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","ENC")),7)_" Encounters"
+14 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","UNQ")),7)_" Unique Patients"
+15 ;
+16 ;Patient Demographics
+17 ;% of Patients on Medicaid
+18 ;% of Patients on Medicare
+19 ;% of Patients on Private Insurance
+20 ;% of Patients Uninsured
+21 ;% of Patients on Managed Care
+22 ;no patients found so it cause a DIVIDE error if we continue
IF +$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS"))=0
WRITE !!,"(REPORT COMPLETE)"
QUIT
+23 WRITE !!,"Patient Demographics"
+24 ;medicaid
+25 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCD")),7)_" Patients with Medicaid ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCD"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+26 ;medicare
+27 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCR")),7)_" Patients with Medicare ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","MCR"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+28 ;railroad
+29 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","RR")),7)_" Patients with Railroad ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","RR"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+30 ;private
+31 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PI")),7)_" Patients with Private ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PI"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+32 ;no eligibility
+33 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","NO")),7)_" Patients Uninsured ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","NO"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+34 ;start new code abm*2.6*11 VMBP#9 RQMT_103
+35 ;vmbp
+36 WRITE !?2,$JUSTIFY(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","VMBP")),7)_" Patients with VA Med B ( "_$JUSTIFY($FNUMBER((+$GET(^TMP($JOB,"ABM-M2RPT","CNT","VMBP"))/(+$GET(^TMP($JOB,"ABM-M2RPT","CNT","PTS")))*100),",",2),5)_"% )"
+37 ;end new code VMBP#9 RQMT_103
+38 WRITE !!,"(REPORT COMPLETE)"
+39 QUIT
+40 ;
WRTPTS ;^TMP($J,"ABM-M2RPT","PTS",ABMP("PDFN"))
+1 WRITE !!!,"PATIENTS PATIENTS PATIENTS PATIENTS PATIENTS"
+2 WRITE !?3,"PDFN",?15,"NAME",?50,"HRN",?60,"DATE INACTIVE"
+3 SET ABMP("PDFN")=0
+4 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PTS",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+5 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2),?60,$$SDT^ABMDUTL($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,3))
End DoDot:1
+6 ;
+7 ;^TMP($J,"ABM-M2RPT","UNQ",ABMPT)
+8 WRITE !!!,"UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS UNIQUE PATIENTS"
+9 WRITE !?3,"PDFN",?15,"NAME",?50,"HRN"
+10 SET ABMP("PDFN")=0
+11 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","UNQ",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+12 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)
End DoDot:1
+13 QUIT
+14 ;
WRTELIG ;
+1 ;^TMP($J,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN"))
+2 WRITE !!!,"MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID MEDICAID "
+3 WRITE !?3,"PDFN",?15,"NAME",?50,"MCD#",?62,"PLAN"
+4 SET ABMP("PDFN")=0
+5 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","MCD",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+6 SET ABMP("MDFN")=0
+7 FOR
SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","MCD",ABMP("PDFN"),ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:2
+8 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,3),?62,$PIECE($GET(^AUPNMCD(ABMP("MDFN"),0)),U,10)
End DoDot:2
End DoDot:1
+9 ;
+10 ;^TMP($J,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN"))
+11 WRITE !!!,"MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE MEDICARE "
+12 WRITE !?3,"PDFN",?15,"NAME",?50,"MCR#"
+13 SET ABMP("PDFN")=0
+14 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","MCR",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+15 SET ABMP("MDFN")=0
+16 FOR
SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","MCR",ABMP("PDFN"),ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:2
+17 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNMCR(ABMP("PDFN"),0)),U,3)
End DoDot:2
End DoDot:1
+18 ;
+19 ;^TMP($J,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN"))
+20 WRITE !!!,"RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD RAILROAD "
+21 WRITE !?3,"PDFN",?15,"NAME",?50,"RR#"
+22 SET ABMP("PDFN")=0
+23 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","RR",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+24 SET ABMP("MDFN")=0
+25 FOR
SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","RR",ABMP("PDFN"),ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:2
+26 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNRRE(ABMP("PDFN"),0)),U,3)
End DoDot:2
End DoDot:1
+27 ;
+28 ;start new code abm*2.6*11 VMBP#9 RQMT_103
+29 ;^TMP($J,"ABM-M2RPT","VMBP",ABMP("PDFN"),ABMP("MDFN"))
+30 WRITE !!!,"VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP VMBP "
+31 WRITE !?3,"PDFN",?15,"NAME",?50,"HRN"
+32 ;end new code VMBP#9 RQMT_103
+33 ;
+34 ;^TMP($J,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN"))
+35 WRITE !!!,"PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE PRIVATE "
+36 WRITE !?3,"PDFN",?15,"NAME",?50,"INS",?62,"MEM#"
+37 SET ABMP("PDFN")=0
+38 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PI",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+39 SET ABMP("MDFN")=0
+40 FOR
SET ABMP("MDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","PI",ABMP("PDFN"),ABMP("MDFN")))
IF 'ABMP("MDFN")
QUIT
Begin DoDot:2
+41 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U),?50,$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),0)),U),?62,$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMP("MDFN"),2)),U)
End DoDot:2
End DoDot:1
+42 ;
+43 ;^TMP($J,"ABM-M2RPT","NO",ABMP("PDFN"))
+44 WRITE !!!,"NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED NOT INSURED "
+45 WRITE !?3,"PDFN",?15,"NAME"
+46 SET ABMP("PDFN")=0
+47 FOR
SET ABMP("PDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","NO",ABMP("PDFN")))
IF 'ABMP("PDFN")
QUIT
Begin DoDot:1
+48 WRITE !?3,ABMP("PDFN"),?15,$PIECE($GET(^DPT(ABMP("PDFN"),0)),U)
End DoDot:1
+49 QUIT
+50 ;
WRTVSTS ;^TMP($J,"ABM-M2RPT","ENC",ABMP("VDFN"))
+1 WRITE !!!,"VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS VISITS "
+2 WRITE !?3,"VDFN",?13,"VISIT",?30,"PDFN",?40,"PATIENT"
+3 SET ABMP("VDFN")=0
+4 FOR
SET ABMP("VDFN")=$ORDER(^TMP($JOB,"ABM-M2RPT","ENC",ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:1
+5 WRITE !?3,ABMP("VDFN"),?13,$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U),?30,$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5),?40,$PIECE($GET(^DPT($PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5),0)),U)
End DoDot:1
+6 QUIT
WHD ;EP for writing Report Header
+1 WRITE $$EN^ABMVDF("IOF"),!
+2 KILL ABM("LINE")
SET $PIECE(ABM("LINE"),"=",$SELECT($DATA(ABM(132)):132,1:80))=""
WRITE ABM("LINE"),!
+3 ;abm*2.6*1 NO HEAT
DO NOW^%DTC
+4 WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):103,1:48)
SET Y=%
XECUTE ^DD("DD")
WRITE Y," Page ",ABM("PG")
+5 SET ABM("HD",1)="For date range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2))
+6 IF $GET(ABM("HD",1))]""
WRITE !,ABM("HD",1)
+7 IF $GET(ABM("HD",2))]""
WRITE !,ABM("HD",2)
+8 WRITE !,"Billing Location: ",$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+9 WRITE !,ABM("LINE")
KILL ABM("LINE")
+10 QUIT
