ABMM2EP ;IHS/SD/SDR - MU EP List of EPs Report ;
;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
;IHS/SD/SDR - 2.6*12 - HEAT100502 - Print all provider classes; didn't if site added/removed from list.
;
I $P($G(^ABMMUPRM(1,0)),U,2)="" D Q
.W !!,"Setup has not been done. Please do MUP option prior to running any reports",!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;
EN ;
D ^XBFMK
W !!
S DIR(0)="Y"
S DIR("A",1)="The output for this report will contain a list of eligible provider classes"
S DIR("A",2)=""
S DIR("A",3)="You can also print providers that have an eligible provider class"
S DIR("A",4)="This could be a lengthy list!"
S DIR("A",5)=""
S DIR("A")="Print the list of providers with eligible provider classes as well"
D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
S ABMBOTH=Y
S ABMQ("RC")="COMPUTE^ABMM2EP"
S ABMQ("RX")="POUT^ABMDRUTL"
S ABMQ("NS")="ABM"
S ABMQ("RP")="PRINT^ABMM2EP"
D ^ABMDRDBQ
Q
COMPUTE ;
Q
PRINT ;
S ABM("PG")=1
D HDR
;start old code abm*2.6*12 HEAT100502
;S ABMLAST=$O(^ABMMUPRM(1,2,9999),-1)
;S ABMCUTOF=$S(ABMLAST#2=1:(ABMLAST+1)\2,1:ABMLAST\2)
;S ABMCNT=0
;S ABMCNT2=ABMCUTOF
;F S ABMCNT=$O(^ABMMUPRM(1,2,ABMCNT)) Q:'ABMCNT D Q:ABMCNT=ABMCUTOF
;.I $Y+5>IOSL D HD Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
;.S ABMCD=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),9999999.01,"E")
;.S ABMPC=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),.01,"E")
;.S ABMCD2=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT2,0)),U),9999999.01,"E")
;.S ABMPC2=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT2,0)),U),.01,"E")
;.S ABMCNT2=ABMCNT2+1
;.W !?3,ABMCD,?8,ABMPC,?40,ABMCD2,?45,ABMPC2
;end old code start new code HEAT100502
S ABMI=0,ABMCNT=0
F S ABMI=$O(^ABMMUPRM(1,2,ABMI)) Q:'ABMI D
.S ABMCNT=ABMCNT+1
.S ABMCD=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),9999999.01,"E")
.S ABMPC=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),.01,"E")
.S ABMTMP(ABMCNT)=ABMCD_U_ABMPC
S ABMLAST=ABMCNT
S ABMCUTOF=$S(ABMLAST#2=1:(ABMLAST+1)\2,1:ABMLAST\2)
S ABMCNT2=ABMCUTOF
S ABMCNT=0
F S ABMCNT=$O(ABMTMP(ABMCNT)) Q:'ABMCNT D Q:ABMCNT=ABMCUTOF
.I $Y+5>IOSL D HD Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
.S ABMCNT2=ABMCNT2+1
.S ABMCD=$P(ABMTMP(ABMCNT),U)
.S ABMPC=$P(ABMTMP(ABMCNT),U,2)
.S ABMCD2=$P($G(ABMTMP(ABMCNT2)),U)
.S ABMPC2=$P($G(ABMTMP(ABMCNT2)),U,2)
.W !?3,ABMCD,?8,ABMPC,?40,ABMCD2,?45,ABMPC2
;end new code HEAT100502
;
I +$G(ABMBOTH)'=1 Q ;don't write providers
S ABM("PG")=ABM("PG")+1
D HDR2
K ^XTMP("ABM-EP",$J)
S ABMNM=""
S ABMCNT=0
F S ABMNM=$O(^VA(200,"B",ABMNM)) Q:$G(ABMNM)="" D
.S ABMIEN=0
.F S ABMIEN=$O(^VA(200,"B",ABMNM,ABMIEN)) Q:'ABMIEN D
..Q:$$GET1^DIQ(200,ABMIEN,53.5,"I")=""
..Q:'$D(^ABMMUPRM(1,2,"B",$$GET1^DIQ(200,ABMIEN,53.5,"I"))) ;not on the provider class list
..S ABMCNT=ABMCNT+1
..S ^XTMP("ABM-EP",$J,ABMCNT)=$$GET1^DIQ(200,ABMIEN,.01,"E")_U_$$GET1^DIQ(7,$$GET1^DIQ(200,ABMIEN,53.5,"I"),9999999.01,"E")
S ABMCUTOF=$S(ABMCNT#2=1:(ABMCNT+1)\2,1:ABMCNT\2)
S ABMCNT=0,ABMCNT2=ABMCUTOF
F S ABMCNT=$O(^XTMP("ABM-EP",$J,ABMCNT)) Q:'ABMCNT!(ABMCNT=ABMCUTOF) D Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
.I $Y+5>IOSL D HD2 Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
.S ABMP=$P($G(^XTMP("ABM-EP",$J,ABMCNT)),U)
.S ABMPC=$P($G(^XTMP("ABM-EP",$J,ABMCNT)),U,2)
.S ABMP2=$P($G(^XTMP("ABM-EP",$J,ABMCNT2)),U)
.S ABMPC2=$P($G(^XTMP("ABM-EP",$J,ABMCNT2)),U,2)
.S ABMCNT2=ABMCNT2+1
.W !,$E(ABMP,1,33),?35,ABMPC,?40,$E(ABMP2,1,33),?75,ABMPC2
K ^XTMP("ABM-EP",$J)
Q
;
HD ;
D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("PG")=+$G(ABM("PG"))+1
HDR ;EP
D EN^ABMVDF("IOF")
W $C(13)
D CENTER^ABMUCUTL(" EP Class - List of Eligible Professionals Page "_ABM("PG"))
W ! D CENTER^ABMUCUTL("IHS Meaningful Use Patient Volume Report")
W !
D NOW^%DTC
D CENTER^ABMUCUTL("Report Run Date: "_$$CDT^ABMDUTL(%))
I ABM("PG")=1 W !!,"PROVIDER CLASSES THAT WILL BE INCLUDED:"
I ABM("PG")'=1 W !!,"(Cont)"
W !?3,$$EN^ABMVDF("ULN"),"Code",$$EN^ABMVDF("ULF")
W ?8,$$EN^ABMVDF("ULN"),"Provider Class",$$EN^ABMVDF("ULF")
W ?40,$$EN^ABMVDF("ULN"),"Code",$$EN^ABMVDF("ULF")
W ?45,$$EN^ABMVDF("ULN"),"Provider Class",$$EN^ABMVDF("ULF")
Q
HD2 ;
D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("PG")=+$G(ABM("PG"))+1
HDR2 ;EP
D EN^ABMVDF("IOF")
W $C(13)
D CENTER^ABMUCUTL(" EP Class - List of Eligible Professionals Page "_ABM("PG"))
W ! D CENTER^ABMUCUTL("IHS Meaningful Use Patient Volume Report")
W !
D NOW^%DTC
D CENTER^ABMUCUTL("Report Run Date: "_$$CDT^ABMDUTL(%))
I ABM("PG")=1 W !!,"ELIGIBLE PROFESSIONALS"
I ABM("PG")'=1 W !!,"(Cont)"
W !,$$EN^ABMVDF("ULN"),"Provider",$$EN^ABMVDF("ULF")
W ?34,$$EN^ABMVDF("ULN"),"Class",$$EN^ABMVDF("ULF")
W ?40,$$EN^ABMVDF("ULN"),"Provider",$$EN^ABMVDF("ULF")
W ?75,$$EN^ABMVDF("ULN"),"Class",$$EN^ABMVDF("ULF")
Q
ABMM2EP ;IHS/SD/SDR - MU EP List of EPs Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
+2 ;IHS/SD/SDR - 2.6*12 - HEAT100502 - Print all provider classes; didn't if site added/removed from list.
+3 ;
+4 IF $PIECE($GET(^ABMMUPRM(1,0)),U,2)=""
Begin DoDot:1
+5 WRITE !!,"Setup has not been done. Please do MUP option prior to running any reports",!
+6 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+7 ;
EN ;
+1 DO ^XBFMK
+2 WRITE !!
+3 SET DIR(0)="Y"
+4 SET DIR("A",1)="The output for this report will contain a list of eligible provider classes"
+5 SET DIR("A",2)=""
+6 SET DIR("A",3)="You can also print providers that have an eligible provider class"
+7 SET DIR("A",4)="This could be a lengthy list!"
+8 SET DIR("A",5)=""
+9 SET DIR("A")="Print the list of providers with eligible provider classes as well"
+10 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+11 SET ABMBOTH=Y
+12 SET ABMQ("RC")="COMPUTE^ABMM2EP"
+13 SET ABMQ("RX")="POUT^ABMDRUTL"
+14 SET ABMQ("NS")="ABM"
+15 SET ABMQ("RP")="PRINT^ABMM2EP"
+16 DO ^ABMDRDBQ
+17 QUIT
COMPUTE ;
+1 QUIT
PRINT ;
+1 SET ABM("PG")=1
+2 DO HDR
+3 ;start old code abm*2.6*12 HEAT100502
+4 ;S ABMLAST=$O(^ABMMUPRM(1,2,9999),-1)
+5 ;S ABMCUTOF=$S(ABMLAST#2=1:(ABMLAST+1)\2,1:ABMLAST\2)
+6 ;S ABMCNT=0
+7 ;S ABMCNT2=ABMCUTOF
+8 ;F S ABMCNT=$O(^ABMMUPRM(1,2,ABMCNT)) Q:'ABMCNT D Q:ABMCNT=ABMCUTOF
+9 ;.I $Y+5>IOSL D HD Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
+10 ;.S ABMCD=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),9999999.01,"E")
+11 ;.S ABMPC=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT,0)),U),.01,"E")
+12 ;.S ABMCD2=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT2,0)),U),9999999.01,"E")
+13 ;.S ABMPC2=$$GET1^DIQ(7,$P($G(^ABMMUPRM(1,2,ABMCNT2,0)),U),.01,"E")
+14 ;.S ABMCNT2=ABMCNT2+1
+15 ;.W !?3,ABMCD,?8,ABMPC,?40,ABMCD2,?45,ABMPC2
+16 ;end old code start new code HEAT100502
+17 SET ABMI=0
SET ABMCNT=0
+18 FOR
SET ABMI=$ORDER(^ABMMUPRM(1,2,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+19 SET ABMCNT=ABMCNT+1
+20 SET ABMCD=$$GET1^DIQ(7,$PIECE($GET(^ABMMUPRM(1,2,ABMCNT,0)),U),9999999.01,"E")
+21 SET ABMPC=$$GET1^DIQ(7,$PIECE($GET(^ABMMUPRM(1,2,ABMCNT,0)),U),.01,"E")
+22 SET ABMTMP(ABMCNT)=ABMCD_U_ABMPC
End DoDot:1
+23 SET ABMLAST=ABMCNT
+24 SET ABMCUTOF=$SELECT(ABMLAST#2=1:(ABMLAST+1)\2,1:ABMLAST\2)
+25 SET ABMCNT2=ABMCUTOF
+26 SET ABMCNT=0
+27 FOR
SET ABMCNT=$ORDER(ABMTMP(ABMCNT))
IF 'ABMCNT
QUIT
Begin DoDot:1
+28 IF $Y+5>IOSL
DO HD
IF (IOST["C")&((+$GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+29 SET ABMCNT2=ABMCNT2+1
+30 SET ABMCD=$PIECE(ABMTMP(ABMCNT),U)
+31 SET ABMPC=$PIECE(ABMTMP(ABMCNT),U,2)
+32 SET ABMCD2=$PIECE($GET(ABMTMP(ABMCNT2)),U)
+33 SET ABMPC2=$PIECE($GET(ABMTMP(ABMCNT2)),U,2)
+34 WRITE !?3,ABMCD,?8,ABMPC,?40,ABMCD2,?45,ABMPC2
End DoDot:1
IF ABMCNT=ABMCUTOF
QUIT
+35 ;end new code HEAT100502
+36 ;
+37 ;don't write providers
IF +$GET(ABMBOTH)'=1
QUIT
+38 SET ABM("PG")=ABM("PG")+1
+39 DO HDR2
+40 KILL ^XTMP("ABM-EP",$JOB)
+41 SET ABMNM=""
+42 SET ABMCNT=0
+43 FOR
SET ABMNM=$ORDER(^VA(200,"B",ABMNM))
IF $GET(ABMNM)=""
QUIT
Begin DoDot:1
+44 SET ABMIEN=0
+45 FOR
SET ABMIEN=$ORDER(^VA(200,"B",ABMNM,ABMIEN))
IF 'ABMIEN
QUIT
Begin DoDot:2
+46 IF $$GET1^DIQ(200,ABMIEN,53.5,"I")=""
QUIT
+47 ;not on the provider class list
IF '$DATA(^ABMMUPRM(1,2,"B",$$GET1^DIQ(200,ABMIEN,53.5,"I")))
QUIT
+48 SET ABMCNT=ABMCNT+1
+49 SET ^XTMP("ABM-EP",$JOB,ABMCNT)=$$GET1^DIQ(200,ABMIEN,.01,"E")_U_$$GET1^DIQ(7,$$GET1^DIQ(200,ABMIEN,53.5,"I"),9999999.01,"E")
End DoDot:2
End DoDot:1
+50 SET ABMCUTOF=$SELECT(ABMCNT#2=1:(ABMCNT+1)\2,1:ABMCNT\2)
+51 SET ABMCNT=0
SET ABMCNT2=ABMCUTOF
+52 FOR
SET ABMCNT=$ORDER(^XTMP("ABM-EP",$JOB,ABMCNT))
IF 'ABMCNT!(ABMCNT=ABMCUTOF)
QUIT
Begin DoDot:1
+53 IF $Y+5>IOSL
DO HD2
IF (IOST["C")&((+$GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+54 SET ABMP=$PIECE($GET(^XTMP("ABM-EP",$JOB,ABMCNT)),U)
+55 SET ABMPC=$PIECE($GET(^XTMP("ABM-EP",$JOB,ABMCNT)),U,2)
+56 SET ABMP2=$PIECE($GET(^XTMP("ABM-EP",$JOB,ABMCNT2)),U)
+57 SET ABMPC2=$PIECE($GET(^XTMP("ABM-EP",$JOB,ABMCNT2)),U,2)
+58 SET ABMCNT2=ABMCNT2+1
+59 WRITE !,$EXTRACT(ABMP,1,33),?35,ABMPC,?40,$EXTRACT(ABMP2,1,33),?75,ABMPC2
End DoDot:1
IF (IOST["C")&((+$GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+60 KILL ^XTMP("ABM-EP",$JOB)
+61 QUIT
+62 ;
HD ;
+1 DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+2 SET ABM("PG")=+$GET(ABM("PG"))+1
HDR ;EP
+1 DO EN^ABMVDF("IOF")
+2 WRITE $CHAR(13)
+3 DO CENTER^ABMUCUTL(" EP Class - List of Eligible Professionals Page "_ABM("PG"))
+4 WRITE !
DO CENTER^ABMUCUTL("IHS Meaningful Use Patient Volume Report")
+5 WRITE !
+6 DO NOW^%DTC
+7 DO CENTER^ABMUCUTL("Report Run Date: "_$$CDT^ABMDUTL(%))
+8 IF ABM("PG")=1
WRITE !!,"PROVIDER CLASSES THAT WILL BE INCLUDED:"
+9 IF ABM("PG")'=1
WRITE !!,"(Cont)"
+10 WRITE !?3,$$EN^ABMVDF("ULN"),"Code",$$EN^ABMVDF("ULF")
+11 WRITE ?8,$$EN^ABMVDF("ULN"),"Provider Class",$$EN^ABMVDF("ULF")
+12 WRITE ?40,$$EN^ABMVDF("ULN"),"Code",$$EN^ABMVDF("ULF")
+13 WRITE ?45,$$EN^ABMVDF("ULN"),"Provider Class",$$EN^ABMVDF("ULF")
+14 QUIT
HD2 ;
+1 DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+2 SET ABM("PG")=+$GET(ABM("PG"))+1
HDR2 ;EP
+1 DO EN^ABMVDF("IOF")
+2 WRITE $CHAR(13)
+3 DO CENTER^ABMUCUTL(" EP Class - List of Eligible Professionals Page "_ABM("PG"))
+4 WRITE !
DO CENTER^ABMUCUTL("IHS Meaningful Use Patient Volume Report")
+5 WRITE !
+6 DO NOW^%DTC
+7 DO CENTER^ABMUCUTL("Report Run Date: "_$$CDT^ABMDUTL(%))
+8 IF ABM("PG")=1
WRITE !!,"ELIGIBLE PROFESSIONALS"
+9 IF ABM("PG")'=1
WRITE !!,"(Cont)"
+10 WRITE !,$$EN^ABMVDF("ULN"),"Provider",$$EN^ABMVDF("ULF")
+11 WRITE ?34,$$EN^ABMVDF("ULN"),"Class",$$EN^ABMVDF("ULF")
+12 WRITE ?40,$$EN^ABMVDF("ULN"),"Provider",$$EN^ABMVDF("ULF")
+13 WRITE ?75,$$EN^ABMVDF("ULN"),"Class",$$EN^ABMVDF("ULF")
+14 QUIT
