- ABMMUMUP ;IHS/SD/SDR - MU Report Parameters ;
- ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009
- ;
- W !!
- I $P($G(^ABMMUPRM(1,0)),U,2)'="" D Q
- .W !!,"Setup has already been done. Contact OIT if changes need to be made",!
- .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
- 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 or RHC"
- 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: "
- ..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? "
- ..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"
- .S ABMCNT=0
- .F S ABMCNT=$O(ABMF(ABMCNT)) Q:'ABMCNT D
- ..W !?2,$$GET1^DIQ(9999999.06,ABMCNT,.01,"E")
- ..W:+$G(ABMF(ABMCNT))=0 " (FQHC)"
- ..W:+$G(ABMF(ABMCNT))=1 " (FQHC led by PA)"
- .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
- ABMMUMUP ;IHS/SD/SDR - MU Report Parameters ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009
- +2 ;
- +3 WRITE !!
- +4 IF $PIECE($GET(^ABMMUPRM(1,0)),U,2)'=""
- Begin DoDot:1
- +5 WRITE !!,"Setup has already been done. Contact OIT if changes need to be made",!
- +6 SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +7 DO ^XBFMK
- +8 SET DIR(0)="Y"
- +9 SET DIR("A",1)="You are setting up the Report Parameters. Once completed, you will not be able to edit."
- +10 SET DIR("A")="Continue"
- +11 SET DIR("B")="N"
- +12 DO ^DIR
- KILL DIR
- +13 IF Y<1
- QUIT
- +14 DO ^XBFMK
- +15 SET DIR(0)="Y"
- +16 SET DIR("A")="Do you wish to designate a Facility as an FQHC or RHC"
- +17 DO ^DIR
- KILL DIR
- +18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +19 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 SET DIR("A")="Select one or more facilities to designate as an FQHC or RHC: "
- +17 DO ^DIR
- KILL DIR
- +18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +19 IF +$GET(Y)<0
- QUIT
- +20 SET ABMFANS=Y
- +21 SET ABMF($GET(ABMFLIST(ABMFANS)))=""
- +22 DO ^XBFMK
- +23 SET DIR(0)="Y"
- +24 SET DIR("A")="Is this FQHC led by a PA? "
- +25 DO ^DIR
- KILL DIR
- +26 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +27 SET ABMF($GET(ABMFLIST(ABMFANS)))=Y
- +28 IF ABMFANS=(ABMCNT+1)
- Begin DoDot:3
- +29 SET ABMCNT=0
- +30 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
- +31 IF $DATA(ABMF)
- Begin DoDot:1
- +32 WRITE !!!,"The following have been identified by you as FQHC/RHC facilities"
- +33 SET ABMCNT=0
- +34 FOR
- SET ABMCNT=$ORDER(ABMF(ABMCNT))
- IF 'ABMCNT
- QUIT
- Begin DoDot:2
- +35 WRITE !?2,$$GET1^DIQ(9999999.06,ABMCNT,.01,"E")
- +36 IF +$GET(ABMF(ABMCNT))=0
- WRITE " (FQHC)"
- +37 IF +$GET(ABMF(ABMCNT))=1
- WRITE " (FQHC led by PA)"
- End DoDot:2
- +38 DO ^XBFMK
- +39 SET DIR(0)="Y"
- +40 SET DIR("A",1)=""
- +41 SET DIR("A",2)="By answering YES the entries below will be added and the list may not be edited without contacting OIT"
- +42 SET DIR("A",3)=""
- +43 SET DIR("A")="Are you sure"
- +44 DO ^DIR
- KILL DIR
- +45 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +46 SET ABMFANS=Y
- End DoDot:1
- +47 SET DIE="^ABMMUPRM("
- +48 SET DR=".02////Y"
- +49 SET DA=1
- +50 DO ^DIE
- +51 ;
- +52 SET ABMLOC=0
- +53 FOR
- SET ABMLOC=$ORDER(ABMF(ABMLOC))
- IF 'ABMLOC
- QUIT
- DO ADDENTRY(ABMLOC)
- +54 KILL ABMDIR,ABMFLIST
- +55 WRITE !!,"Some states consider Optometrists, Podiatrists, etc., as Physicians."
- +56 WRITE !!,"The next prompt will allow the identification of these provider classes as"
- +57 WRITE !,"EP types to generate volume reports."
- +58 WRITE !!,"Please note: Defaults have been provided so there are already entries in this"
- +59 WRITE !,"file that don't need to be entered again."
- +60 DO ^XBFMK
- +61 SET DIR(0)="Y"
- +62 SET DIR("A")="Are there additional EP types for your state"
- +63 DO ^DIR
- KILL DIR
- +64 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +65 IF Y=0
- QUIT
- +66 FOR
- Begin DoDot:1
- +67 DO ^XBFMK
- +68 SET DA(1)=1
- +69 SET DIC="^ABMMUPRM("_DA(1)_",2,"
- +70 SET DIC("P")=$PIECE(^DD(9002274.55,2,0),U,2)
- +71 SET DIC(0)="AELMQ"
- +72 DO ^DIC
- End DoDot:1
- IF +$GET(Y)<0!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +73 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