AG3RDP ;IHS/ASDS/SDH - COUNT 3RD PARTY RESOURCE PATIENTS ;
;;7.1;IHS PATIENT REGISTRATION;**2,4**;JAN 31, 2007
;
INTRO ;
;;
;;3RD PARTY ELIGIBLITY COUNT PROCESS!
;;-----------------------------------
;;This report counts the number of patients that have 3rd Party
;;insurance on a selected date.
;;
;;###
W @IOF
F AG=1:1 W $$CJ^XLFSTR($P($T(INTRO+AG),";",3),IOM) Q:$P($T(INTRO+AG+1),";",3)="###"
;
DATE ; Input date to check for eligibility.
S AGDT=$$DIR^XBDIR("D","Date for the point in Time you want eligibility for")
I $D(DIRUT) D EOJ Q
VSTCK ; Input check-active flag.
S AGVCK=$$DIR^XBDIR("Y","Want to check if patient is active")
I $D(DIRUT) D EOJ Q
DEV ; Select Device.
W !!
KILL IOP
S %ZIS="PQ"
KILL IO("Q")
D ^%ZIS
I POP D EOJ Q
I $D(IO("Q")) D TASK,EOJ Q
START ;EP - From TaskMan.
;AG*7.1*2 ALPHA ISSUE ADD DATE/TIME STAMP TO AID IN BEFORE/AFTER COMPARISONS FOR CMS DOWNLOAD
N AGNOW
D NOW^%DTC
S Y=% X ^DD("DD")
S AGNOW=Y
;AG*7.1*2 END
KILL ^TMP("AG3RDP",$J)
D MCR,MCD,PI,RPT,EOJ
Q
;
MCR ; Process MediCare file. Record the counts
I '$D(ZTQUEUED),$E(IOST)="C" U IO(0) W !,"Processing Medicare......"
S DFN=0
F S DFN=$O(^AUPNMCR(DFN)) Q:+DFN=0 D
. I $P($G(^DPT(DFN,.35)),U)'="",($P($G(^DPT(DFN,.35)),U)'>AGDT) Q
. S AGM=0
. F S AGM=$O(^AUPNMCR(DFN,11,AGM)) Q:+AGM=0 D
.. S AGST=$P($G(^AUPNMCR(DFN,11,AGM,0)),U)
.. S AGEND=$P($G(^AUPNMCR(DFN,11,AGM,0)),U,2)
.. S AGTY=$P($G(^AUPNMCR(DFN,11,AGM,0)),U,3)
.. S AG("MCR")="N"
.. I (AGDT'<AGST),(AGEND="") S AG("MCR")="Y"
.. E I (AGDT'<AGST),(AGDT'>AGEND) S AG("MCR")="Y"
.. ;I AG("MCR")="Y" S $P(^TMP("AG3RDP",$J,DFN),U,$S(AGTY="B":4,1:3))=1
.. I AG("MCR")="Y" S $P(^TMP("AG3RDP",$J,DFN),U,$S(AGTY="B":4,AGTY="A":3,1:5))=1 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PG 11
..Q
.Q
Q
;
MCD ; Process MediCaid file. Record the counts
I '$D(ZTQUEUED),$E(IOST)="C" U IO(0) W !!,"Processing Medicaid...."
S AG=0
F S AG=$O(^AUPNMCD(AG)) Q:+AG=0 D
. S DFN=$P($G(^AUPNMCD(AG,0)),U)
. I 'DFN W !,DFN
. Q:'DFN
. I $P($G(^DPT(DFN,.35)),U)'="",($P($G(^DPT(DFN,.35)),U)'>AGDT) Q
. S AGM=0,AG("MCD")="N"
. F S AGM=$O(^AUPNMCD(AG,11,AGM)) Q:+AGM=0 D Q:AG("MCD")="Y"
.. S AGST=$P($G(^AUPNMCD(AG,11,AGM,0)),U)
.. S AGEND=$P($G(^AUPNMCD(AG,11,AGM,0)),U,2)
.. I $E(AGEND,6,7)="00" S AGEND=AGEND+31
.. I (AGDT'<AGST),(AGEND="") S AG("MCD")="Y"
.. E I (AGDT'<AGST),(AGDT'>AGEND) S AG("MCD")="Y"
.. I AG("MCD")="Y" S $P(^TMP("AG3RDP",$J,DFN),U,1)=1
..Q
.Q
Q
;
PI ; Process Private Insurance file. Record the counts
I '$D(ZTQUEUED),$E(IOST)="C" U IO(0) W !!,"Processing Private Ins......."
S DFN=0
F S DFN=$O(^AUPNPRVT(DFN)) Q:+DFN=0 I $$PI^AUPNPAT(DFN,AGDT) S $P(^TMP("AG3RDP",$J,DFN),U,2)=1
Q
;
RPT ;
K AGST,AGEND,AG,AGM,DIR
U IO
D EN
Q
;
EOJ ;
D ^%ZISC
K AGDT,AGST,AGTY,AGVCK,DIR,DFN
K ^TMP("AG3RDP",$J)
Q
;
TASK ;
K ZTSAVE
S ZTSAVE("AGDT")="",ZTSAVE("AGVCK")="",ZTIO=ION,ZTRTN="START^AG3RDP",ZTDTH="",ZTDESC="3RD PARTY ELIGIBILITY REPORT"
D ^%ZTLOAD
Q
;
EN ;
S (AG,AGMCD,AGPI,AGMCR,AGMCRB,AGMMPI,AGMM,AGMDPI,AGMRPI,AGMCRAB)=0
S AGMCRD=0 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
S AG("BDT")=9999999-(AGDT-30001),AG("EDT")=9999999-(AGDT-1)
S DFN=0
F S DFN=$O(^TMP("AG3RDP",$J,DFN)) Q:+DFN=0 D
.I $G(AGVCK)=1 D VCHK Q:AG("V")="N"
.S AG=$G(^TMP("AG3RDP",$J,DFN))
.;F %=1:1:4 S @("AG"_%)=+$P(AG,U,%)
.F %=1:1:5 S @("AG"_%)=+$P(AG,U,%) ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
.;I AG1=0,AG2=0,AG3=0,AG4=0,AG5=1 S AGMCRD=AGMCRD+1 Q
.I AG5=1 S AGMCRD=AGMCRD+1 Q ;AG*7.1*2 ITEM 8 PAGE 11 SPECS CHANGED PER BPD MEETING OF 8/18/2006
.I AG1=1,AG2=0,AG3=0,AG4=0 S AGMCD=AGMCD+1 Q
.I AG1=0,AG2=1,AG3=0,AG4=0 S AGPI=AGPI+1 Q
.I AG1=0,AG2=0,AG3=1,AG4=0 S AGMCR=AGMCR+1 Q
.I AG1=0,AG2=0,AG3=0,AG4=1 S AGMCRB=AGMCRB+1 Q
.I AG1=0,AG2=0,AG3=1,AG4=1 S AGMCRAB=AGMCRAB+1 Q
.I AG1=1,AG2=1,((AG3=1)!(AG4=1)) S AGMMPI=AGMMPI+1 Q
.I AG1=1,((AG3=1)!(AG4=1)) S AGMM=AGMM+1 Q
.I AG1=1,AG2=1 S AGMDPI=AGMDPI+1 Q
.I AG1=0,AG2=1,((AG3=1)!(AG4=1)) S AGMRPI=AGMRPI+1 Q
.Q
REPORT ;
U IO
W !!?10,"3rd Party eligibility Stats"
W !?10,"For Patients with Eligibility: ",$$FMTE^XLFDT(AGDT)
W:$G(AGVCK)=1 !?10,"and having a visit in the past 3 years."
W !?10,"Report Date/Time: ",$G(AGNOW) ;AG*7.1*2 ALPHA ISSUE ADD DATE/TIME STAMP TO AID IN BEFORE/AFTER COMPARISONS FOR CMS DOWNLOAD
W !!?16,"UNDUPLICATED PATIENT COUNTS"
W !!?10,"Medicaid Only: ",?40,$J(AGMCD,6)
W !!?10,"Private Insurance Only: ",?40,$J(AGPI,6)
W !!?10,"Medicare A Only: ",?40,$J(AGMCR,6)
W !!?10,"Medicare B Only: ",?40,$J(AGMCRB,6)
W !!?10,"Medicare Part A & B Only: ",?40,$J(AGMCRAB,6)
W !!?10,"Medicare Part D: ",?40,$J(AGMCRD,6) ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
W !!?10,"Medicaid & Medicare: ",?40,$J(AGMM,6)
W !!?10,"Medicaid & Private Ins.: ",?40,$J(AGMDPI,6)
W !!?10,"Medicare & Private Ins.: ",?40,$J(AGMRPI,6)
W !!?10,"Medicaid, Medicare, & PI: ",?40,$J(AGMMPI,6)
;S AGTOT=AGMCD+AGPI+AGMCR+AGMCRB+AGMCRAB+AGMM+AGMDPI+AGMRPI+AGMMPI
S AGTOT=AGMCD+AGPI+AGMCR+AGMCRB+AGMCRAB+AGMM+AGMDPI+AGMRPI+AGMMPI+AGMCRD ;AG*7.1*4 IM26255
W !?40,"------",!!?20,"TOTAL",?40,$J(AGTOT,6)
I '$D(ZTQUEUED),$E(IOST)="C",$$DIR^XBDIR("E","Enter RETURN to continue")
W @IOF
D ^%ZISC
K DFN,AG1,AG2,AG3,AG4,AG,AGTOT,AGMCD,AGPI,AGMCR,AGMCRB,AGMMPI,AGMM,AGMDPI,AGMRPI,AGMCRAB,AGDT
Q
;
VCHK ;
S AG("V")="N",AGST=0
F S AGST=$O(^AUPNVSIT("AA",DFN,AGST)) Q:AGST="" I (AGST<AG("BDT")),(AGST>AG("EDT")) S AG("V")="Y" Q
Q
AG3RDP ;IHS/ASDS/SDH - COUNT 3RD PARTY RESOURCE PATIENTS ;
+1 ;;7.1;IHS PATIENT REGISTRATION;**2,4**;JAN 31, 2007
+2 ;
INTRO ;
+1 ;;
+2 ;;3RD PARTY ELIGIBLITY COUNT PROCESS!
+3 ;;-----------------------------------
+4 ;;This report counts the number of patients that have 3rd Party
+5 ;;insurance on a selected date.
+6 ;;
+7 ;;###
+8 WRITE @IOF
+9 FOR AG=1:1
WRITE $$CJ^XLFSTR($PIECE($TEXT(INTRO+AG),";",3),IOM)
IF $PIECE($TEXT(INTRO+AG+1),";",3)="###"
QUIT
+10 ;
DATE ; Input date to check for eligibility.
+1 SET AGDT=$$DIR^XBDIR("D","Date for the point in Time you want eligibility for")
+2 IF $DATA(DIRUT)
DO EOJ
QUIT
VSTCK ; Input check-active flag.
+1 SET AGVCK=$$DIR^XBDIR("Y","Want to check if patient is active")
+2 IF $DATA(DIRUT)
DO EOJ
QUIT
DEV ; Select Device.
+1 WRITE !!
+2 KILL IOP
+3 SET %ZIS="PQ"
+4 KILL IO("Q")
+5 DO ^%ZIS
+6 IF POP
DO EOJ
QUIT
+7 IF $DATA(IO("Q"))
DO TASK
DO EOJ
QUIT
START ;EP - From TaskMan.
+1 ;AG*7.1*2 ALPHA ISSUE ADD DATE/TIME STAMP TO AID IN BEFORE/AFTER COMPARISONS FOR CMS DOWNLOAD
+2 NEW AGNOW
+3 DO NOW^%DTC
+4 SET Y=%
XECUTE ^DD("DD")
+5 SET AGNOW=Y
+6 ;AG*7.1*2 END
+7 KILL ^TMP("AG3RDP",$JOB)
+8 DO MCR
DO MCD
DO PI
DO RPT
DO EOJ
+9 QUIT
+10 ;
MCR ; Process MediCare file. Record the counts
+1 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="C"
USE IO(0)
WRITE !,"Processing Medicare......"
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^AUPNMCR(DFN))
IF +DFN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^DPT(DFN,.35)),U)'=""
IF ($PIECE($GET(^DPT(DFN,.35)),U)'>AGDT)
QUIT
+5 SET AGM=0
+6 FOR
SET AGM=$ORDER(^AUPNMCR(DFN,11,AGM))
IF +AGM=0
QUIT
Begin DoDot:2
+7 SET AGST=$PIECE($GET(^AUPNMCR(DFN,11,AGM,0)),U)
+8 SET AGEND=$PIECE($GET(^AUPNMCR(DFN,11,AGM,0)),U,2)
+9 SET AGTY=$PIECE($GET(^AUPNMCR(DFN,11,AGM,0)),U,3)
+10 SET AG("MCR")="N"
+11 IF (AGDT'<AGST)
IF (AGEND="")
SET AG("MCR")="Y"
+12 IF '$TEST
IF (AGDT'<AGST)
IF (AGDT'>AGEND)
SET AG("MCR")="Y"
+13 ;I AG("MCR")="Y" S $P(^TMP("AG3RDP",$J,DFN),U,$S(AGTY="B":4,1:3))=1
+14 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PG 11
IF AG("MCR")="Y"
SET $PIECE(^TMP("AG3RDP",$JOB,DFN),U,$SELECT(AGTY="B":4,AGTY="A":3,1:5))=1
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
MCD ; Process MediCaid file. Record the counts
+1 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="C"
USE IO(0)
WRITE !!,"Processing Medicaid...."
+2 SET AG=0
+3 FOR
SET AG=$ORDER(^AUPNMCD(AG))
IF +AG=0
QUIT
Begin DoDot:1
+4 SET DFN=$PIECE($GET(^AUPNMCD(AG,0)),U)
+5 IF 'DFN
WRITE !,DFN
+6 IF 'DFN
QUIT
+7 IF $PIECE($GET(^DPT(DFN,.35)),U)'=""
IF ($PIECE($GET(^DPT(DFN,.35)),U)'>AGDT)
QUIT
+8 SET AGM=0
SET AG("MCD")="N"
+9 FOR
SET AGM=$ORDER(^AUPNMCD(AG,11,AGM))
IF +AGM=0
QUIT
Begin DoDot:2
+10 SET AGST=$PIECE($GET(^AUPNMCD(AG,11,AGM,0)),U)
+11 SET AGEND=$PIECE($GET(^AUPNMCD(AG,11,AGM,0)),U,2)
+12 IF $EXTRACT(AGEND,6,7)="00"
SET AGEND=AGEND+31
+13 IF (AGDT'<AGST)
IF (AGEND="")
SET AG("MCD")="Y"
+14 IF '$TEST
IF (AGDT'<AGST)
IF (AGDT'>AGEND)
SET AG("MCD")="Y"
+15 IF AG("MCD")="Y"
SET $PIECE(^TMP("AG3RDP",$JOB,DFN),U,1)=1
+16 QUIT
End DoDot:2
IF AG("MCD")="Y"
QUIT
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
PI ; Process Private Insurance file. Record the counts
+1 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="C"
USE IO(0)
WRITE !!,"Processing Private Ins......."
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^AUPNPRVT(DFN))
IF +DFN=0
QUIT
IF $$PI^AUPNPAT(DFN,AGDT)
SET $PIECE(^TMP("AG3RDP",$JOB,DFN),U,2)=1
+4 QUIT
+5 ;
RPT ;
+1 KILL AGST,AGEND,AG,AGM,DIR
+2 USE IO
+3 DO EN
+4 QUIT
+5 ;
EOJ ;
+1 DO ^%ZISC
+2 KILL AGDT,AGST,AGTY,AGVCK,DIR,DFN
+3 KILL ^TMP("AG3RDP",$JOB)
+4 QUIT
+5 ;
TASK ;
+1 KILL ZTSAVE
+2 SET ZTSAVE("AGDT")=""
SET ZTSAVE("AGVCK")=""
SET ZTIO=ION
SET ZTRTN="START^AG3RDP"
SET ZTDTH=""
SET ZTDESC="3RD PARTY ELIGIBILITY REPORT"
+3 DO ^%ZTLOAD
+4 QUIT
+5 ;
EN ;
+1 SET (AG,AGMCD,AGPI,AGMCR,AGMCRB,AGMMPI,AGMM,AGMDPI,AGMRPI,AGMCRAB)=0
+2 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
SET AGMCRD=0
+3 SET AG("BDT")=9999999-(AGDT-30001)
SET AG("EDT")=9999999-(AGDT-1)
+4 SET DFN=0
+5 FOR
SET DFN=$ORDER(^TMP("AG3RDP",$JOB,DFN))
IF +DFN=0
QUIT
Begin DoDot:1
+6 IF $GET(AGVCK)=1
DO VCHK
IF AG("V")="N"
QUIT
+7 SET AG=$GET(^TMP("AG3RDP",$JOB,DFN))
+8 ;F %=1:1:4 S @("AG"_%)=+$P(AG,U,%)
+9 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
FOR %=1:1:5
SET @("AG"_%)=+$PIECE(AG,U,%)
+10 ;I AG1=0,AG2=0,AG3=0,AG4=0,AG5=1 S AGMCRD=AGMCRD+1 Q
+11 ;AG*7.1*2 ITEM 8 PAGE 11 SPECS CHANGED PER BPD MEETING OF 8/18/2006
IF AG5=1
SET AGMCRD=AGMCRD+1
QUIT
+12 IF AG1=1
IF AG2=0
IF AG3=0
IF AG4=0
SET AGMCD=AGMCD+1
QUIT
+13 IF AG1=0
IF AG2=1
IF AG3=0
IF AG4=0
SET AGPI=AGPI+1
QUIT
+14 IF AG1=0
IF AG2=0
IF AG3=1
IF AG4=0
SET AGMCR=AGMCR+1
QUIT
+15 IF AG1=0
IF AG2=0
IF AG3=0
IF AG4=1
SET AGMCRB=AGMCRB+1
QUIT
+16 IF AG1=0
IF AG2=0
IF AG3=1
IF AG4=1
SET AGMCRAB=AGMCRAB+1
QUIT
+17 IF AG1=1
IF AG2=1
IF ((AG3=1)!(AG4=1))
SET AGMMPI=AGMMPI+1
QUIT
+18 IF AG1=1
IF ((AG3=1)!(AG4=1))
SET AGMM=AGMM+1
QUIT
+19 IF AG1=1
IF AG2=1
SET AGMDPI=AGMDPI+1
QUIT
+20 IF AG1=0
IF AG2=1
IF ((AG3=1)!(AG4=1))
SET AGMRPI=AGMRPI+1
QUIT
+21 QUIT
End DoDot:1
REPORT ;
+1 USE IO
+2 WRITE !!?10,"3rd Party eligibility Stats"
+3 WRITE !?10,"For Patients with Eligibility: ",$$FMTE^XLFDT(AGDT)
+4 IF $GET(AGVCK)=1
WRITE !?10,"and having a visit in the past 3 years."
+5 ;AG*7.1*2 ALPHA ISSUE ADD DATE/TIME STAMP TO AID IN BEFORE/AFTER COMPARISONS FOR CMS DOWNLOAD
WRITE !?10,"Report Date/Time: ",$GET(AGNOW)
+6 WRITE !!?16,"UNDUPLICATED PATIENT COUNTS"
+7 WRITE !!?10,"Medicaid Only: ",?40,$JUSTIFY(AGMCD,6)
+8 WRITE !!?10,"Private Insurance Only: ",?40,$JUSTIFY(AGPI,6)
+9 WRITE !!?10,"Medicare A Only: ",?40,$JUSTIFY(AGMCR,6)
+10 WRITE !!?10,"Medicare B Only: ",?40,$JUSTIFY(AGMCRB,6)
+11 WRITE !!?10,"Medicare Part A & B Only: ",?40,$JUSTIFY(AGMCRAB,6)
+12 ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 8 PAGE 11
WRITE !!?10,"Medicare Part D: ",?40,$JUSTIFY(AGMCRD,6)
+13 WRITE !!?10,"Medicaid & Medicare: ",?40,$JUSTIFY(AGMM,6)
+14 WRITE !!?10,"Medicaid & Private Ins.: ",?40,$JUSTIFY(AGMDPI,6)
+15 WRITE !!?10,"Medicare & Private Ins.: ",?40,$JUSTIFY(AGMRPI,6)
+16 WRITE !!?10,"Medicaid, Medicare, & PI: ",?40,$JUSTIFY(AGMMPI,6)
+17 ;S AGTOT=AGMCD+AGPI+AGMCR+AGMCRB+AGMCRAB+AGMM+AGMDPI+AGMRPI+AGMMPI
+18 ;AG*7.1*4 IM26255
SET AGTOT=AGMCD+AGPI+AGMCR+AGMCRB+AGMCRAB+AGMM+AGMDPI+AGMRPI+AGMMPI+AGMCRD
+19 WRITE !?40,"------",!!?20,"TOTAL",?40,$JUSTIFY(AGTOT,6)
+20 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="C"
IF $$DIR^XBDIR("E","Enter RETURN to continue")
+21 WRITE @IOF
+22 DO ^%ZISC
+23 KILL DFN,AG1,AG2,AG3,AG4,AG,AGTOT,AGMCD,AGPI,AGMCR,AGMCRB,AGMMPI,AGMM,AGMDPI,AGMRPI,AGMCRAB,AGDT
+24 QUIT
+25 ;
VCHK ;
+1 SET AG("V")="N"
SET AGST=0
+2 FOR
SET AGST=$ORDER(^AUPNVSIT("AA",DFN,AGST))
IF AGST=""
QUIT
IF (AGST<AG("BDT"))
IF (AGST>AG("EDT"))
SET AG("V")="Y"
QUIT
+3 QUIT
