ABMM2MUP ;IHS/SD/SDR - MU Report Parameters ;
;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
;IHS/SD/SDR - 2.6*12 - Updated FQHC/RHC/Tribal to include Urban
;
;
I $P($G(^ABMMUPRM(1,0)),U,2)'="" D Q
.W !!,"Setup has already been done. Contact OIT if changes need to be made",!
.W !,"Will display current setup next...",!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
.D DIC^ABMMUINQ
.W !!
;
D ^XBFMK
S DIR(0)="Y"
S DIR("A",1)="You are setting up the Report Parameters. Once completed, you will not be able to edit."
S DIR("A")="Continue"
S DIR("B")="N"
D ^DIR K DIR
Q:Y<1
D ^XBFMK
S DIR(0)="Y"
;S DIR("A")="Do you wish to designate a Facility as an FQHC, RHC or Tribal clinic" ;abm*2.6*12 include Urban
S DIR("A")="Do you wish to designate a Facility as an FQHC, RHC, Tribal or Urban clinic" ;abm*2.6*12 include Urban
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
S ABMANS=+Y
EN ;
I ABMANS=1 D
.D GETFACS
.W !!
.S ABMCNT=0,ABMDIR=""
.F S ABMCNT=$O(ABMFLIST(ABMCNT)) Q:'ABMCNT D
..W !?2,ABMCNT_".",?6,$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
..S:ABMDIR'="" ABMDIR=ABMDIR_";"_ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
..S:ABMDIR="" ABMDIR=ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
.S ABMCNT=$O(ABMFLIST(99999),-1) ;get last entry#
.S (ABMCNT,ABMTOT)=ABMCNT+1
.W !!
.K ABMFANS,ABMF
.F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) ;they didn't answer
..D ^XBFMK
..S DIR(0)="SAO^"_$G(ABMDIR)
..;S DIR("A")="Select one or more facilities to designate as an FQHC or RHC: " ;abm*2.6*10 HEAT61752
..;S DIR("A")="Select one or more facilities to designate as an FQHC, RHC or Tribal clinic: " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
..S DIR("A")="Select one or more facilities to designate as an FQHC, RHC, Tribal or Urban clinic: " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
..D ^DIR K DIR
..Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
..Q:+$G(Y)<0
..S ABMFANS=Y
..S ABMF($G(ABMFLIST(ABMFANS)))=""
..D ^XBFMK
..S DIR(0)="Y"
..;S DIR("A")="Is this FQHC led by a PA? " ;abm*2.6*10 HEAT61752
..;S DIR("A")="Is this FQHC/RHC/Tribal clinic led by a PA? " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
..S DIR("A")="Is this FQHC/RHC/Tribal/Urban clinic led by a PA? " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
..D ^DIR K DIR
..Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
..S ABMF($G(ABMFLIST(ABMFANS)))=Y
..I ABMFANS=(ABMCNT+1) D
...S ABMCNT=0
...F S ABMCNT=$O(ABMF(ABMCNT)) Q:'ABMCNT S ABMF($G(ABMFLIST(ABMFANS)))=ABMFANS2
I $D(ABMF) D
.;W !!!,"The following have been identified by you as FQHC/RHC facilities" ;abm*2.6*10 HEAT61752
.;W !!!,"The following have been identified by you as FQHC/RHC/Tribal facilities" ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
.W !!!,"The following have been identified by you as FQHC/RHC/Tribal/Urban facilities" ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
.S ABMCNT=0
.F S ABMCNT=$O(ABMF(ABMCNT)) Q:'ABMCNT D
..W !?2,$$GET1^DIQ(9999999.06,ABMCNT,.01,"E")
..;start old code abm*2.6*10 HEAT61752
..;W:+$G(ABMF(ABMCNT))=0 " (FQHC)"
..;W:+$G(ABMF(ABMCNT))=1 " (FQHC led by PA)"
..;end old code start new code HEAT61752
..;start old code abm*2.6*12 include Urban
..;W:+$G(ABMF(ABMCNT))=0 " (FQHC/RHC/Tribal)"
..;W:+$G(ABMF(ABMCNT))=1 " (FQHC/RHC/Tribal led by PA)"
..;end old code start new code include Urban
..W:+$G(ABMF(ABMCNT))=0 " (FQHC/RHC/Tribal/Urban)"
..W:+$G(ABMF(ABMCNT))=1 " (FQHC/RHC/Tribal/Urban led by PA)"
..;end new code include Urban
..;end new code HEAT61752
.D ^XBFMK
.S DIR(0)="Y"
.S DIR("A",1)=""
.S DIR("A",2)="By answering YES the entries below will be added and the list may not be edited without contacting OIT"
.S DIR("A",3)=""
.S DIR("A")="Are you sure"
.D ^DIR K DIR
.Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.S ABMFANS=Y
S DIE="^ABMMUPRM("
S DR=".02////Y"
S DA=1
D ^DIE
;
S ABMLOC=0
F S ABMLOC=$O(ABMF(ABMLOC)) Q:'ABMLOC D ADDENTRY(ABMLOC)
K ABMDIR,ABMFLIST
W !!,"Some states consider Optometrists, Podiatrists, etc., as Physicians."
W !!,"The next prompt will allow the identification of these provider classes as"
W !,"EP types to generate volume reports."
W !!,"Please note: Defaults have been provided so there are already entries in this"
W !,"file that don't need to be entered again."
D ^XBFMK
S DIR(0)="Y"
S DIR("A")="Are there additional EP types for your state"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
Q:Y=0
F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.D ^XBFMK
.S DA(1)=1
.S DIC="^ABMMUPRM("_DA(1)_",2,"
.S DIC("P")=$P(^DD(9002274.55,2,0),U,2)
.S DIC(0)="AELMQ"
.D ^DIC
Q
ADDENTRY(ABMLOC) ;
D ^XBFMK
S DA(1)=1
S DIC="^ABMMUPRM("_DA(1)_",1,"
S DIC("P")=$P(^DD(9002274.55,1,0),U,2)
S DIC(0)="LMQ"
S X="`"_ABMLOC
D ^DIC
;start old code abm*2.6*8
;S DIE=DIC
;S DA(1)=1
;S DA=ABMLOC
;end old code start new code
S ABMIEN=+Y
D ^XBFMK
S DA(1)=1
S DA=ABMIEN
S DIE="^ABMMUPRM("_DA(1)_",1,"
;end new code
S DR=".02////"_$G(ABMF(ABMLOC))
D ^DIE
Q
GETFACS ;EP
K ABMPSFLG,ABMFLIST
S ABMPAR=0
S ABMCNT=1
F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
.I $D(^BAR(90052.05,ABMPAR,DUZ(2))) D
..; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
..; visit location
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,3)'=ABMPAR
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<DT)
..S ABMPSFLG=1
S ABMFLIST(ABMCNT)=ABMPAR
S ABMCNT=+$G(ABMCNT)+1
S ABML=0
F S ABML=$O(^BAR(90052.05,ABMPAR,ABML)) Q:'ABML D
.Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
.Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<DT)
.Q:ABMPAR=ABML
.S ABMFLIST(ABMCNT)=ABML
.S ABMCNT=+$G(ABMCNT)+1
Q
ABMM2MUP ;IHS/SD/SDR - MU Report Parameters ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
+2 ;IHS/SD/SDR - 2.6*12 - Updated FQHC/RHC/Tribal to include Urban
+3 ;
+4 ;
+5 IF $PIECE($GET(^ABMMUPRM(1,0)),U,2)'=""
Begin DoDot:1
+6 WRITE !!,"Setup has already been done. Contact OIT if changes need to be made",!
+7 WRITE !,"Will display current setup next...",!
+8 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+9 DO DIC^ABMMUINQ
+10 WRITE !!
End DoDot:1
QUIT
+11 ;
+12 DO ^XBFMK
+13 SET DIR(0)="Y"
+14 SET DIR("A",1)="You are setting up the Report Parameters. Once completed, you will not be able to edit."
+15 SET DIR("A")="Continue"
+16 SET DIR("B")="N"
+17 DO ^DIR
KILL DIR
+18 IF Y<1
QUIT
+19 DO ^XBFMK
+20 SET DIR(0)="Y"
+21 ;S DIR("A")="Do you wish to designate a Facility as an FQHC, RHC or Tribal clinic" ;abm*2.6*12 include Urban
+22 ;abm*2.6*12 include Urban
SET DIR("A")="Do you wish to designate a Facility as an FQHC, RHC, Tribal or Urban clinic"
+23 DO ^DIR
KILL DIR
+24 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+25 SET ABMANS=+Y
EN ;
+1 IF ABMANS=1
Begin DoDot:1
+2 DO GETFACS
+3 WRITE !!
+4 SET ABMCNT=0
SET ABMDIR=""
+5 FOR
SET ABMCNT=$ORDER(ABMFLIST(ABMCNT))
IF 'ABMCNT
QUIT
Begin DoDot:2
+6 WRITE !?2,ABMCNT_".",?6,$$GET1^DIQ(9999999.06,$GET(ABMFLIST(ABMCNT)),.01,"E")
+7 IF ABMDIR'=""
SET ABMDIR=ABMDIR_";"_ABMCNT_":"_$$GET1^DIQ(9999999.06,$GET(ABMFLIST(ABMCNT)),.01,"E")
+8 IF ABMDIR=""
SET ABMDIR=ABMCNT_":"_$$GET1^DIQ(9999999.06,$GET(ABMFLIST(ABMCNT)),.01,"E")
End DoDot:2
+9 ;get last entry#
SET ABMCNT=$ORDER(ABMFLIST(99999),-1)
+10 SET (ABMCNT,ABMTOT)=ABMCNT+1
+11 WRITE !!
+12 KILL ABMFANS,ABMF
+13 ;they didn't answer
FOR
Begin DoDot:2
+14 DO ^XBFMK
+15 SET DIR(0)="SAO^"_$GET(ABMDIR)
+16 ;S DIR("A")="Select one or more facilities to designate as an FQHC or RHC: " ;abm*2.6*10 HEAT61752
+17 ;S DIR("A")="Select one or more facilities to designate as an FQHC, RHC or Tribal clinic: " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
+18 ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
SET DIR("A")="Select one or more facilities to designate as an FQHC, RHC, Tribal or Urban clinic: "
+19 DO ^DIR
KILL DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+21 IF +$GET(Y)<0
QUIT
+22 SET ABMFANS=Y
+23 SET ABMF($GET(ABMFLIST(ABMFANS)))=""
+24 DO ^XBFMK
+25 SET DIR(0)="Y"
+26 ;S DIR("A")="Is this FQHC led by a PA? " ;abm*2.6*10 HEAT61752
+27 ;S DIR("A")="Is this FQHC/RHC/Tribal clinic led by a PA? " ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
+28 ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
SET DIR("A")="Is this FQHC/RHC/Tribal/Urban clinic led by a PA? "
+29 DO ^DIR
KILL DIR
+30 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+31 SET ABMF($GET(ABMFLIST(ABMFANS)))=Y
+32 IF ABMFANS=(ABMCNT+1)
Begin DoDot:3
+33 SET ABMCNT=0
+34 FOR
SET ABMCNT=$ORDER(ABMF(ABMCNT))
IF 'ABMCNT
QUIT
SET ABMF($GET(ABMFLIST(ABMFANS)))=ABMFANS2
End DoDot:3
End DoDot:2
IF +$GET(Y)<0!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
End DoDot:1
+35 IF $DATA(ABMF)
Begin DoDot:1
+36 ;W !!!,"The following have been identified by you as FQHC/RHC facilities" ;abm*2.6*10 HEAT61752
+37 ;W !!!,"The following have been identified by you as FQHC/RHC/Tribal facilities" ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
+38 ;abm*2.6*10 HEAT61752 ;abm*2.6*12 include Urban
WRITE !!!,"The following have been identified by you as FQHC/RHC/Tribal/Urban facilities"
+39 SET ABMCNT=0
+40 FOR
SET ABMCNT=$ORDER(ABMF(ABMCNT))
IF 'ABMCNT
QUIT
Begin DoDot:2
+41 WRITE !?2,$$GET1^DIQ(9999999.06,ABMCNT,.01,"E")
+42 ;start old code abm*2.6*10 HEAT61752
+43 ;W:+$G(ABMF(ABMCNT))=0 " (FQHC)"
+44 ;W:+$G(ABMF(ABMCNT))=1 " (FQHC led by PA)"
+45 ;end old code start new code HEAT61752
+46 ;start old code abm*2.6*12 include Urban
+47 ;W:+$G(ABMF(ABMCNT))=0 " (FQHC/RHC/Tribal)"
+48 ;W:+$G(ABMF(ABMCNT))=1 " (FQHC/RHC/Tribal led by PA)"
+49 ;end old code start new code include Urban
+50 IF +$GET(ABMF(ABMCNT))=0
WRITE " (FQHC/RHC/Tribal/Urban)"
+51 IF +$GET(ABMF(ABMCNT))=1
WRITE " (FQHC/RHC/Tribal/Urban led by PA)"
+52 ;end new code include Urban
+53 ;end new code HEAT61752
End DoDot:2
+54 DO ^XBFMK
+55 SET DIR(0)="Y"
+56 SET DIR("A",1)=""
+57 SET DIR("A",2)="By answering YES the entries below will be added and the list may not be edited without contacting OIT"
+58 SET DIR("A",3)=""
+59 SET DIR("A")="Are you sure"
+60 DO ^DIR
KILL DIR
+61 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+62 SET ABMFANS=Y
End DoDot:1
+63 SET DIE="^ABMMUPRM("
+64 SET DR=".02////Y"
+65 SET DA=1
+66 DO ^DIE
+67 ;
+68 SET ABMLOC=0
+69 FOR
SET ABMLOC=$ORDER(ABMF(ABMLOC))
IF 'ABMLOC
QUIT
DO ADDENTRY(ABMLOC)
+70 KILL ABMDIR,ABMFLIST
+71 WRITE !!,"Some states consider Optometrists, Podiatrists, etc., as Physicians."
+72 WRITE !!,"The next prompt will allow the identification of these provider classes as"
+73 WRITE !,"EP types to generate volume reports."
+74 WRITE !!,"Please note: Defaults have been provided so there are already entries in this"
+75 WRITE !,"file that don't need to be entered again."
+76 DO ^XBFMK
+77 SET DIR(0)="Y"
+78 SET DIR("A")="Are there additional EP types for your state"
+79 DO ^DIR
KILL DIR
+80 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+81 IF Y=0
QUIT
+82 FOR
Begin DoDot:1
+83 DO ^XBFMK
+84 SET DA(1)=1
+85 SET DIC="^ABMMUPRM("_DA(1)_",2,"
+86 SET DIC("P")=$PIECE(^DD(9002274.55,2,0),U,2)
+87 SET DIC(0)="AELMQ"
+88 DO ^DIC
End DoDot:1
IF +$GET(Y)<0!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+89 QUIT
ADDENTRY(ABMLOC) ;
+1 DO ^XBFMK
+2 SET DA(1)=1
+3 SET DIC="^ABMMUPRM("_DA(1)_",1,"
+4 SET DIC("P")=$PIECE(^DD(9002274.55,1,0),U,2)
+5 SET DIC(0)="LMQ"
+6 SET X="`"_ABMLOC
+7 DO ^DIC
+8 ;start old code abm*2.6*8
+9 ;S DIE=DIC
+10 ;S DA(1)=1
+11 ;S DA=ABMLOC
+12 ;end old code start new code
+13 SET ABMIEN=+Y
+14 DO ^XBFMK
+15 SET DA(1)=1
+16 SET DA=ABMIEN
+17 SET DIE="^ABMMUPRM("_DA(1)_",1,"
+18 ;end new code
+19 SET DR=".02////"_$GET(ABMF(ABMLOC))
+20 DO ^DIE
+21 QUIT
GETFACS ;EP
+1 KILL ABMPSFLG,ABMFLIST
+2 SET ABMPAR=0
+3 SET ABMCNT=1
+4 FOR
SET ABMPAR=$ORDER(^BAR(90052.05,ABMPAR))
IF +ABMPAR=0
QUIT
Begin DoDot:1
+5 IF $DATA(^BAR(90052.05,ABMPAR,DUZ(2)))
Begin DoDot:2
+6 ; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
+7 ; visit location
+8 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,3)'=ABMPAR
QUIT
+9 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
QUIT
+10 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($PIECE(^(0),U,7)<DT)
QUIT
+11 SET ABMPSFLG=1
End DoDot:2
End DoDot:1
IF ($GET(ABMPSFLG)=1)
QUIT
+12 SET ABMFLIST(ABMCNT)=ABMPAR
+13 SET ABMCNT=+$GET(ABMCNT)+1
+14 SET ABML=0
+15 FOR
SET ABML=$ORDER(^BAR(90052.05,ABMPAR,ABML))
IF 'ABML
QUIT
Begin DoDot:1
+16 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
QUIT
+17 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($PIECE(^(0),U,7)<DT)
QUIT
+18 IF ABMPAR=ABML
QUIT
+19 SET ABMFLIST(ABMCNT)=ABML
+20 SET ABMCNT=+$GET(ABMCNT)+1
End DoDot:1
+21 QUIT
