APCLPYR ; IHS/CMI/LAB - Patients by Payer (Insurer) - Driver ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;For Medicare Part D, add the selections fo the prompt below, then
;check the subsections in APCLPYR2 (MCR) and APCLPYR5 (RR).
;
D ^XBCLS
W !,"This option allows you to print a list of patients who are registered at"
W !,"the facility that you select, who have insurance coverage with the insurer"
W !,"that you select."
W !
;
W !,"========================================================================",!
K DIC,DIR,DIE,DA,DD,DO,DR
S DIC="^AUTTLOC("
S DIC(0)="AEQMZ"
S DIC("A")="Which Facility: "
S DIC("B")=DUZ(2)
D ^DIC
K DIC,DIR,DIE,DA,DD,DO,DR
I Y<0 Q
S APCLFAC=+Y
;
W !,"========================================================================",!!
W "You may select from the following types of insurance"
K DIR
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"
S DIR("A")="Select a type of insurance"
D ^DIR
I $D(DIRUT) Q
I Y=1 S APCLTYP="MRA"
I Y=2 S APCLTYP="MRB"
I Y=3 S APCLTYP="MCD"
I Y=4 S APCLTYP="PVT"
I Y=5 S APCLTYP="RRA"
I Y=6 S APCLTYP="RRB"
;
I APCLTYP="PVT" D Q:'APCLPYR
.W !!,"========================================================================",!
.S APCLPYR=0
.K DIC,DD,DA,DIE,DLAYGO,DR,DO
.S DIC(0)="AEQMZ"
.S DIC="^AUTNINS("
.D ^DIC
.I Y<0 K DIC Q
.S APCLPYR=+Y
;
I APCLTYP="MCD" D Q:'APCLMCST
.W !!,"========================================================================",!
.S APCLMCST=0,APCLPYR=0
.K DIC,DIE,DIR,DA,DD,DO,DR
.S DIC(0)="AEQMZ"
.S DIC=5
.S DIC("A")="Select a Medicaid State: "
.D ^DIC
.K DIC,DIE,DIR,DA,DD,DO,DR
.I Y<0 Q
.S APCLMCST=+Y
.W !!,"You may further specify a specific Plan Name. If you don't"
.W !,"enter a Plan Name, then all Plans for that state will be"
.W !,"selected.",!
.S DIC(0)="AEQMZ"
.S DIC("A")="Select a Medicaid Plan Name (optional): "
.S DIC="^AUTNINS("
.D ^DIC
.K DIC,DIE,DIR,DR,DA,DD,DO
.I Y<0 Q
.S APCLPYR=+Y
;
;
W !!,"========================================================================",!!
W "Do you want patients that only have this one insurer (no other coverage)?",!
K DIR
S DIR(0)="Y"
S DIR("B")="N"
D ^DIR
I $D(DIRUT) K APCLPYR,DIR Q
S APCLOTH=0
I Y=1 S APCLOTH=1
;
W !!,"========================================================================",!!
W "You may select eligibility in three different ways"
K DIR
S DIR(0)="S^1:Currently Active Eligibility Dates;2:Any Past or Current Eligibility Dates;3:Selected Eligibility Dates"
S DIR("A")="Select Type of Eligibility Dates"
D ^DIR
I $D(DIRUT) Q
I Y=1 S APCLACT=1,APCLBDAT=DT,APCLEDAT=DT
I Y=2 S APCLACT=0,APCLBDAT=0,APCLEDAT=0
I Y=3 D
.S APCLACT=1
.W !
.S %DT="AE"
.S %DT("A")="Enter a Beginning Eligibility Date: "
.D ^%DT
.S APCLBDAT=0
.I Y>0 S APCLBDAT=Y
.S %DT="AE"
.S %DT("A")="Enter an Ending Eligibility Date: "
.D ^%DT
.S APCLEDAT=0
.I Y>0 S APCLEDAT=Y
.W !!
.W "Restrict the report to eligibility dates starting after ",$E(APCLBDAT,4,5),"/",$E(APCLBDAT,6,7),"/",$E(APCLBDAT,2,3),"?",!
.K DIR
.S DIR(0)="Y"
.S DIR("B")="N"
.D ^DIR
.I Y=1 S APCLACT=2
;
I APCLTYP="PVT" S APCLALL=0
I APCLTYP'="PVT" D
.W !!,"========================================================================",!!
.W "Do you want to print all beginning and ending eligibility date pairs?",!
.K DIR
.S DIR(0)="Y"
.S DIR("B")="N"
.D ^DIR
.I $D(DIRUT) K APCLPYR,APCLBDAT,APCLEDAT,APCLACT,DIR Q
.S APCLALL=0
.I Y=1 S APCLALL=1
;
W !!,"========================================================================",!!
W "How do you want this report sorted?"
K DIR
S DIR(0)="S^1:Patient Name;2:Patient HRNO"
S DIR("A")="Sort the Report By"
S DIR("B")=1
D ^DIR
I $D(DIRUT) Q
I Y=1 S APCLSORT="NAME"
I Y=2 S APCLSORT="HRNO"
;
W !!,"========================================================================",!
S XBRP="EN^APCLPYR"
S XBNS="APCL"
S XBRX="EOJ^APCLPYR"
D ^XBDBQUE
Q
;
EOJ ;
X ^%ZIS("C")
K ^TMP($J,"APCLPYR")
D EN^XBVK("APCL")
K DIR,DIE,DIC,DA,DD,DR,DO,DLAYGO
Q
;
EN ;
K DUOUT,DTOUT,DFOUT
;I $D(ZTSK) K ^%ZTSK(ZTSK)
U IO
;
I APCLTYP="MRA" D MRALOOP^APCLPYR2
I APCLTYP="MRB" D MRBLOOP^APCLPYR2
I APCLTYP="MRD" D MRDLOOP^APCLPYR2
I APCLTYP="MCD" D MCDLOOP^APCLPYR3
I APCLTYP="PVT" D PVTLOOP^APCLPYR4
I APCLTYP="RRA" D RRALOOP^APCLPYR5
I APCLTYP="RRB" D RRBLOOP^APCLPYR5
I APCLTYP="RRD" D RRDLOOP^APCLPYR5
Q
APCLPYR ; IHS/CMI/LAB - Patients by Payer (Insurer) - Driver ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;For Medicare Part D, add the selections fo the prompt below, then
+4 ;check the subsections in APCLPYR2 (MCR) and APCLPYR5 (RR).
+5 ;
+6 DO ^XBCLS
+7 WRITE !,"This option allows you to print a list of patients who are registered at"
+8 WRITE !,"the facility that you select, who have insurance coverage with the insurer"
+9 WRITE !,"that you select."
+10 WRITE !
+11 ;
+12 WRITE !,"========================================================================",!
+13 KILL DIC,DIR,DIE,DA,DD,DO,DR
+14 SET DIC="^AUTTLOC("
+15 SET DIC(0)="AEQMZ"
+16 SET DIC("A")="Which Facility: "
+17 SET DIC("B")=DUZ(2)
+18 DO ^DIC
+19 KILL DIC,DIR,DIE,DA,DD,DO,DR
+20 IF Y<0
QUIT
+21 SET APCLFAC=+Y
+22 ;
+23 WRITE !,"========================================================================",!!
+24 WRITE "You may select from the following types of insurance"
+25 KILL DIR
+26 SET 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"
+27 SET DIR("A")="Select a type of insurance"
+28 DO ^DIR
+29 IF $DATA(DIRUT)
QUIT
+30 IF Y=1
SET APCLTYP="MRA"
+31 IF Y=2
SET APCLTYP="MRB"
+32 IF Y=3
SET APCLTYP="MCD"
+33 IF Y=4
SET APCLTYP="PVT"
+34 IF Y=5
SET APCLTYP="RRA"
+35 IF Y=6
SET APCLTYP="RRB"
+36 ;
+37 IF APCLTYP="PVT"
Begin DoDot:1
+38 WRITE !!,"========================================================================",!
+39 SET APCLPYR=0
+40 KILL DIC,DD,DA,DIE,DLAYGO,DR,DO
+41 SET DIC(0)="AEQMZ"
+42 SET DIC="^AUTNINS("
+43 DO ^DIC
+44 IF Y<0
KILL DIC
QUIT
+45 SET APCLPYR=+Y
End DoDot:1
IF 'APCLPYR
QUIT
+46 ;
+47 IF APCLTYP="MCD"
Begin DoDot:1
+48 WRITE !!,"========================================================================",!
+49 SET APCLMCST=0
SET APCLPYR=0
+50 KILL DIC,DIE,DIR,DA,DD,DO,DR
+51 SET DIC(0)="AEQMZ"
+52 SET DIC=5
+53 SET DIC("A")="Select a Medicaid State: "
+54 DO ^DIC
+55 KILL DIC,DIE,DIR,DA,DD,DO,DR
+56 IF Y<0
QUIT
+57 SET APCLMCST=+Y
+58 WRITE !!,"You may further specify a specific Plan Name. If you don't"
+59 WRITE !,"enter a Plan Name, then all Plans for that state will be"
+60 WRITE !,"selected.",!
+61 SET DIC(0)="AEQMZ"
+62 SET DIC("A")="Select a Medicaid Plan Name (optional): "
+63 SET DIC="^AUTNINS("
+64 DO ^DIC
+65 KILL DIC,DIE,DIR,DR,DA,DD,DO
+66 IF Y<0
QUIT
+67 SET APCLPYR=+Y
End DoDot:1
IF 'APCLMCST
QUIT
+68 ;
+69 ;
+70 WRITE !!,"========================================================================",!!
+71 WRITE "Do you want patients that only have this one insurer (no other coverage)?",!
+72 KILL DIR
+73 SET DIR(0)="Y"
+74 SET DIR("B")="N"
+75 DO ^DIR
+76 IF $DATA(DIRUT)
KILL APCLPYR,DIR
QUIT
+77 SET APCLOTH=0
+78 IF Y=1
SET APCLOTH=1
+79 ;
+80 WRITE !!,"========================================================================",!!
+81 WRITE "You may select eligibility in three different ways"
+82 KILL DIR
+83 SET DIR(0)="S^1:Currently Active Eligibility Dates;2:Any Past or Current Eligibility Dates;3:Selected Eligibility Dates"
+84 SET DIR("A")="Select Type of Eligibility Dates"
+85 DO ^DIR
+86 IF $DATA(DIRUT)
QUIT
+87 IF Y=1
SET APCLACT=1
SET APCLBDAT=DT
SET APCLEDAT=DT
+88 IF Y=2
SET APCLACT=0
SET APCLBDAT=0
SET APCLEDAT=0
+89 IF Y=3
Begin DoDot:1
+90 SET APCLACT=1
+91 WRITE !
+92 SET %DT="AE"
+93 SET %DT("A")="Enter a Beginning Eligibility Date: "
+94 DO ^%DT
+95 SET APCLBDAT=0
+96 IF Y>0
SET APCLBDAT=Y
+97 SET %DT="AE"
+98 SET %DT("A")="Enter an Ending Eligibility Date: "
+99 DO ^%DT
+100 SET APCLEDAT=0
+101 IF Y>0
SET APCLEDAT=Y
+102 WRITE !!
+103 WRITE "Restrict the report to eligibility dates starting after ",$EXTRACT(APCLBDAT,4,5),"/",$EXTRACT(APCLBDAT,6,7),"/",$EXTRACT(APCLBDAT,2,3),"?",!
+104 KILL DIR
+105 SET DIR(0)="Y"
+106 SET DIR("B")="N"
+107 DO ^DIR
+108 IF Y=1
SET APCLACT=2
End DoDot:1
+109 ;
+110 IF APCLTYP="PVT"
SET APCLALL=0
+111 IF APCLTYP'="PVT"
Begin DoDot:1
+112 WRITE !!,"========================================================================",!!
+113 WRITE "Do you want to print all beginning and ending eligibility date pairs?",!
+114 KILL DIR
+115 SET DIR(0)="Y"
+116 SET DIR("B")="N"
+117 DO ^DIR
+118 IF $DATA(DIRUT)
KILL APCLPYR,APCLBDAT,APCLEDAT,APCLACT,DIR
QUIT
+119 SET APCLALL=0
+120 IF Y=1
SET APCLALL=1
End DoDot:1
+121 ;
+122 WRITE !!,"========================================================================",!!
+123 WRITE "How do you want this report sorted?"
+124 KILL DIR
+125 SET DIR(0)="S^1:Patient Name;2:Patient HRNO"
+126 SET DIR("A")="Sort the Report By"
+127 SET DIR("B")=1
+128 DO ^DIR
+129 IF $DATA(DIRUT)
QUIT
+130 IF Y=1
SET APCLSORT="NAME"
+131 IF Y=2
SET APCLSORT="HRNO"
+132 ;
+133 WRITE !!,"========================================================================",!
+134 SET XBRP="EN^APCLPYR"
+135 SET XBNS="APCL"
+136 SET XBRX="EOJ^APCLPYR"
+137 DO ^XBDBQUE
+138 QUIT
+139 ;
EOJ ;
+1 XECUTE ^%ZIS("C")
+2 KILL ^TMP($JOB,"APCLPYR")
+3 DO EN^XBVK("APCL")
+4 KILL DIR,DIE,DIC,DA,DD,DR,DO,DLAYGO
+5 QUIT
+6 ;
EN ;
+1 KILL DUOUT,DTOUT,DFOUT
+2 ;I $D(ZTSK) K ^%ZTSK(ZTSK)
+3 USE IO
+4 ;
+5 IF APCLTYP="MRA"
DO MRALOOP^APCLPYR2
+6 IF APCLTYP="MRB"
DO MRBLOOP^APCLPYR2
+7 IF APCLTYP="MRD"
DO MRDLOOP^APCLPYR2
+8 IF APCLTYP="MCD"
DO MCDLOOP^APCLPYR3
+9 IF APCLTYP="PVT"
DO PVTLOOP^APCLPYR4
+10 IF APCLTYP="RRA"
DO RRALOOP^APCLPYR5
+11 IF APCLTYP="RRB"
DO RRBLOOP^APCLPYR5
+12 IF APCLTYP="RRD"
DO RRDLOOP^APCLPYR5
+13 QUIT
