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

ACHSDNS.m

Go to the documentation of this file. 
  1. ACHSDNS ; IHS/ITSC/PMF - DENIAL STATISTICS REPORT (1/2) ;7/27/10  16:15
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
  1.  ;ACHS*3.1*6 4/24/03 IHS/SET/FCJ MULTIPLE CHANGES ADDED TO RUN 2 OTHER
  1.  ;           REPORTS BY DOS, COMMUNITY
  1.  ;           ADDED DEV LINE LABEL
  1.  ;           REQUEST TO SORT BY PAYOR WILL BE INCLUDED IN PATCH 7 BUT
  1.  ;           HAS BEEN STARTED
  1.  ;ACHS*3.1*7 10/10/03 ITSC/SET/FCJ ADDED ACHSPRT IN LABEL DEV
  1.  ;ACHS*3.1*18 7/19/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
  1.  ;
  1.  ;
  1. SEL D QSEL
  1.  S ACHSRPT=$$DIR^ACHS("N^1:3:0","Select",1,"","^D QSEL^ACHSDNS",3)
  1.  G:ACHSRPT'?1N.3N K
  1.  D A2
  1.  Q
  1. A2 ; --- Input date range
  1.  S ACHSBDT=$$DATE^ACHS("B","DENIAL STATISTICS")
  1.  G K:ACHSBDT<1
  1.  S ACHSEDT=$$DATE^ACHS("E","DENIAL STATISTICS")
  1.  G A2:ACHSEDT<1
  1.  I $$EBB^ACHS(ACHSBDT,ACHSEDT) G A2
  1.  S ACHSHAT=""
  1. DEV S %ZIS="OPQ"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS G K
  1.  G:'$D(IO("Q")) START
  1.  K IO("Q")
  1.  I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
  1.  ;
  1.  S ZTRTN="START^ACHSDNS",ZTIO="",ZTDESC="CHS Denial Statistics, "_(ACHSBDT+17000000)_" to "_(ACHSEDT+17000000),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL  ; Y2000
  1.  ;
  1.  ;ITSC/SET/FCJ ACHS*3.1*7  ADDED ACHSRPT
  1.  ;F %="ACHSQIO","ACHSBDT","ACHSEDT" S ZTSAVE(%)=""
  1.  F %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRPT" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1. K ;
  1.  K ACHS,ACHSBDT,ACHSEDT,ACHSHAT,ACHSQIO,DTOUT,DUOUT,ZTIO,ZTSK
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. START ;EP - TaskMan.
  1. ST ;
  1.  N ACHSMPRI
  1.  S ACHSISDT=ACHSBDT-1
  1.  K ^TMP($J,"ACHSDNS")
  1. A ; --- START OF Loops
  1.  S ACHSSUB=$S((ACHSRPT<3):"SET",ACHSRPT=3:"SET3",ACHSRPT=4:"SET4")
  1. DOI ;SORT BY DATE OF ISSUE
  1.  I ACHSRPT'=2 D
  1.  .F  S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT)) Q:+ACHSISDT=0!(+ACHSISDT>ACHSEDT)  D
  1.  ..S DA=0,ACHSINST=0
  1.  ..F  S DA=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHSISDT,DA)) Q:+DA=0  D
  1.  ...D B
  1.  ...S:ACHS("A")'="TOTAL" $P(^TMP($J,"ACHSDNS","X","TOTALD"),U)=+$P($G(^TMP($J,"ACHSDNS","X","TOTALD")),U)+1
  1. DOS ;SORT BY DATE OF SERVICE
  1.  I ACHSRPT=2 D
  1.  .F  S ACHSISDT=$O(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT)) Q:+ACHSISDT=0!(+ACHSISDT>ACHSEDT)  D
  1.  ..S DA=0
  1.  ..F  S DA=$O(^ACHSDEN(DUZ(2),"D","ES",ACHSISDT,DA)) Q:+DA=0  D B
  1.  ;G:ACHSRPT<4 GRNDTOT
  1.  G GRNDTOT
  1. B ; --- Loop thru Denial IENs
  1.  Q:'$D(^ACHSDEN(DUZ(2),"D",DA,0))
  1.  Q:'$D(^ACHSDEN(DUZ(2),"D",DA,100))
  1.  S ACHSTYPE=$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,10)
  1.  Q:ACHSTYPE']""
  1.  Q:$P($G(^ACHSDEN(DUZ(2),"D",DA,0)),U)["#"
  1.  D DOLLARS
  1.  S ACHSMPRI=$P($G(^ACHSDEN(DUZ(2),"D",DA,400)),U,2)
  1.  I ACHSMPRI S ACHSMPRI=$P($G(^ACHSMPRI(ACHSMPRI,0)),U)
  1.  E  S ACHSMPRI="UNKNOWN"
  1.  S ACHS("A")="TOTAL"
  1.  D @ACHSSUB
  1.  Q:'$G(^ACHSDEN(DUZ(2),"D",DA,250))
  1.  S ACHS("A")=$P($G(^ACHSDEN(DUZ(2),"D",DA,250)),U),ACHSREAS=$P($G(^ACHSDENS(+ACHS("A"),0)),U)
  1.  D @ACHSSUB
  1.  Q
  1.  ;
  1. GRNDTOT ; --- Compute Grand Total For each Group.
  1.  S ACHS=""
  1. G1 ;
  1.  F  S ACHS=$O(^TMP($J,"ACHSDNS",ACHS)) G END:ACHS="" D
  1.  .S ACHS(1)="",(ACHS("C"),ACHS("D"))=0
  1.  .F  S ACHS(1)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1))) Q:ACHS(1)=""  D
  1.  ..I ACHSRPT<3 D  Q
  1.  ...S ACHS("C")=ACHS("C")+$G(^TMP($J,"ACHSDNS",ACHS,ACHS(1)))
  1.  ...S ACHS("D")=ACHS("D")+$P($G(^TMP($J,"ACHSDNS",ACHS,ACHS(1))),U,2)
  1.  ..S ACHS(2)=""
  1.  ..F  S ACHS(2)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2))) Q:ACHS(2)=""  D
  1.  ...S ACHS(3)=""
  1.  ...F  S ACHS(3)=$O(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3))) Q:ACHS(3)=""  D
  1.  ....S ACHS("C")=ACHS("C")+$G(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3)))
  1.  ....S ACHS("D")=ACHS("D")+$P($G(^TMP($J,"ACHSDNS",ACHS,ACHS(1),ACHS(2),ACHS(3))),U,2)
  1.  .S ^TMP($J,"ACHSDNS",ACHS,"TOTAL")=ACHS("C")_U_ACHS("D")
  1.  ;
  1. END ;
  1.  K ACHS,ACHSREAS,ACHSINS,ACHSINST
  1.  G ^ACHSDNS1
  1.  ;
  1. SET ;
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE),U,2)+ACHS("$")
  1.  ;
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
  1.  Q
  1. SET3 ;REPORT TYPE WITH COMMUNITY    
  1.  I $P(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="Y" D
  1.  .Q:'$D(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11))
  1.  .S ACHSCOM=$P(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
  1.  .Q:ACHSCOM=""
  1.  .S ACHSCOM=$P(^AUPNPAT($P(^ACHSDEN(DUZ(2),"D",DA,0),U,7),11),U,17)
  1.  .S ACHSST=$P(^AUTTCOM(ACHSCOM,0),U,3)
  1.  .S ACHSCOM=$P(^AUTTCOM(ACHSCOM,0),U)
  1.  I $P(^ACHSDEN(DUZ(2),"D",DA,0),U,6)="N" D
  1.  .Q:ACHSCOM=""
  1.  .S ACHSCOM=$P(^ACHSDEN(DUZ(2),"D",DA,10),U,3)
  1.  .S ACHSST=$P(^ACHSDEN(DUZ(2),"D",DA,10),U,4)
  1.  Q:ACHSCOM=""
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE),U,2)+ACHS("$")
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSCOM,ACHSST,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
  1.  S:(ACHS("A")'="TOTAL")&('$D(^TMP($J,"ACHSDNS","X",ACHSCOM,ACHSST,ACHS("A"),ACHSTYPE))) ^(ACHSTYPE)=""
  1.  Q
  1.  ;
  1. SET4 ;REPORT BY ALTERNATE RESOURCES
  1.  I ACHS("$")'=0,ACHS("A")="TOTAL" S ACHSINS="SELF PAY",ACHSINST=ACHS("$") D SETINS
  1.  I ACHS("A")'="TOTAL",ACHSINST'=0 S ACHSINS="SELF PAY",ACHS("$")=ACHSINST D SETINS
  1.  I $D(^ACHSDEN(DUZ(2),"D",DA,800)) D
  1.  .S DA(1)=0
  1.  .F  S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,800,DA(1))) Q:DA(1)'?1N.N  D
  1.  ..S %=$P(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0),U),ACHS("$")=$P(^(0),U,2)
  1.  ..S ACHSINS=$S(%'?1.N:%,1:$P($G(^AUTNINS(%,0)),U))
  1.  ..I ACHSINS'="MEDICAID",ACHSINS'="MEDICARE" S ACHSINS="OTHER INSURANCE/COVERAGE"
  1.  ..Q:(ACHSINS="")!(ACHS("$"))
  1.  ..D SETINS
  1.  Q
  1. SETINS ;SET OTHER PAYMENT TYPES
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U)=+$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)=+$P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE),U,2)+ACHS("$")
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U)+1
  1.  S $P(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI),U,2)=$P($G(^TMP($J,"ACHSDNS",ACHS("A"),ACHSINS,ACHSTYPE,ACHSMPRI)),U,2)+ACHS("$")
  1.  S:(ACHS("A")'="TOTAL")&('$D(^TMP($J,"ACHSDNS","X",ACHSINS,ACHS("A"),ACHSTYPE))) ^(ACHSTYPE)=""
  1.  Q
  1.  ;
  1. HDR ;EP
  1.  S ACHSPG=ACHSPG+1
  1.  ;{ABK,7/19/10}W @IOF,!!,$$C^ACHS("***  CHS DENIAL/DEFERRED SERVICES  ***",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC
  1.  W @IOF,!!,$$C^ACHS("***  CHS DENIAL  ***",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC
  1.  I $D(ZTSK) S X="(task "_ZTSK_")" W ?79-$L(X),X
  1.  W !,$$C^ACHS("DENIAL FACILITY STATISTICS",80),!,ACHSTIME,!!,ACHST1,!!
  1.  W:ACHSRPT=3 !,"COMMUNITY:  ",ACHSCOM,", ",$P(^DIC(5,ACHSST,0),U),!
  1.  W:ACHSRPT=4 !,"PAYOR:  ",ACHSINS,!
  1.  I ACHSPART=1 W "DENIAL REASON",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
  1.  I ACHSPART=2 W ?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
  1.  ;{ABK,7/19/10}I ACHSPART=3 W "TYPE OF DEFERRED SERVICE",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
  1.  I ACHSPART=3 W "TYPE OF UNMET NEED",?37,"TYPE",?44,"TOTAL",?53,"%",?63,"DOLLARS",?76,"%"
  1.  W !,$$REPEAT^XLFSTR("=",79),!
  1.  Q
  1.  ;
  1. DOLLARS ;EP - Get Dollar Amount for each Denial.
  1.  S ACHS("$")=$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,9):+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,9),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,100)),U,8))
  1.  ;
  1.  I $D(^ACHSDEN(DUZ(2),"D",DA,200)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,200,DA(1))) Q:'DA(1)  D
  1.  .I $D(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)) D
  1.  ..S ACHS("$")=ACHS("$")+$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3):$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,3),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,200,DA(1),0)),U,2))
  1.  ;
  1.  I $D(^ACHSDEN(DUZ(2),"D",DA,210)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,210,DA(1))) Q:'DA(1)  D
  1.  .I $D(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)) D
  1.  ..S ACHS("$")=ACHS("$")+$S(+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7):+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,7),1:+$P($G(^ACHSDEN(DUZ(2),"D",DA,210,DA(1),0)),U,6))
  1.  ;
  1.  I $D(^ACHSDEN(DUZ(2),"D",DA,800)) F DA(1)=0:0 S DA(1)=$O(^ACHSDEN(DUZ(2),"D",DA,800,DA(1))) Q:'DA(1)  D
  1.  .I $D(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)) S ACHS("$")=ACHS("$")-(+$P($G(^ACHSDEN(DUZ(2),"D",DA,800,DA(1),0)),U,2))
  1.  Q
  1.  ;
  1. QSEL ;
  1.  W !!?20,"1) Print Report by Date of Issue"
  1.  W !?20,"2) Print Report by Date of Service"
  1.  W !?20,"3) Print Report by Community"
  1.  ;W !?20,"4) Print Report by Primary Payor"
  1.  Q