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

ABMM2MUP.m

Go to the documentation of this file. 
  1. ABMM2MUP ;IHS/SD/SDR - MU Report Parameters ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
  1.  ;IHS/SD/SDR - 2.6*12 - Updated FQHC/RHC/Tribal to include Urban
  1.  ;
  1.  ;
  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.  .W !,"Will display current setup next...",!
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
  1.  .D DIC^ABMMUINQ
  1.  .W !!
  1.  ;
  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, RHC or Tribal clinic"  ;abm*2.6*12 include Urban
  1.  S DIR("A")="Do you wish to designate a Facility as an FQHC, RHC, Tribal or Urban clinic"  ;abm*2.6*12 include Urban
  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: "  ;abm*2.6*10 HEAT61752
  1.  ..;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
  1.  ..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
  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? "  ;abm*2.6*10 HEAT61752
  1.  ..;S DIR("A")="Is this FQHC/RHC/Tribal clinic led by a PA? "  ;abm*2.6*10 HEAT61752  ;abm*2.6*12 include Urban
  1.  ..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
  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"  ;abm*2.6*10 HEAT61752
  1.  .;W !!!,"The following have been identified by you as FQHC/RHC/Tribal facilities"  ;abm*2.6*10 HEAT61752  ;abm*2.6*12 include Urban
  1.  .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
  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.  ..;start old code abm*2.6*10 HEAT61752
  1.  ..;W:+$G(ABMF(ABMCNT))=0 " (FQHC)"
  1.  ..;W:+$G(ABMF(ABMCNT))=1 " (FQHC led by PA)"
  1.  ..;end old code start new code HEAT61752
  1.  ..;start old code abm*2.6*12 include Urban
  1.  ..;W:+$G(ABMF(ABMCNT))=0 " (FQHC/RHC/Tribal)"
  1.  ..;W:+$G(ABMF(ABMCNT))=1 " (FQHC/RHC/Tribal led by PA)"
  1.  ..;end old code start new code include Urban
  1.  ..W:+$G(ABMF(ABMCNT))=0 " (FQHC/RHC/Tribal/Urban)"
  1.  ..W:+$G(ABMF(ABMCNT))=1 " (FQHC/RHC/Tribal/Urban led by PA)"
  1.  ..;end new code include Urban
  1.  ..;end new code HEAT61752
  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