Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMMUMUP

ABMMUMUP.m

Go to the documentation of this file.
  1. ABMMUMUP ;IHS/SD/SDR - MU Report Parameters ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009
  1. ;
  1. W !!
  1. I $P($G(^ABMMUPRM(1,0)),U,2)'="" D Q
  1. .W !!,"Setup has already been done. Contact OIT if changes need to be made",!
  1. .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1. D ^XBFMK
  1. S DIR(0)="Y"
  1. S DIR("A",1)="You are setting up the Report Parameters. Once completed, you will not be able to edit."
  1. S DIR("A")="Continue"
  1. S DIR("B")="N"
  1. D ^DIR K DIR
  1. Q:Y<1
  1. D ^XBFMK
  1. S DIR(0)="Y"
  1. S DIR("A")="Do you wish to designate a Facility as an FQHC or RHC"
  1. D ^DIR K DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. S ABMANS=+Y
  1. EN ;
  1. I ABMANS=1 D
  1. .D GETFACS
  1. .W !!
  1. .S ABMCNT=0,ABMDIR=""
  1. .F S ABMCNT=$O(ABMFLIST(ABMCNT)) Q:'ABMCNT D
  1. ..W !?2,ABMCNT_".",?6,$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
  1. ..S:ABMDIR'="" ABMDIR=ABMDIR_";"_ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
  1. ..S:ABMDIR="" ABMDIR=ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
  1. .S ABMCNT=$O(ABMFLIST(99999),-1) ;get last entry#
  1. .S (ABMCNT,ABMTOT)=ABMCNT+1
  1. .W !!
  1. .K ABMFANS,ABMF
  1. .F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) ;they didn't answer
  1. ..D ^XBFMK
  1. ..S DIR(0)="SAO^"_$G(ABMDIR)
  1. ..S DIR("A")="Select one or more facilities to designate as an FQHC or RHC: "
  1. ..D ^DIR K DIR
  1. ..Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. ..Q:+$G(Y)<0
  1. ..S ABMFANS=Y
  1. ..S ABMF($G(ABMFLIST(ABMFANS)))=""
  1. ..D ^XBFMK
  1. ..S DIR(0)="Y"
  1. ..S DIR("A")="Is this FQHC led by a PA? "
  1. ..D ^DIR K DIR
  1. ..Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. ..S ABMF($G(ABMFLIST(ABMFANS)))=Y
  1. ..I ABMFANS=(ABMCNT+1) D
  1. ...S ABMCNT=0
  1. ...F S ABMCNT=$O(ABMF(ABMCNT)) Q:'ABMCNT S ABMF($G(ABMFLIST(ABMFANS)))=ABMFANS2
  1. I $D(ABMF) D
  1. .W !!!,"The following have been identified by you as FQHC/RHC facilities"
  1. .S ABMCNT=0
  1. .F S ABMCNT=$O(ABMF(ABMCNT)) Q:'ABMCNT D
  1. ..W !?2,$$GET1^DIQ(9999999.06,ABMCNT,.01,"E")
  1. ..W:+$G(ABMF(ABMCNT))=0 " (FQHC)"
  1. ..W:+$G(ABMF(ABMCNT))=1 " (FQHC led by PA)"
  1. .D ^XBFMK
  1. .S DIR(0)="Y"
  1. .S DIR("A",1)=""
  1. .S DIR("A",2)="By answering YES the entries below will be added and the list may not be edited without contacting OIT"
  1. .S DIR("A",3)=""
  1. .S DIR("A")="Are you sure"
  1. .D ^DIR K DIR
  1. .Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. .S ABMFANS=Y
  1. S DIE="^ABMMUPRM("
  1. S DR=".02////Y"
  1. S DA=1
  1. D ^DIE
  1. ;
  1. S ABMLOC=0
  1. F S ABMLOC=$O(ABMF(ABMLOC)) Q:'ABMLOC D ADDENTRY(ABMLOC)
  1. K ABMDIR,ABMFLIST
  1. W !!,"Some states consider Optometrists, Podiatrists, etc., as Physicians."
  1. W !!,"The next prompt will allow the identification of these provider classes as"
  1. W !,"EP types to generate volume reports."
  1. W !!,"Please note: Defaults have been provided so there are already entries in this"
  1. W !,"file that don't need to be entered again."
  1. D ^XBFMK
  1. S DIR(0)="Y"
  1. S DIR("A")="Are there additional EP types for your state"
  1. D ^DIR K DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. Q:Y=0
  1. F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. .D ^XBFMK
  1. .S DA(1)=1
  1. .S DIC="^ABMMUPRM("_DA(1)_",2,"
  1. .S DIC("P")=$P(^DD(9002274.55,2,0),U,2)
  1. .S DIC(0)="AELMQ"
  1. .D ^DIC
  1. Q
  1. ADDENTRY(ABMLOC) ;
  1. D ^XBFMK
  1. S DA(1)=1
  1. S DIC="^ABMMUPRM("_DA(1)_",1,"
  1. S DIC("P")=$P(^DD(9002274.55,1,0),U,2)
  1. S DIC(0)="LMQ"
  1. S X="`"_ABMLOC
  1. D ^DIC
  1. ;start old code abm*2.6*8
  1. ;S DIE=DIC
  1. ;S DA(1)=1
  1. ;S DA=ABMLOC
  1. ;end old code start new code
  1. S ABMIEN=+Y
  1. D ^XBFMK
  1. S DA(1)=1
  1. S DA=ABMIEN
  1. S DIE="^ABMMUPRM("_DA(1)_",1,"
  1. ;end new code
  1. S DR=".02////"_$G(ABMF(ABMLOC))
  1. D ^DIE
  1. Q
  1. GETFACS ;EP
  1. K ABMPSFLG,ABMFLIST
  1. S ABMPAR=0
  1. S ABMCNT=1
  1. F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
  1. .I $D(^BAR(90052.05,ABMPAR,DUZ(2))) D
  1. ..; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
  1. ..; visit location
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,3)'=ABMPAR
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<DT)
  1. ..S ABMPSFLG=1
  1. S ABMFLIST(ABMCNT)=ABMPAR
  1. S ABMCNT=+$G(ABMCNT)+1
  1. S ABML=0
  1. F S ABML=$O(^BAR(90052.05,ABMPAR,ABML)) Q:'ABML D
  1. .Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>DT
  1. .Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<DT)
  1. .Q:ABMPAR=ABML
  1. .S ABMFLIST(ABMCNT)=ABML
  1. .S ABMCNT=+$G(ABMCNT)+1
  1. Q