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
+25 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+26 IF PATNAM'=""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+27 QUIT
+28 ;
GETAR ; Get Alternate Resource records
+1 NEW AR1,AR2
+2 SET AR1=+$GET(EXCL("Alternate Resource"))
SET AR2=$PIECE($GET(EXCL("Alternate Resource")),U,2)
+3 IF AR1=1
DO GETMEDR
QUIT
+4 IF AR1=2
DO GETMEDD
QUIT
+5 IF (AR1=3)!(AR1=7)
DO GETPRVT
QUIT
+6 IF AR1=4
DO GETINSR
QUIT
+7 IF AR1=6
DO GETWRKC
QUIT
+8 IF AR1=8
DO GETCHIP
QUIT
+9 ;IHS/OIT/NKD AG*7.1*11 REMOVED FILTERING IF NO AR WAS SELECTED
+10 ;D GETNOAR
+11 QUIT
+12 ;
GETDT ; Check Visit Date Rang
+1 NEW VIEN,RBEG,REND,VDT,PATNUM,PATNAM,QFLG,FOUND,ADATE
+2 SET QFLG=0
+3 IF $DATA(^TMP("AGAGERP",$JOB))
IF $ORDER(^TMP("AGAGERP",$JOB,""))'=""
Begin DoDot:1
+4 SET RBEG=+EXCL("Visit Date Range")
SET REND=+$PIECE(EXCL("Visit Date Range"),"^",3)+1
+5 SET QFLG=1
+6 SET ADATE=RBEG
+7 FOR
SET ADATE=$ORDER(^AUPNVSIT("B",ADATE))
IF (+ADATE=0)!(ADATE>REND)
QUIT
Begin DoDot:2
+8 SET VIEN=""
+9 FOR
SET VIEN=$ORDER(^AUPNVSIT("B",ADATE,VIEN))
IF +VIEN=0
QUIT
Begin DoDot:3
+10 SET PATNAM=$$GET1^DIQ(9000010,VIEN,.05)
+11 SET PATNUM=$$GET1^DIQ(9000010,VIEN,.05,"I")
+12 IF PATNUM'=""
IF PATNAM'=""
SET ^TMP2("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET PATNAM=""
+14 FOR
SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))
IF PATNAM=""
QUIT
Begin DoDot:1
+15 SET PATNUM=0
+16 FOR
SET PATNUM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATNUM))
IF PATNUM=""
QUIT
Begin DoDot:2
+17 IF '$DATA(^TMP2("AGAGERP",$JOB,PATNAM,PATNUM))
KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)
End DoDot:2
End DoDot:1
+18 KILL ^TMP2("AGAGERP",$JOB)
+19 IF QFLG
QUIT
+20 IF '$DATA(^TMP("AGAGERP",$JOB))
Begin DoDot:1
+21 SET ^TMP("AGAGERP",$JOB)=""
+22 SET RBEG=+EXCL("Visit Date Range")
SET REND=+$PIECE(EXCL("Visit Date Range"),U,3)+1
+23 SET ADATE=RBEG
+24 FOR
SET ADATE=$ORDER(^AUPNVSIT("B",ADATE))
IF (+ADATE=0)!(ADATE>REND)
QUIT
Begin DoDot:2
+25 SET VIEN=""
+26 FOR
SET VIEN=$ORDER(^AUPNVSIT("B",ADATE,VIEN))
IF +VIEN=0
QUIT
Begin DoDot:3
+27 SET PATNAM=$$GET1^DIQ(9000010,VIEN,.05)
+28 SET PATNUM=$$GET1^DIQ(9000010,VIEN,.05,"I")
+29 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+30 IF '$$PTACTIVE(PATNUM)
QUIT
+31 IF PATNUM'=""
IF PATNAM'=""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+32 QUIT
+33 ;
GETAGE ; Loop through AGE X-ref to get initial list of patients
+1 NEW VAL,PATNAM,PATNUM,QFLG,AGE
+2 SET VAL=+$GET(EXCL("Age Range"))
+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 SET AGE=$$AGE^AUPNPAT(PATNUM,DT)
+11 IF ((VAL=1)&(AGE>17))!((VAL=2)&((AGE<18)!(AGE>64)))!((VAL=3)&((AGE<65)!(AGE>95)))
KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)
End DoDot:3
End DoDot:2
+12 QUIT
End DoDot:1
QUIT
+13 IF QFLG
QUIT
+14 IF '$DATA(^TMP("AGAGERP",$JOB))
Begin DoDot:1
+15 NEW REC,PATNUM,AGE
+16 SET PATNUM=0
+17 SET ^TMP("AGAGERP",$JOB)=""
+18 FOR
SET PATNUM=$ORDER(^DPT(PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:2
+19 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+20 IF '$$PTACTIVE(PATNUM)
QUIT
+21 SET AGE=$$AGE^AUPNPAT(PATNUM,DT)
+22 IF ((VAL=1)&(AGE<18))!((VAL=2)&((AGE>17)&(AGE<65)))!((VAL=3)&((AGE>64)&(AGE<96)))
SET ^TMP("AGAGERP",$JOB,$$GET1^DIQ(2,PATNUM,.01),PATNUM)=""
End DoDot:2
End DoDot:1
QUIT
+23 QUIT
+24 ;
GETES ; Get Eligibility Status records
+1 NEW ES,QFLG
+2 SET ES=+$GET(EXCL("Eligibility Status"))
+3 SET QFLG=0
+4 IF $DATA(^TMP("AGAGERP",$JOB))
Begin DoDot:1
+5 SET QFLG=1
+6 NEW ES,ES1,PATNAM,PATNUM
+7 SET ES=+$GET(EXCL("Eligibility Status"))
+8 SET PATNAM=""
+9 FOR
SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))
IF PATNAM=""
QUIT
Begin DoDot:2
+10 SET PATNUM=0
+11 FOR
SET PATNUM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATNUM))
IF PATNUM=""
QUIT
Begin DoDot:3
+12 SET ES1=$$GET1^DIQ(9000001,PATNUM,1111,"I")
+13 IF ES=1
IF ES1>1
KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)
+14 IF ES>1
IF ES1=1
KILL ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+15 IF QFLG
QUIT
+16 IF '$DATA(^TMP("AGAGERP",$JOB))
Begin DoDot:1
+17 NEW ES1,PATNUM,PATNAM
+18 SET ^TMP("AGAGERP",$JOB)=""
+19 IF ES=1
Begin DoDot:2
+20 SET PATNUM=0
+21 FOR
SET PATNUM=$ORDER(^AUPNPAT("AD",ES,PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:3
+22 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+23 IF '$$PTACTIVE(PATNUM)
QUIT
+24 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+25 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:3
End DoDot:2
QUIT
+26 IF ES>1
Begin DoDot:2
+27 SET ES1=1
SET PATNUM=0
+28 FOR
SET ES1=$ORDER(^AUPNPAT("AD",ES1))
IF +ES1=0
QUIT
Begin DoDot:3
+29 FOR
SET PATNUM=$ORDER(^AUPNPAT("AD",ES1,PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:4
+30 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+31 IF '$$PTACTIVE(PATNUM)
QUIT
+32 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+33 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
QUIT
+34 QUIT
+35 ;
GETPRVT ; Get Private Insurance Patients and Prvt plut Workman's comp
+1 NEW PATNUM,PATNAM,RECINS,FOUND1,FOUND2,PATNUM,QFLG,PRFR,PRTO,ELGFR,ELGTO,INSCO,WCIEN,INSTYP,WCFROM,WCTO
+2 SET PATNUM=0
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNPAT(PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 SET RECINS=0
+8 FOR
SET RECINS=$ORDER(^AUPNPRVT(PATNUM,11,RECINS))
IF +RECINS=0
QUIT
Begin DoDot:2
+9 SET FOUND1=0
+10 SET INSCO=$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U)
+11 ;IHS/OIT/NKD AG*7.1*12
SET INSTYP=$$INSTYP^AGUTL(INSCO,1)
+12 IF ((AR1=3)!(AR1=7))&("HMO/MEDICARE SUPPL/PRIVATE/CHAMPUS/FRATERNAL ORG/MEDICARE HMO"[INSTYP)
Begin DoDot:3
+13 SET PRFR=$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U,6)
+14 SET PRTO=$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U,7)
+15 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(PRFR,PRTO,.FOUND1)
+16 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(PRFR,PRTO,.FOUND1)
+17 IF FOUND1
Begin DoDot:4
+18 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+19 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,INSCO)=""
End DoDot:4
End DoDot:3
End DoDot:2
+20 IF $DATA(^AUPNWC(PATNUM))
IF AR1=7
Begin DoDot:2
+21 SET WCIEN=0
+22 FOR
SET WCIEN=$ORDER(^AUPNWC(PATNUM,11,WCIEN))
IF +WCIEN=0
QUIT
Begin DoDot:3
+23 SET FOUND2=0
+24 SET WCFROM=$PIECE($GET(^AUPNWC(PATNUM,11,WCIEN,0)),U,12)
+25 SET WCTO=$PIECE($GET(^AUPNWC(PATNUM,11,WCIEN,0)),U,13)
+26 SET INSCO=$PIECE($GET(^AUPNWC(PATNUM,11,WCIEN,0)),U,10)
+27 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(WCFROM,WCTO,.FOUND2)
+28 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(WCFROM,WCTO,.FOUND2)
+29 IF FOUND2
Begin DoDot:4
+30 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+31 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,"W-"_INSCO)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
GETINSR ; Get all patients for a specific insurance company
+1 NEW PATNUM,PATNAM,RECINS,FOUND,QFLG,PRFR,PRTO,ELGFR,ELGTO,INSR,INSCO
+2 SET QFLG=0
+3 SET INSR=$PIECE(EXCL("Specific Insurer"),U)
+4 SET PATNUM=0
+5 SET ^TMP("AGAGERP",$JOB)=""
+6 FOR
SET PATNUM=$ORDER(^AUPNPRVT("I",INSR,PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+7 IF '$$PTACTIVE(PATNUM)
QUIT
+8 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+9 SET RECINS=0
+10 FOR
SET RECINS=$ORDER(^AUPNPRVT("I",INSR,PATNUM,RECINS))
IF +RECINS=0
QUIT
Begin DoDot:2
+11 SET INSCO=$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U)
+12 SET FOUND=0
+13 SET PRFR=+$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U,6)
+14 SET PRTO=$PIECE($GET(^AUPNPRVT(PATNUM,11,RECINS,0)),U,7)
+15 IF PRTO=""
SET PRTO=9999999
+16 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(PRFR,PRTO,.FOUND)
+17 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(PRFR,PRTO,.FOUND)
+18 IF FOUND
Begin DoDot:3
+19 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+20 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,INSCO)=""
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
GETMEDR ; Get Medicare Patients
+1 NEW PATNUM,PATNAM,QFLG,MRIEN,MRFROM,MRTO,FOUND,MCRNUM
+2 SET PATNUM=""
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNMCR("B",PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 SET MCRNUM=0
+8 FOR
SET MCRNUM=$ORDER(^AUPNMCR("B",PATNUM,MCRNUM))
IF +MCRNUM=0
QUIT
Begin DoDot:2
+9 SET (MRIEN,FOUND)=0
+10 FOR
SET MRIEN=$ORDER(^AUPNMCR(MCRNUM,11,MRIEN))
IF +MRIEN=0
QUIT
Begin DoDot:3
+11 SET MRFROM=+$PIECE($GET(^AUPNMCR(MCRNUM,11,MRIEN,0)),U)
SET MRTO=$PIECE($GET(^AUPNMCR(MCRNUM,11,MRIEN,0)),U,2)
+12 IF MRTO=""
SET MRTO=9999999
+13 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(MRFROM,MRTO,.FOUND)
+14 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(MRFROM,MRTO,.FOUND)
+15 IF FOUND
Begin DoDot:4
+16 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+17 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,MCRNUM)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET PATNUM=0
+19 FOR
SET PATNUM=$ORDER(^AUPNRRE("B",PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+20 IF '$$PTACTIVE(PATNUM)
QUIT
+21 SET MCRNUM=""
+22 FOR
SET MCRNUM=$ORDER(^AUPNRRE("B",PATNUM,MCRNUM))
IF +MCRNUM=0
QUIT
Begin DoDot:2
+23 SET (FOUND,MRIEN)=0
+24 FOR
SET MRIEN=$ORDER(^AUPNRRE(MCRNUM,11,MRIEN))
IF +MRIEN=0
QUIT
Begin DoDot:3
+25 SET MRFROM=+$PIECE($GET(^AUPNRRE(MCRNUM,11,MRIEN,0)),U)
SET MRTO=$PIECE($GET(^AUPNMCR(MCRNUM,11,MRIEN,0)),U,2)
+26 IF MRTO=""
SET MRTO=9999999
+27 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(MRFROM,MRTO,.FOUND)
+28 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(MRFROM,MRTO,.FOUND)
+29 IF FOUND
Begin DoDot:4
+30 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+31 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,MCRNUM)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
GETMEDD ; Get Medicaid Patients
+1 NEW PATNUM,PATNAM,QFLG,MRIEN,MRFROM,MRTO,FOUND,MCDNUM,MCDPLAN,MCDIEN
+2 SET PATNUM=0
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNMCD("B",PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 SET MCDNUM=0
+8 FOR
SET MCDNUM=$ORDER(^AUPNMCD("B",PATNUM,MCDNUM))
IF +MCDNUM=0
QUIT
Begin DoDot:2
+9 SET MCDPLAN=$PIECE($GET(^AUPNMCD(MCDNUM,0)),U,10)
+10 IF MCDPLAN'=""
Begin DoDot:3
+11 ;IHS/OIT/NKD AG*7.1*12
SET MCDPTYP=$$INSTYP^AGUTL(MCDPLAN)
+12 IF MCDPTYP="D"
Begin DoDot:4
+13 SET MCDIEN=0
+14 FOR
SET MCDIEN=$ORDER(^AUPNPRVT(PATNUM,11,MCDIEN))
IF +MCDIEN=0
QUIT
Begin DoDot:5
+15 SET CHFR=+$PIECE($GET(^AUPNPRVT(PATNUM,11,MCDIEN,0)),U,6)
+16 SET CHTO=$PIECE($GET(^AUPNPRVT(PATNUM,11,MCDIEN,0)),U,7)
+17 IF CHTO=""
SET CHTO=9999999
+18 SET FOUND=0
+19 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(CHFR,CHTO,.FOUND)
+20 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(CHFR,CHTO,.FOUND)
+21 IF FOUND
Begin DoDot:6
+22 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+23 SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,MCDNUM)=""
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+24 IF MCDPLAN=""
Begin DoDot:3
+25 SET (FOUND,MRIEN)=0
+26 FOR
SET MRIEN=$ORDER(^AUPNMCD(MCDNUM,11,MRIEN))
IF +MRIEN=0
QUIT
Begin DoDot:4
+27 SET MRFROM=+$PIECE($GET(^AUPNMCD(MCDNUM,11,MRIEN,0)),U)
SET MRTO=$PIECE($GET(^AUPNMCD(MCDNUM,11,MRIEN,0)),U,2)
+28 IF MRTO=""
SET MRTO=9999999
+29 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(MRFROM,MRTO,.FOUND)
+30 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(MRFROM,MRTO,.FOUND)
+31 IF FOUND
Begin DoDot:5
+32 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+33 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,MCDNUM)=""
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
GETWRKC ; Get Workmen's Comp Patients
+1 NEW PATNUM,PATNAM,QFLG,WCIEN,WCFROM,WCTO,FOUND,INSCO,WRKNUM
+2 SET PATNUM=0
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNWC(PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 SET WRKNUM=0
+8 FOR
SET WRKNUM=$ORDER(^AUPNWC(PATNUM,11,WRKNUM))
IF +WRKNUM=0
QUIT
Begin DoDot:2
+9 SET FOUND=0
+10 SET WCFROM=$PIECE($GET(^AUPNWC(PATNUM,11,WRKNUM,0)),U,12)
+11 SET WCTO=$PIECE($GET(^AUPNWC(PATNUM,11,WRKNUM,0)),U,13)
+12 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(WCFROM,WCTO,.FOUND)
+13 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(WCFROM,WCTO,.FOUND)
+14 SET INSCO=$PIECE($GET(^AUPNWC(PATNUM,11,WRKNUM,0)),U,10)
+15 IF FOUND
Begin DoDot:3
+16 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+17 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,"W-"_INSCO)=""
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
GETCHIP ; Get CHIP (Childrens Medicaid)
+1 NEW PATNUM,INS,INSTYP,PATNAM,INSNO,FOUND,QFLG,CHFR,CHTO,ELGTO,ELGFR,AGE,MCDNUM,MCDPLAN,MCDPTYP,MCDIEN
+2 SET PATNUM=0
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNPAT(PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 SET AGE=$$AGE^AUPNPAT(PATNUM,DT)
+8 IF AGE>17
QUIT
+9 SET INS=0
+10 FOR
SET INS=$ORDER(^AUPNPRVT(PATNUM,11,INS))
IF +INS=0
QUIT
Begin DoDot:2
+11 SET INSNO=$PIECE($GET(^AUPNPRVT(PATNUM,11,INS,0)),U)
+12 SET FOUND=0
+13 ;IHS/OIT/NKD AG*7.1*12
IF $$INSTYP^AGUTL(INSNO)="K"
Begin DoDot:3
+14 SET CHFR=+$PIECE($GET(^AUPNPRVT(PATNUM,11,INS,0)),U,6)
+15 SET CHTO=$PIECE($GET(^AUPNPRVT(PATNUM,11,INS,0)),U,7)
+16 IF CHTO=""
SET CHTO=9999999
+17 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(CHFR,CHTO,.FOUND)
+18 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(CHFR,CHTO,.FOUND)
+19 IF FOUND
Begin DoDot:4
+20 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+21 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,INSNO)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 SET PATNUM=0
+23 FOR
SET PATNUM=$ORDER(^AUPNMCD("B",PATNUM))
IF PATNUM=""
QUIT
Begin DoDot:1
+24 IF '$$PTACTIVE(PATNUM)
QUIT
+25 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+26 SET MCDNUM=0
+27 FOR
SET MCDNUM=$ORDER(^AUPNMCD("B",PATNUM,MCDNUM))
IF MCDNUM=""
QUIT
Begin DoDot:2
+28 SET MCDPLAN=$PIECE($GET(^AUPNMCD(MCDNUM,0)),U,10)
+29 IF MCDPLAN=""
QUIT
+30 ;IHS/OIT/NKD AG*7.1*12
SET MCDPTYP=$$INSTYP^AGUTL(MCDPLAN)
+31 IF MCDPTYP="K"
Begin DoDot:3
+32 SET MCDIEN=0
+33 FOR
SET MCDIEN=$ORDER(^AUPNMCD(MCDNUM,11,MCDIEN))
IF +MCDIEN=0
QUIT
Begin DoDot:4
+34 SET CHFR=+$PIECE($GET(^AUPNMCD(MCDNUM,11,MCDIEN,0)),U)
+35 SET CHTO=$PIECE($GET(^AUPNMCD(MCDNUM,11,MCDIEN,0)),U,2)
+36 IF CHTO=""
SET CHTO=9999999
+37 SET FOUND=0
+38 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH(CHFR,CHTO,.FOUND)
+39 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2(CHFR,CHTO,.FOUND)
+40 IF FOUND
Begin DoDot:5
+41 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+42 SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM,"M-"_MCDNUM)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
+44 ;
GETNOAR ;Get patients without Alternate Resources
+1 NEW PATNUM,PATNAM,QFLG,MRIEN,FROM,TO,FOUND,MCRNUM,MCDNUM,RECINS,SEL
+2 SET PATNUM=0
+3 SET ^TMP("AGAGERP",$JOB)=""
+4 FOR
SET PATNUM=$ORDER(^AUPNPAT(PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+5 IF '$$PTACTIVE(PATNUM)
QUIT
+6 IF $$GET1^DIQ(2,PATNUM,.351)'=""
QUIT
+7 KILL AGINS,AGINSN1,AGINSNN,MAX
+8 SET SEL=0
+9 ; MEDICARE
DO FINDMCR^AGINS(PATNUM)
+10 ; MEDICAID
DO FINDMCD^AGINS(PATNUM)
+11 ; RAILROAD
DO FINDRRE^AGINS(PATNUM)
+12 ; PRIVATE
DO FINDPVT^AGINS(PATNUM)
+13 IF '$DATA(AGINS)
Begin DoDot:2
+14 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+15 IF PATNAM]""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
End DoDot:2
End DoDot:1
+16 QUIT
ELGDTCH(AGFR,AGTO,FOUND) ;Check Patient Eligibility Dates Against Report parameters
+1 NEW ELGFR,ELGTO
+2 SET ELGFR=+$PIECE($GET(EXCL("Elig Date Range")),U)
SET ELGTO=$PIECE($GET(EXCL("Elig Date Range")),U,3)
+3 IF AGTO=""
SET AGTO=9999999
+4 IF +$GET(AGFR)=0
QUIT
+5 IF '((AGTO<ELGFR)!(ELGTO<AGFR))
SET FOUND=1
+6 QUIT
+7 ;
ELGDTCH2(AGFR,AGTO,FOUND) ;Check Patient Eligibility Dates Against Report parameter
+1 NEW ELGFR,ELGTO
+2 SET (ELGFR,ELGTO)=DT
+3 IF AGTO=""
SET AGTO=9999999
+4 IF (+AGFR=0)
QUIT
+5 IF '((AGTO<ELGFR)!(ELGTO<AGFR))
SET FOUND=1
+6 QUIT
PTACTIVE(DFN) ;EP - SEE IF PATIENT IS ACTIVE IN AT LEAST ONE FACILTY
+1 NEW ACTIVE,FAC
+2 SET ACTIVE=1
+3 SET FAC=0
+4 FOR
SET FAC=$ORDER(^AUPNPAT(DFN,41,FAC))
IF ('FAC)!('ACTIVE)
QUIT
Begin DoDot:1
+5 IF FAC=DUZ(2)
IF $PIECE($GET(^AUPNPAT(DFN,41,FAC,0)),U,5)'=""
SET ACTIVE=0
QUIT
End DoDot:1
+6 QUIT ACTIVE
