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

APCLPYR.m

Go to the documentation of this file. 
  1. APCLPYR ; IHS/CMI/LAB - Patients by Payer (Insurer) - Driver ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ;For Medicare Part D, add the selections fo the prompt below, then
  1.  ;check the subsections in APCLPYR2 (MCR) and APCLPYR5 (RR).
  1.  ;
  1.  D ^XBCLS
  1.  W !,"This option allows you to print a list of patients who are registered at"
  1.  W !,"the facility that you select, who have insurance coverage with the insurer"
  1.  W !,"that you select."
  1.  W !
  1.  ;
  1.  W !,"========================================================================",!
  1.  K DIC,DIR,DIE,DA,DD,DO,DR
  1.  S DIC="^AUTTLOC("
  1.  S DIC(0)="AEQMZ"
  1.  S DIC("A")="Which Facility: "
  1.  S DIC("B")=DUZ(2)
  1.  D ^DIC
  1.  K DIC,DIR,DIE,DA,DD,DO,DR
  1.  I Y<0 Q
  1.  S APCLFAC=+Y
  1.  ;
  1.  W !,"========================================================================",!!
  1.  W "You may select from the following types of insurance"
  1.  K DIR
  1.  S DIR(0)="S^1:Medicare Part A;2:Medicare Part B;3:Medicaid;4:A Selected Private Insurance;5:Railroad Part A;6:Railroad Part B"
  1.  S DIR("A")="Select a type of insurance"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 S APCLTYP="MRA"
  1.  I Y=2 S APCLTYP="MRB"
  1.  I Y=3 S APCLTYP="MCD"
  1.  I Y=4 S APCLTYP="PVT"
  1.  I Y=5 S APCLTYP="RRA"
  1.  I Y=6 S APCLTYP="RRB"
  1.  ;
  1.  I APCLTYP="PVT" D  Q:'APCLPYR
  1.  .W !!,"========================================================================",!
  1.  .S APCLPYR=0
  1.  .K DIC,DD,DA,DIE,DLAYGO,DR,DO
  1.  .S DIC(0)="AEQMZ"
  1.  .S DIC="^AUTNINS("
  1.  .D ^DIC
  1.  .I Y<0 K DIC Q
  1.  .S APCLPYR=+Y
  1.  ;
  1.  I APCLTYP="MCD" D  Q:'APCLMCST
  1.  .W !!,"========================================================================",!
  1.  .S APCLMCST=0,APCLPYR=0
  1.  .K DIC,DIE,DIR,DA,DD,DO,DR
  1.  .S DIC(0)="AEQMZ"
  1.  .S DIC=5
  1.  .S DIC("A")="Select a Medicaid State: "
  1.  .D ^DIC
  1.  .K DIC,DIE,DIR,DA,DD,DO,DR
  1.  .I Y<0 Q
  1.  .S APCLMCST=+Y
  1.  .W !!,"You may further specify a specific Plan Name.  If you don't"
  1.  .W !,"enter a Plan Name, then all Plans for that state will be"
  1.  .W !,"selected.",!
  1.  .S DIC(0)="AEQMZ"
  1.  .S DIC("A")="Select a Medicaid Plan Name (optional): "
  1.  .S DIC="^AUTNINS("
  1.  .D ^DIC
  1.  .K DIC,DIE,DIR,DR,DA,DD,DO
  1.  .I Y<0 Q
  1.  .S APCLPYR=+Y
  1.  ;
  1.  ;
  1.  W !!,"========================================================================",!!
  1.  W "Do you want patients that only have this one insurer (no other coverage)?",!
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("B")="N"
  1.  D ^DIR
  1.  I $D(DIRUT) K APCLPYR,DIR Q
  1.  S APCLOTH=0
  1.  I Y=1 S APCLOTH=1
  1.  ;
  1.  W !!,"========================================================================",!!
  1.  W "You may select eligibility in three different ways"
  1.  K DIR
  1.  S DIR(0)="S^1:Currently Active Eligibility Dates;2:Any Past or Current Eligibility Dates;3:Selected Eligibility Dates"
  1.  S DIR("A")="Select Type of Eligibility Dates"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 S APCLACT=1,APCLBDAT=DT,APCLEDAT=DT
  1.  I Y=2 S APCLACT=0,APCLBDAT=0,APCLEDAT=0
  1.  I Y=3 D
  1.  .S APCLACT=1
  1.  .W !
  1.  .S %DT="AE"
  1.  .S %DT("A")="Enter a Beginning Eligibility Date: "
  1.  .D ^%DT
  1.  .S APCLBDAT=0
  1.  .I Y>0 S APCLBDAT=Y
  1.  .S %DT="AE"
  1.  .S %DT("A")="Enter an Ending Eligibility Date: "
  1.  .D ^%DT
  1.  .S APCLEDAT=0
  1.  .I Y>0 S APCLEDAT=Y
  1.  .W !!
  1.  .W "Restrict the report to eligibility dates starting after ",$E(APCLBDAT,4,5),"/",$E(APCLBDAT,6,7),"/",$E(APCLBDAT,2,3),"?",!
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .S DIR("B")="N"
  1.  .D ^DIR
  1.  .I Y=1 S APCLACT=2
  1.  ;
  1.  I APCLTYP="PVT" S APCLALL=0
  1.  I APCLTYP'="PVT" D
  1.  .W !!,"========================================================================",!!
  1.  .W "Do you want to print all beginning and ending eligibility date pairs?",!
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .S DIR("B")="N"
  1.  .D ^DIR
  1.  .I $D(DIRUT) K APCLPYR,APCLBDAT,APCLEDAT,APCLACT,DIR Q
  1.  .S APCLALL=0
  1.  .I Y=1 S APCLALL=1
  1.  ;
  1.  W !!,"========================================================================",!!
  1.  W "How do you want this report sorted?"
  1.  K DIR
  1.  S DIR(0)="S^1:Patient Name;2:Patient HRNO"
  1.  S DIR("A")="Sort the Report By"
  1.  S DIR("B")=1
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y=1 S APCLSORT="NAME"
  1.  I Y=2 S APCLSORT="HRNO"
  1.  ;
  1.  W !!,"========================================================================",!
  1.  S XBRP="EN^APCLPYR"
  1.  S XBNS="APCL"
  1.  S XBRX="EOJ^APCLPYR"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. EOJ ;
  1.  X ^%ZIS("C")
  1.  K ^TMP($J,"APCLPYR")
  1.  D EN^XBVK("APCL")
  1.  K DIR,DIE,DIC,DA,DD,DR,DO,DLAYGO
  1.  Q
  1.  ;
  1. EN ;
  1.  K DUOUT,DTOUT,DFOUT
  1.  ;I $D(ZTSK) K ^%ZTSK(ZTSK)
  1.  U IO
  1.  ;
  1.  I APCLTYP="MRA" D MRALOOP^APCLPYR2
  1.  I APCLTYP="MRB" D MRBLOOP^APCLPYR2
  1.  I APCLTYP="MRD" D MRDLOOP^APCLPYR2
  1.  I APCLTYP="MCD" D MCDLOOP^APCLPYR3
  1.  I APCLTYP="PVT" D PVTLOOP^APCLPYR4
  1.  I APCLTYP="RRA" D RRALOOP^APCLPYR5
  1.  I APCLTYP="RRB" D RRBLOOP^APCLPYR5
  1.  I APCLTYP="RRD" D RRDLOOP^APCLPYR5
  1.  Q