AGAGERP1.m

AGAGERP1 ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010

 ;;7.1;PATIENT REGISTRATION;**8,9,11,12**;AUG 25, 2005;Build 1

 ;

 ;IHS/OIT/NKD AG*7.1*11 REMOVED FILTERING IF NO AR WAS SELECTED

 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 ;

 Q

GETDATA ; Extracting Records based on the Selection Criteria

 W !

 I $G(EXCL("Specific Patient"))="" D GETAR

 I $G(EXCL("Specific Patient"))'="" D GETPATN^AGAGERP3

 I $G(EXCL("Eligibility Status"))'="" D GETES

 I $G(EXCL("Age Range"))'="" D GETAGE

 I $G(EXCL("Location"))'="" D GETLOC

 I $G(EXCL("Visit Date Range"))'="" D GETDT

 Q

 ;

GETLOC ; Check Location

 N VAL,PATNAM,PATNUM,QFLG,NODE

 S VAL=+$G(EXCL("Location"))

 S QFLG=0

 I $D(^TMP("AGAGERP",$J)) D  Q

 . S PATNAM=""

 . S QFLG=1

 . F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:PATNAM=""  D

 . . S PATNUM=0

 . . F  S PATNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATNUM)) Q:PATNUM=""  D

 . . . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . . . I $G(^AUPNPAT(PATNUM,41,VAL,0))="" K ^TMP("AGAGERP",$J,PATNAM,PATNUM) Q

 . . . I $G(^AUPNPAT(PATNUM,41,VAL,0))'="" D

 . . . . S NODE=^AUPNPAT(PATNUM,41,VAL,0)

 . . . . I ($P(NODE,3)'="")&($P(NODE,U,5)'="") K ^TMP("AGAGERP",$J,PATNAM,PATNUM)

 . Q

 Q:QFLG

 I '$D(^TMP("AGAGERP",$J)) D  Q

 . S PATNUM=0

 . S ^TMP("AGAGERP",$J)=""

 . F  S PATNUM=$O(^AUPNPAT(PATNUM)) Q:PATNUM=""  D

 . . Q:'$$PTACTIVE(PATNUM)

 . . I $G(^AUPNPAT(PATNUM,41,VAL,0))'="" D

 . . . S NODE=^AUPNPAT(PATNUM,41,VAL,0)

 . . . Q:($P(NODE,3)'="")&($P(NODE,U,5)'="")

 . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . I PATNAM'="" S ^TMP("AGAGERP",$J,PATNAM,PATNUM)=""

 Q

 ;

GETAR ; Get Alternate Resource records

 N AR1,AR2

 S AR1=+$G(EXCL("Alternate Resource")),AR2=$P($G(EXCL("Alternate Resource")),U,2)

 I AR1=1 D GETMEDR Q

 I AR1=2 D GETMEDD Q

 I (AR1=3)!(AR1=7) D GETPRVT Q

 I AR1=4 D GETINSR Q

 I AR1=6 D GETWRKC Q

 I AR1=8 D GETCHIP Q

 ;IHS/OIT/NKD AG*7.1*11 REMOVED FILTERING IF NO AR WAS SELECTED

 ;D GETNOAR

 Q

 ;

GETDT ; Check Visit Date Rang

 N VIEN,RBEG,REND,VDT,PATNUM,PATNAM,QFLG,FOUND,ADATE

 S QFLG=0

 I $D(^TMP("AGAGERP",$J)),$O(^TMP("AGAGERP",$J,""))'="" D

 . S RBEG=+EXCL("Visit Date Range"),REND=+$P(EXCL("Visit Date Range"),"^",3)+1

 . S QFLG=1

 . S ADATE=RBEG

 . F  S ADATE=$O(^AUPNVSIT("B",ADATE)) Q:(+ADATE=0)!(ADATE>REND)  D

 . . S VIEN=""

 . . F  S VIEN=$O(^AUPNVSIT("B",ADATE,VIEN)) Q:+VIEN=0  D

 . . . S PATNAM=$$GET1^DIQ(9000010,VIEN,.05)

 . . . S PATNUM=$$GET1^DIQ(9000010,VIEN,.05,"I")

 . . . I PATNUM'="",PATNAM'="" S ^TMP2("AGAGERP",$J,PATNAM,PATNUM)=""

 S PATNAM=""

 F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:PATNAM=""  D

 . S PATNUM=0

 . F  S PATNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATNUM)) Q:PATNUM=""  D

 . . I '$D(^TMP2("AGAGERP",$J,PATNAM,PATNUM)) K ^TMP("AGAGERP",$J,PATNAM,PATNUM)

 K ^TMP2("AGAGERP",$J)

 Q:QFLG

 I '$D(^TMP("AGAGERP",$J)) D  Q

 . S ^TMP("AGAGERP",$J)=""

 . S RBEG=+EXCL("Visit Date Range"),REND=+$P(EXCL("Visit Date Range"),U,3)+1

 . S ADATE=RBEG

 . F  S ADATE=$O(^AUPNVSIT("B",ADATE)) Q:(+ADATE=0)!(ADATE>REND)  D

 . . S VIEN=""

 . . F  S VIEN=$O(^AUPNVSIT("B",ADATE,VIEN)) Q:+VIEN=0  D

 . . . S PATNAM=$$GET1^DIQ(9000010,VIEN,.05)

 . . . S PATNUM=$$GET1^DIQ(9000010,VIEN,.05,"I")

 . . . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . . . Q:'$$PTACTIVE(PATNUM)

 . . . I PATNUM'="",PATNAM'="" S ^TMP("AGAGERP",$J,PATNAM,PATNUM)=""

 Q

 ;

GETAGE ; Loop through AGE X-ref to get initial list of patients

 N VAL,PATNAM,PATNUM,QFLG,AGE

 S VAL=+$G(EXCL("Age Range"))

 S QFLG=0

 I $D(^TMP("AGAGERP",$J)) D  Q

 . S PATNAM=""

 . S QFLG=1

 . F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:PATNAM=""  D

 . . S PATNUM=0

 . . F  S PATNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATNUM)) Q:PATNUM=""  D

 . . . S AGE=$$AGE^AUPNPAT(PATNUM,DT)

 . . . I ((VAL=1)&(AGE>17))!((VAL=2)&((AGE<18)!(AGE>64)))!((VAL=3)&((AGE<65)!(AGE>95))) K ^TMP("AGAGERP",$J,PATNAM,PATNUM)

 . Q

 Q:QFLG

 I '$D(^TMP("AGAGERP",$J)) D  Q

 . N REC,PATNUM,AGE

 . S PATNUM=0

 . S ^TMP("AGAGERP",$J)=""

 . F  S PATNUM=$O(^DPT(PATNUM)) Q:+PATNUM=0  D

 . . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . . Q:'$$PTACTIVE(PATNUM)

 . . S AGE=$$AGE^AUPNPAT(PATNUM,DT)

 . . I ((VAL=1)&(AGE<18))!((VAL=2)&((AGE>17)&(AGE<65)))!((VAL=3)&((AGE>64)&(AGE<96))) S ^TMP("AGAGERP",$J,$$GET1^DIQ(2,PATNUM,.01),PATNUM)=""

 Q

 ;

GETES ; Get Eligibility Status records

 N ES,QFLG

 S ES=+$G(EXCL("Eligibility Status"))

 S QFLG=0

 I $D(^TMP("AGAGERP",$J)) D  Q

 . S QFLG=1

 . N ES,ES1,PATNAM,PATNUM

 . S ES=+$G(EXCL("Eligibility Status"))

 . S PATNAM=""

 . F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:PATNAM=""  D

 . . S PATNUM=0

 . . F  S PATNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATNUM)) Q:PATNUM=""  D

 . . . S ES1=$$GET1^DIQ(9000001,PATNUM,1111,"I")

 . . . I ES=1,ES1>1 K ^TMP("AGAGERP",$J,PATNAM,PATNUM)

 . . . I ES>1,ES1=1 K ^TMP("AGAGERP",$J,PATNAM,PATNUM)

 Q:QFLG

 I '$D(^TMP("AGAGERP",$J)) D  Q

 . N ES1,PATNUM,PATNAM

 . S ^TMP("AGAGERP",$J)=""

 . I ES=1 D  Q

 . . S PATNUM=0

 . . F  S PATNUM=$O(^AUPNPAT("AD",ES,PATNUM)) Q:+PATNUM=0  D

 . . . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . . . Q:'$$PTACTIVE(PATNUM)

 . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM)=""

 . I ES>1 D  Q

 . . S ES1=1,PATNUM=0

 . . F  S ES1=$O(^AUPNPAT("AD",ES1)) Q:+ES1=0  D

 . . . F  S PATNUM=$O(^AUPNPAT("AD",ES1,PATNUM)) Q:+PATNUM=0  D

 . . . . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . . . . Q:'$$PTACTIVE(PATNUM)

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM)=""

 Q

 ;

GETPRVT ; Get Private Insurance Patients and Prvt plut Workman's comp

 N PATNUM,PATNAM,RECINS,FOUND1,FOUND2,PATNUM,QFLG,PRFR,PRTO,ELGFR,ELGTO,INSCO,WCIEN,INSTYP,WCFROM,WCTO

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNPAT(PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S RECINS=0

 . F  S RECINS=$O(^AUPNPRVT(PATNUM,11,RECINS)) Q:+RECINS=0  D

 . . S FOUND1=0

 . . S INSCO=$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U)

 . . S INSTYP=$$INSTYP^AGUTL(INSCO,1)  ;IHS/OIT/NKD AG*7.1*12

 . . I ((AR1=3)!(AR1=7))&("HMO/MEDICARE SUPPL/PRIVATE/CHAMPUS/FRATERNAL ORG/MEDICARE HMO"[INSTYP) D

 . . . S PRFR=$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U,6)

 . . . S PRTO=$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U,7)

 . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(PRFR,PRTO,.FOUND1)

 . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(PRFR,PRTO,.FOUND1)

 . . . I FOUND1 D

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,INSCO)=""

 . I $D(^AUPNWC(PATNUM)),AR1=7 D

 . . S WCIEN=0

 . . F  S WCIEN=$O(^AUPNWC(PATNUM,11,WCIEN)) Q:+WCIEN=0  D

 . . . S FOUND2=0

 . . . S WCFROM=$P($G(^AUPNWC(PATNUM,11,WCIEN,0)),U,12)

 . . . S WCTO=$P($G(^AUPNWC(PATNUM,11,WCIEN,0)),U,13)

 . . . S INSCO=$P($G(^AUPNWC(PATNUM,11,WCIEN,0)),U,10)

 . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(WCFROM,WCTO,.FOUND2)

 . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(WCFROM,WCTO,.FOUND2)

 . . . I FOUND2 D

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,"W-"_INSCO)=""

 Q

 ;

GETINSR ; Get all patients for a specific insurance company

 N PATNUM,PATNAM,RECINS,FOUND,QFLG,PRFR,PRTO,ELGFR,ELGTO,INSR,INSCO

 S QFLG=0

 S INSR=$P(EXCL("Specific Insurer"),U)

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNPRVT("I",INSR,PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S RECINS=0

 . F  S RECINS=$O(^AUPNPRVT("I",INSR,PATNUM,RECINS)) Q:+RECINS=0  D

 . . S INSCO=$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U)

 . . S FOUND=0

 . . S PRFR=+$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U,6)

 . . S PRTO=$P($G(^AUPNPRVT(PATNUM,11,RECINS,0)),U,7)

 . . I PRTO="" S PRTO=9999999

 . . I $D(EXCL("Elig Date Range")) D ELGDTCH(PRFR,PRTO,.FOUND)

 . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(PRFR,PRTO,.FOUND)

 . . I FOUND D

 . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,INSCO)=""

 Q

 ;

GETMEDR ; Get Medicare Patients

 N PATNUM,PATNAM,QFLG,MRIEN,MRFROM,MRTO,FOUND,MCRNUM

 S PATNUM=""

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNMCR("B",PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S MCRNUM=0

 . F  S MCRNUM=$O(^AUPNMCR("B",PATNUM,MCRNUM)) Q:+MCRNUM=0  D

 . . S (MRIEN,FOUND)=0

 . . F  S MRIEN=$O(^AUPNMCR(MCRNUM,11,MRIEN)) Q:+MRIEN=0  D

 . . . S MRFROM=+$P($G(^AUPNMCR(MCRNUM,11,MRIEN,0)),U),MRTO=$P($G(^AUPNMCR(MCRNUM,11,MRIEN,0)),U,2)

 . . . I MRTO="" S MRTO=9999999

 . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(MRFROM,MRTO,.FOUND)

 . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(MRFROM,MRTO,.FOUND)

 . . . I FOUND D

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,MCRNUM)=""

 S PATNUM=0

 F  S PATNUM=$O(^AUPNRRE("B",PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . S MCRNUM=""

 . F  S MCRNUM=$O(^AUPNRRE("B",PATNUM,MCRNUM)) Q:+MCRNUM=0  D

 . . S (FOUND,MRIEN)=0

 . . F  S MRIEN=$O(^AUPNRRE(MCRNUM,11,MRIEN)) Q:+MRIEN=0  D

 . . . S MRFROM=+$P($G(^AUPNRRE(MCRNUM,11,MRIEN,0)),U),MRTO=$P($G(^AUPNMCR(MCRNUM,11,MRIEN,0)),U,2)

 . . . I MRTO="" S MRTO=9999999

 . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(MRFROM,MRTO,.FOUND)

 . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(MRFROM,MRTO,.FOUND)

 . . . I FOUND D

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,MCRNUM)=""

 Q

 ;

GETMEDD ; Get Medicaid Patients

 N PATNUM,PATNAM,QFLG,MRIEN,MRFROM,MRTO,FOUND,MCDNUM,MCDPLAN,MCDIEN

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNMCD("B",PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S MCDNUM=0

 . F  S MCDNUM=$O(^AUPNMCD("B",PATNUM,MCDNUM)) Q:+MCDNUM=0  D

 . . S MCDPLAN=$P($G(^AUPNMCD(MCDNUM,0)),U,10)

 . . I MCDPLAN'="" D  Q

 . . . S MCDPTYP=$$INSTYP^AGUTL(MCDPLAN)  ;IHS/OIT/NKD AG*7.1*12

 . . . I MCDPTYP="D" D

 . . . . S MCDIEN=0

 . . . . F  S MCDIEN=$O(^AUPNPRVT(PATNUM,11,MCDIEN)) Q:+MCDIEN=0  D

 . . . . . S CHFR=+$P($G(^AUPNPRVT(PATNUM,11,MCDIEN,0)),U,6)

 . . . . . S CHTO=$P($G(^AUPNPRVT(PATNUM,11,MCDIEN,0)),U,7)

 . . . . . I CHTO="" S CHTO=9999999

 . . . . . S FOUND=0

 . . . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(CHFR,CHTO,.FOUND)

 . . . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(CHFR,CHTO,.FOUND)

 . . . . . I FOUND D

 . . . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . . . S ^TMP("AGAGERP",$J,PATNAM,PATNUM,MCDNUM)=""

 . . I MCDPLAN="" D  Q

 . . . S (FOUND,MRIEN)=0

 . . . F  S MRIEN=$O(^AUPNMCD(MCDNUM,11,MRIEN)) Q:+MRIEN=0  D

 . . . . S MRFROM=+$P($G(^AUPNMCD(MCDNUM,11,MRIEN,0)),U),MRTO=$P($G(^AUPNMCD(MCDNUM,11,MRIEN,0)),U,2)

 . . . . I MRTO="" S MRTO=9999999

 . . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(MRFROM,MRTO,.FOUND)

 . . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(MRFROM,MRTO,.FOUND)

 . . . . I FOUND D

 . . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,MCDNUM)=""

 Q

 ;

GETWRKC ; Get Workmen's Comp Patients

 N PATNUM,PATNAM,QFLG,WCIEN,WCFROM,WCTO,FOUND,INSCO,WRKNUM

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNWC(PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S WRKNUM=0

 . F  S WRKNUM=$O(^AUPNWC(PATNUM,11,WRKNUM)) Q:+WRKNUM=0  D

 . . S FOUND=0

 . . S WCFROM=$P($G(^AUPNWC(PATNUM,11,WRKNUM,0)),U,12)

 . . S WCTO=$P($G(^AUPNWC(PATNUM,11,WRKNUM,0)),U,13)

 . . I $D(EXCL("Elig Date Range")) D ELGDTCH(WCFROM,WCTO,.FOUND)

 . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(WCFROM,WCTO,.FOUND)

 . . S INSCO=$P($G(^AUPNWC(PATNUM,11,WRKNUM,0)),U,10)

 . . I FOUND D

 . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,"W-"_INSCO)=""

 Q

 ;

GETCHIP ; Get CHIP (Childrens Medicaid)

 N PATNUM,INS,INSTYP,PATNAM,INSNO,FOUND,QFLG,CHFR,CHTO,ELGTO,ELGFR,AGE,MCDNUM,MCDPLAN,MCDPTYP,MCDIEN

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNPAT(PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S AGE=$$AGE^AUPNPAT(PATNUM,DT)

 . Q:AGE>17

 . S INS=0

 . F  S INS=$O(^AUPNPRVT(PATNUM,11,INS)) Q:+INS=0  D

 . . S INSNO=$P($G(^AUPNPRVT(PATNUM,11,INS,0)),U)

 . . S FOUND=0

 . . I $$INSTYP^AGUTL(INSNO)="K" D  ;IHS/OIT/NKD AG*7.1*12

 . . . S CHFR=+$P($G(^AUPNPRVT(PATNUM,11,INS,0)),U,6)

 . . . S CHTO=$P($G(^AUPNPRVT(PATNUM,11,INS,0)),U,7)

 . . . I CHTO="" S CHTO=9999999

 . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(CHFR,CHTO,.FOUND)

 . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(CHFR,CHTO,.FOUND)

 . . . I FOUND D

 . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM,INSNO)=""

 S PATNUM=0

 F  S PATNUM=$O(^AUPNMCD("B",PATNUM)) Q:PATNUM=""  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . S MCDNUM=0

 . F  S MCDNUM=$O(^AUPNMCD("B",PATNUM,MCDNUM)) Q:MCDNUM=""  D

 . . S MCDPLAN=$P($G(^AUPNMCD(MCDNUM,0)),U,10)

 . . Q:MCDPLAN=""

 . . S MCDPTYP=$$INSTYP^AGUTL(MCDPLAN)  ;IHS/OIT/NKD AG*7.1*12

 . . I MCDPTYP="K" D

 . . . S MCDIEN=0

 . . . F  S MCDIEN=$O(^AUPNMCD(MCDNUM,11,MCDIEN)) Q:+MCDIEN=0  D

 . . . . S CHFR=+$P($G(^AUPNMCD(MCDNUM,11,MCDIEN,0)),U)

 . . . . S CHTO=$P($G(^AUPNMCD(MCDNUM,11,MCDIEN,0)),U,2)

 . . . . I CHTO="" S CHTO=9999999

 . . . . S FOUND=0

 . . . . I $D(EXCL("Elig Date Range")) D ELGDTCH(CHFR,CHTO,.FOUND)

 . . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2(CHFR,CHTO,.FOUND)

 . . . . I FOUND D

 . . . . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . . . . S ^TMP("AGAGERP",$J,PATNAM,PATNUM,"M-"_MCDNUM)=""

 Q

 ;

GETNOAR ;Get patients without Alternate Resources

 N PATNUM,PATNAM,QFLG,MRIEN,FROM,TO,FOUND,MCRNUM,MCDNUM,RECINS,SEL

 S PATNUM=0

 S ^TMP("AGAGERP",$J)=""

 F  S PATNUM=$O(^AUPNPAT(PATNUM)) Q:+PATNUM=0  D

 . Q:'$$PTACTIVE(PATNUM)

 . Q:$$GET1^DIQ(2,PATNUM,.351)'=""

 . K AGINS,AGINSN1,AGINSNN,MAX

 . S SEL=0

 . D FINDMCR^AGINS(PATNUM)  ; MEDICARE

 . D FINDMCD^AGINS(PATNUM)  ; MEDICAID

 . D FINDRRE^AGINS(PATNUM)  ; RAILROAD

 . D FINDPVT^AGINS(PATNUM)  ; PRIVATE

 . I '$D(AGINS) D

 . . S PATNAM=$$GET1^DIQ(2,PATNUM,.01)

 . . I PATNAM]"" S ^TMP("AGAGERP",$J,PATNAM,PATNUM)=""

 Q

ELGDTCH(AGFR,AGTO,FOUND) ;Check Patient Eligibility Dates Against Report parameters

 N ELGFR,ELGTO

 S ELGFR=+$P($G(EXCL("Elig Date Range")),U),ELGTO=$P($G(EXCL("Elig Date Range")),U,3)

 I AGTO="" S AGTO=9999999

 I +$G(AGFR)=0 Q

 I '((AGTO<ELGFR)!(ELGTO<AGFR)) S FOUND=1

 Q

 ;

ELGDTCH2(AGFR,AGTO,FOUND) ;Check Patient Eligibility Dates Against Report parameter

 N ELGFR,ELGTO

 S (ELGFR,ELGTO)=DT

 I AGTO="" S AGTO=9999999

 I (+AGFR=0) Q

 I '((AGTO<ELGFR)!(ELGTO<AGFR)) S FOUND=1

 Q

PTACTIVE(DFN) ;EP - SEE IF PATIENT IS ACTIVE IN AT LEAST ONE FACILTY

 N ACTIVE,FAC

 S ACTIVE=1

 S FAC=0

 F  S FAC=$O(^AUPNPAT(DFN,41,FAC)) Q:('FAC)!('ACTIVE)  D

 . I FAC=DUZ(2),$P($G(^AUPNPAT(DFN,41,FAC,0)),U,5)'="" S ACTIVE=0 Q

 Q ACTIVE

AGAGERP1  ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010

 +1       ;;7.1;PATIENT REGISTRATION;**8,9,11,12**;AUG 25, 2005;Build 1

 +2       ;

 +3       ;IHS/OIT/NKD AG*7.1*11 REMOVED FILTERING IF NO AR WAS SELECTED

 +4       ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 +5       ;

 +6        QUIT 

GETDATA   ; Extracting Records based on the Selection Criteria

 +1        WRITE !

 +2        IF $GET(EXCL("Specific Patient"))=""

               DO GETAR

 +3        IF $GET(EXCL("Specific Patient"))'=""

               DO GETPATN^AGAGERP3

 +4        IF $GET(EXCL("Eligibility Status"))'=""

               DO GETES

 +5        IF $GET(EXCL("Age Range"))'=""

               DO GETAGE

 +6        IF $GET(EXCL("Location"))'=""

               DO GETLOC

 +7        IF $GET(EXCL("Visit Date Range"))'=""

               DO GETDT

 +8        QUIT 

 +9       ;

GETLOC    ; Check Location

 +1        NEW VAL,PATNAM,PATNUM,QFLG,NODE

 +2        SET VAL=+$GET(EXCL("Location"))

 +3        SET QFLG=0

 +4        IF $DATA(^TMP("AGAGERP",$JOB))

               Begin DoDot:1

 +5                SET PATNAM=""

 +6                SET QFLG=1

 +7                FOR 

                       SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))

                       IF PATNAM=""

                           QUIT 

                       Begin DoDot:2

 +8                        SET PATNUM=0

 +9                        FOR 

                               SET PATNUM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATNUM))

                               IF PATNUM=""

                                   QUIT 

                               Begin DoDot:3

 +10                               IF $$GET1^DIQ(2,PATNUM,.351)'=""

                                       QUIT 

 +11                               IF $GET(^AUPNPAT(PATNUM,41,VAL,0))=""

                                       KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)

                                       QUIT 

 +12                               IF $GET(^AUPNPAT(PATNUM,41,VAL,0))'=""

                                       Begin DoDot:4

 +13                                       SET NODE=^AUPNPAT(PATNUM,41,VAL,0)

 +14                                       IF ($PIECE(NODE,3)'="")&($PIECE(NODE,U,5)'="")

                                               KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +15               QUIT 

               End DoDot:1

               QUIT 

 +16       IF QFLG

               QUIT 

 +17       IF '$DATA(^TMP("AGAGERP",$JOB))

               Begin DoDot:1

 +18               SET PATNUM=0

 +19               SET ^TMP("AGAGERP",$JOB)=""

 +20               FOR 

                       SET PATNUM=$ORDER(^AUPNPAT(PATNUM))

                       IF PATNUM=""

                           QUIT 

                       Begin DoDot:2

 +21                       IF '$$PTACTIVE(PATNUM)

                               QUIT 

 +22                       IF $GET(^AUPNPAT(PATNUM,41,VAL,0))'=""

                               Begin DoDot:3

 +23                               SET NODE=^AUPNPAT(PATNUM,41,VAL,0)

 +24                               IF ($PIECE(NODE,3)'="")&($PIECE(NODE,U,5)'="")

                                       QUIT