AGINS ; IHS/ASDS/EFG - EXT ROUTINE TO BUILD AGINS ARRAY ;
;;7.1;PATIENT REGISTRATION;**1,2,3,11,12,13**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;IHS/OIT/NKD AG*7.1*13 MBI IMPLEMENTATION
;
EP ;
K AGINS
K AGINSN1,AGINSNN,MAX
S SEL=0
;BEGIN IHS/SD/TPF 9/30/2005 AG*7.1*1 FIX BAD DATA CALL ITEM 16
K FIXLIST
S FIXLIST(DFN)="",NOMSG=1
D FIXALL^AGDATA(.FIXLIST,NOMSG)
K NOMSG
;END
D FINDMCR(DFN)
D FINDMCD(DFN)
D FINDRRE(DFN)
D FINDPVT(DFN)
D FINDTPL(DFN)
D FINDWC(DFN)
D FINDGUAR(DFN)
;D ADDSEQNM
D ADDSEQNM^AGINS1 ;AG*7.1*3
I $D(AGINS) S MAX=SEL
K INS,INSPTR,SEL,COV,COVPTR,EFF,END,MCRPTR,RECPTR,RREPTR,SUFPTR,TYPE,PH,PHPTR,POLNUM
Q
FINDMCR(DFN) ;EP
Q:'DFN
N MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,COVPTR,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE
S (SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE,COVPTR)=""
S MCRPTR=""
F S MCRPTR=$O(^AUPNMCR("B",DFN,MCRPTR)) Q:'MCRPTR D
. ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
. ;NEXT 14 LINES OF CODE MOVED TO NEXT FOR LOOP
. S AGD1=0
. F S AGD1=$O(^AUPNMCR(DFN,11,AGD1)) Q:'AGD1 D
.. ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
.. S MCRSTR=$G(^AUPNMCR(MCRPTR,0))
.. S PCP=$P(MCRSTR,U,14)
.. S INSPTR=$P(MCRSTR,U,2)
.. S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
.. ;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
.. S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
.. ;S TYPE="R" AG*7.1*1 ITEM 2 IHS/SD/TPF 2/1/2006
.. ;IHS/OIT/NKD AG*7.1*13
.. ;S SUFPTR=$P(MCRSTR,U,4)
.. ;S SUF=$S(SUFPTR="":"",1:$P(^AUTTMCS(SUFPTR,0),U))
.. ;S POL=$P(MCRSTR,U,3)
.. ;S:POL'="" POLNUM=POL_SUF
.. S PHPTR="M"_MCRPTR
.. S PH=$P($G(^AUPNMCR(DFN,21)),U)
.. S RECPTR=MCRPTR,ISACTIVE="I",PLANNAME=""
.. ;NEW CODE PATCH 2
.. S MCRELIG=$G(^AUPNMCR(DFN,11,AGD1,0))
.. S RECPTR=DFN_",11,"_AGD1_","_0
.. S EFF=$P(MCRELIG,U)
.. S END=$P(MCRELIG,U,2)
.. S ISACTIVE=$$ISACTIVE(EFF,END)
.. S POLNUM=$$GETMCR^AGUTL(MCRPTR) ;IHS/OIT/NKD AG*7.1*13
.. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
.. ;E Q:'ISACTIVE
.. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
.. E I '$D(AGSEENLY) Q:'ISACTIVE
.. S COVPTR=""
.. S COV=$P(MCRELIG,U,3)
..;BEGIN NEW CODE IHS/SD/TPF 12/5/05 AG*7.1*1
..;I COV="D" D
..I $P(MCRELIG,U,4)'="" D ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
...S PLANNAME=$P(MCRELIG,U,4)
...S POLNUM=$P(MCRELIG,U,6)
...S INSPTR=$P(MCRELIG,U,4)
...S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
...;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
...S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
..;END NEW CODE
.. D LOAD^AGINS1
. I '$O(^AUPNMCR(MCRPTR,11,0)) D
.. S COV="",COVPTR="",EFF="",END=""
.. S ISACTIVE=$$ISACTIVE(EFF,END)
.. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
.. ;E Q:'ISACTIVE
.. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
.. E I '$D(AGSEENLY) Q:'ISACTIVE
.. S RECPTR=MCRPTR
.. D LOAD^AGINS1
K MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH
Q
FINDMCD(DFN) ;EP
Q:'DFN
N MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR,PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE
S (MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR)=""
S (PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE)=""
S MCDPTR=0,PHSTR=""
F S MCDPTR=$O(^AUPNMCD("B",DFN,MCDPTR)) Q:'MCDPTR D
. S MCDSTR=$G(^AUPNMCD(MCDPTR,0))
. S PLANPTR=$P(MCDSTR,U,10)
. S PLANNAME=PLANPTR
. S INSPTR=$P(MCDSTR,U,2)
. S MCDRATE=$P(MCDSTR,U,11)
. S PCP=$P(MCDSTR,U,14)
. S GRPNAME=$P(MCDSTR,U,17)
. S:GRPNAME'="" GRPNUMB=$P($G(^AUTNEGRP(GRPNAME,0)),U,2)
. I $P(MCDSTR,U,10)'="" D
.. S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
.. S TYPE="D"
. I $P(MCDSTR,U,10)="" S INS="MEDICAID",INSPTR=$P(MCDSTR,U,2),TYPE="D"
. S POLNUM=$P(MCDSTR,U,3)
. S PH=$P($G(^AUPNMCD(MCDPTR,21)),U)
. S PHPTR="D"_MCDPTR
. S RECPTR=MCDPTR
. S ISACTIVE="I"
. S AGD1=0
. F S AGD1=$O(^AUPNMCD(MCDPTR,11,AGD1)) Q:'AGD1 D
.. S MCDELIG=$G(^AUPNMCD(MCDPTR,11,AGD1,0))
.. S RECPTR=MCDPTR_",11,"_AGD1_","_0
.. S EFF=$P(MCDELIG,U)
.. S END=$P(MCDELIG,U,2)
.. S ISACTIVE=$$ISACTIVE(EFF,END)
.. S COVPTR=""
.. S COV=$P(MCDELIG,U,3)
. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
. ;E Q:'ISACTIVE
. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
. E I '$D(AGSEENLY) Q:'ISACTIVE
. D LOAD^AGINS1
K MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR
K PCP,GRPNAME,PLANNAME,MCDRATE,POLNUM,ISACTIVE
Q
FINDRRE(DFN) ;EP
Q:'DFN
N PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR,EFF,END,ISACTIVE,COVPTR,COV
S (PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR)=""
S (EFF,END,ISACTIVE,COVPTR,COV)=""
S RREPTR=""
F S RREPTR=$O(^AUPNRRE("B",DFN,RREPTR)) Q:'RREPTR D
. ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
. ;NEXT 11 LINES OF CODE MOVED TO NEXT FOR LOOP
. S AGD1=0
. F S AGD1=$O(^AUPNRRE(DFN,11,AGD1)) Q:'AGD1 D
.. ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
.. S RRESTR=$G(^AUPNRRE(DFN,0))
.. S INSPTR=$P(RRESTR,U,2)
.. S PCP=$P(RRESTR,U,14)
.. S PLANNAME=$P(RRESTR,U,4)
.. S INS=$S(INSPTR="":"",1:$P($G(^AUTNINS(INSPTR,0)),U))
.. S TYPE="R"
.. ;IHS/OIT/NKD AG*7.1*13
.. ;S PRE=$S($P(RRESTR,U,3)="":"",1:$P($G(^AUTTRRP($P(RRESTR,U,3),0)),U))
.. ;S POL=$P(RRESTR,U,4)
.. ;S POLNUM=PRE_POL
.. S PHPTR="R"_RREPTR
.. S PH=$P($G(^AUPNRRE(DFN,21)),U)
.. S RREELIG=$G(^AUPNRRE(DFN,11,AGD1,0))
.. S RECPTR=DFN_",11,"_AGD1_","_0
.. S EFF=$P(RREELIG,U)
.. S END=$P(RREELIG,U,2)
.. S ISACTIVE=$$ISACTIVE(EFF,END)
.. S POLNUM=$$GETRRE^AGUTL(RREPTR) ;IHS/OIT/NKD AG*7.1*13
.. S PLANNAME=""
.. S COVPTR=""
.. S COV=$P(RREELIG,U,3)
..I $P(RREELIG,U,4)'="" D ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
...S PLANNAME=$P(RREELIG,U,4)
...S POLNUM=$P(RREELIG,U,6)
...S INSPTR=$P(RREELIG,U,4)
...S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
...;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
...S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
..;END NEW CODE
.. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
.. ;E Q:'ISACTIVE
.. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
.. E I '$D(AGSEENLY) Q:'ISACTIVE
.. D LOAD^AGINS1
. I '$O(^AUPNRRE(RREPTR,11,0)) D
.. S COV=""
.. S COVPTR=""
.. S EFF=""
.. S END=""
.. S ISACTIVE=$$ISACTIVE(EFF,END)
.. S RECPTR=RREPTR
.. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
.. ;E Q:'ISACTIVE
.. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
.. E I '$D(AGSEENLY) Q:'ISACTIVE
.. D LOAD^AGINS1
K PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR
K EFF,END,ISACTIVE,COVPTR,COV
Q
FINDPVT(DFN) ;EP
Q:'DFN
N PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,EFF
S (PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,RELPOLHO,EFF)=""
S AGSEL=0
K AGPHFLAG
S AGD1=0
F S AGD1=$O(^AUPNPRVT(DFN,11,AGD1)) Q:'AGD1 D
. S PVTSTR=$G(^AUPNPRVT(DFN,11,AGD1,0))
. S RECPTR=DFN_",11,"_AGD1_","_0
. S INSPTR=$P(PVTSTR,U)
. S RELPOLHO=$P(PVTSTR,U,5)
. ;S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
. S INS=$S(INSPTR="":"",1:$P($G(^AUTNINS(INSPTR,0)),U)) ;AG*7.1*1 IM19391
. S TYPE="P"
. S PHPTR=TYPE_$P($G(^AUPNPRVT(DFN,11,AGD1,0)),U,8)
. I $D(PHPTR)&(PHPTR'="")&($L(PHPTR)>1) D
.. S PHREC=$G(^AUPN3PPH($E(PHPTR,2,10),0))
.. S GRPNUMB=$P($G(^AUPN3PPH($E(PHPTR,2,9),0)),U,6)
.. S GRPNAME=$S(GRPNUMB="":"",1:$P($G(^AUTNEGRP(GRPNUMB,0)),U))
.. S INSGEND=$P(PHREC,U,8)
.. S PH=$P(PHREC,U)
.. S COVPTR=$P(PHREC,U,5)
.. S (COV,DATEINEF,OPCOPAY,AOPCOINS,FAMDEDUC,INDDEDUC)=""
.. I COVPTR'="" D
... S COV=$S(COVPTR="":"",1:$P(^AUTTPIC(COVPTR,0),U))
... S DATEINEF=DT+.01,DATEINEF=$O(^AUTTPIC(COVPTR,19,"B",DATEINEF),-1)
... I DATEINEF="" S (OPCOPAY,COINS,FAMDEDUC,INDDEDUC)="" Q
... S DATEINEF=$O(^AUTTPIC(COVPTR,19,"B",DATEINEF,""))
... S OPCOPAY=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,2)
... S OPCOINS=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,3)
... S FAMDEDUC=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,11)
... S INDDEDUC=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,12)
.. S POLNUM=$P(PHREC,U,4)
. I '$D(PHPTR) S PHPTR="P"
. I $L(PHPTR)'>1 S (PHPTR,PH,COVPTR,COV,POLNUM)=""
. S EFF=$P(PVTSTR,U,6)
. S END=$P(PVTSTR,U,7)
. S ISACTIVE=$$ISACTIVE(EFF,END)
. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
. ;E Q:'ISACTIVE
. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
. E I '$D(AGSEENLY) Q:'ISACTIVE
. D LOAD^AGINS1
K PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,AGD1,PVTSTR,INS,PHEC,PHPAT
Q
FINDTPL(DFN) ;EP
Q:'DFN
N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1)=""
S AGTPLDT=0
F S AGTPLDT=$O(^AUPNTPL(DFN,1,AGTPLDT)) Q:'AGTPLDT D
.S AGDATA0=$G(^AUPNTPL(DFN,1,AGTPLDT,0))
.S AGDATA1=$G(^AUPNTPL(DFN,1,AGTPLDT,1))
.S GRPNAME=$P(AGDATA0,U,6)
.;S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),2))
.S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),U,2)) ;IM????? AG*7.1*2 FOUND BY DEVELOPER
.S RECPTR=DFN_",1,"_AGTPLDT
.S INSPTR=$P(AGDATA0,U,2)
.S EFF=$P(AGDATA0,U,4)
.S END=$P(AGDATA0,U,5)
.S ISACTIVE=$$ISACTIVE(EFF,END)
.S POLNUM=$P(AGDATA0,U,3)
.S PH=$P(AGDATA1,U)
.S PHPTR=""
.S INS=$S(INSPTR'="":$P($G(^AUTNINS(INSPTR,0)),U),1:"UNDEFINED")
.S INS=INS_" [T]"
.S (COV,TYPE)="T"
. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
. ;E Q:'ISACTIVE
. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
. E I '$D(AGSEENLY) Q:'ISACTIVE
.D LOAD^AGINS1
K PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
Q
FINDWC(DFN) ;EP
Q:'DFN
N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB)=""
S AGTPLDT=0
F S AGTPLDT=$O(^AUPNWC(DFN,11,AGTPLDT)) Q:'AGTPLDT D
.S AGDATA0=$G(^AUPNWC(DFN,11,AGTPLDT,0))
.S AGDATA1=$G(^AUPNWC(DFN,11,AGTPLDT,1))
.S RECPTR=DFN_","_AGTPLDT
.S GRPNAME=$P(AGDATA0,U,11)
.S:GRPNAME'="" GRPNUMB=$P($G(^AUTNEGRP(GRPNAME,0)),U,2)
.S ENTITY=$P(AGDATA0,U,10),INSPTR=ENTITY
.S EFF=$P(AGDATA0,U,12)
.S END=$P(AGDATA0,U,13)
.S ISACTIVE=$$ISACTIVE(EFF,END)
.S POLNUM=$P(AGDATA0,U,4)
.S PHPTR=$P(AGDATA0,U,6) ;EMPL PTR NOT PH PTR
.;S PH=$S(PHPTR="":"",1:$E($P(^AUTNEMPL(PHPTR,0),U),1,23))
.S PH=$S(PHPTR="":"",1:$E($P($G(^AUTNEMPL(PHPTR,0)),U),1,23)) ;IHS/SD/TPF AG*7.1*1 9/6/2005 IM18762
.S INS=$S(ENTITY'="":$P($G(^AUTNINS(ENTITY,0)),U),1:"UNDEFINED")
.S INS=INS_" [W]"
.S (COV,TYPE)="W"
. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
. ;E Q:'ISACTIVE
. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
. E I '$D(AGSEENLY) Q:'ISACTIVE
.D LOAD^AGINS1
K AGTPLDT,AGDATA0,AGDATA1,PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
Q
FINDGUAR(DFN) ;EP
Q:'DFN
N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP
S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP)=""
S AGGUAR=0
F S AGGUAR=$O(^AUPNGUAR(DFN,1,AGGUAR)) Q:'AGGUAR D
.S INSPTR=$P($P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";")_",0)"
.S POLNUM=$P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U,3)
.S INSGLO=U_$P($P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";",2)
.S INSGLORF=INSGLO_INSPTR
.;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
.;S INS=$P(@INSGLORF,U)
.S INS=$P($G(@INSGLORF),U)
.;S RECPTR=DFN_","_AGGUAR_","
.S RECPTR=DFN_",1,"_AGGUAR ;IHS/SD/TPF AG*7.1*1 9/7/2005
.I INSGLORF[("AUPNPAT") D
..S GSTREET=$S($P($G(^DPT(INS,.11)),U)'="":1,1:"")
..S GCITY=$S($P($G(^DPT(INS,.11)),U,4)'="":1,1:"")
..S GSTATE=$S($P($G(^DPT(INS,.11)),U,5)'="":1,1:"")
..S GZIP=$S($P($G(^DPT(INS,.11)),U,6)'="":1,1:"")
..S INS=$P($G(^DPT(INS,0)),U)
.E D
..S GSTREET=$S($P($G(@INSGLORF),U,2)'="":1,1:"")
..S GCITY=$S($P($G(@INSGLORF),U,3)'="":1,1:"")
..S GSTATE=$S($P($G(@INSGLORF),U,4)'="":1,1:"")
..S GZIP=$S($P($G(@INSGLORF),U,5)'="":1,1:"")
.S INSGLORF=$TR(INSGLORF,U)
.S INS=INS_" [G]"
.S (COV,TYPE)="G"
.S AGGUARDT=0
.F S AGGUARDT=$O(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT)) Q:'AGGUARDT D
..;S RECPTR=DFN_","_AGGUAR_","_AGGUARDT ;IHS/SD/TPF AG*7.1*1 9/7/2005
..S EFF=$P($G(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U)
..S END=$P($G(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U,2)
..S ISACTIVE=$$ISACTIVE(EFF,END)
..S (COV,TYPE)="G"
..S INSPTR=INSGLORF ;AG*71.*2 ADDED TO ACCOMODATE GUARNTOR IN ELIGIBLITY API ITEM 2 PAGE 11
.. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
.. ;E Q:'ISACTIVE
.. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
.. E I '$D(AGSEENLY) Q:'ISACTIVE
..D LOAD^AGINS1
K PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF
Q
ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
N OPENEND
I EFFDT="",(ENDDT="") Q 0
S ENDDT=ENDDT
S OPENEND=ENDDT=""
I OPENEND I DT=EFFDT!(DT>EFFDT) Q 1
I DT=EFFDT!(DT=ENDDT) Q 1
I DT>EFFDT&(DT<ENDDT) Q 1
Q 0
AGINS ; IHS/ASDS/EFG - EXT ROUTINE TO BUILD AGINS ARRAY ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2,3,11,12,13**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
+3 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+4 ;IHS/OIT/NKD AG*7.1*13 MBI IMPLEMENTATION
+5 ;
EP ;
+1 KILL AGINS
+2 KILL AGINSN1,AGINSNN,MAX
+3 SET SEL=0
+4 ;BEGIN IHS/SD/TPF 9/30/2005 AG*7.1*1 FIX BAD DATA CALL ITEM 16
+5 KILL FIXLIST
+6 SET FIXLIST(DFN)=""
SET NOMSG=1
+7 DO FIXALL^AGDATA(.FIXLIST,NOMSG)
+8 KILL NOMSG
+9 ;END
+10 DO FINDMCR(DFN)
+11 DO FINDMCD(DFN)
+12 DO FINDRRE(DFN)
+13 DO FINDPVT(DFN)
+14 DO FINDTPL(DFN)
+15 DO FINDWC(DFN)
+16 DO FINDGUAR(DFN)
+17 ;D ADDSEQNM
+18 ;AG*7.1*3
DO ADDSEQNM^AGINS1
+19 IF $DATA(AGINS)
SET MAX=SEL
+20 KILL INS,INSPTR,SEL,COV,COVPTR,EFF,END,MCRPTR,RECPTR,RREPTR,SUFPTR,TYPE,PH,PHPTR,POLNUM
+21 QUIT
FINDMCR(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,COVPTR,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE
+3 SET (SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE,COVPTR)=""
+4 SET MCRPTR=""
+5 FOR
SET MCRPTR=$ORDER(^AUPNMCR("B",DFN,MCRPTR))
IF 'MCRPTR
QUIT
Begin DoDot:1
+6 ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
+7 ;NEXT 14 LINES OF CODE MOVED TO NEXT FOR LOOP
+8 SET AGD1=0
+9 FOR
SET AGD1=$ORDER(^AUPNMCR(DFN,11,AGD1))
IF 'AGD1
QUIT
Begin DoDot:2
+10 ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
+11 SET MCRSTR=$GET(^AUPNMCR(MCRPTR,0))
+12 SET PCP=$PIECE(MCRSTR,U,14)
+13 SET INSPTR=$PIECE(MCRSTR,U,2)
+14 SET INS=$SELECT(INSPTR="":"",1:$PIECE(^AUTNINS(INSPTR,0),U))
+15 ;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
+16 ;IHS/OIT/NKD AG*7.1*12
SET TYPE=$$INSTYP^AGUTL(INSPTR)
+17 ;S TYPE="R" AG*7.1*1 ITEM 2 IHS/SD/TPF 2/1/2006
+18 ;IHS/OIT/NKD AG*7.1*13
+19 ;S SUFPTR=$P(MCRSTR,U,4)
+20 ;S SUF=$S(SUFPTR="":"",1:$P(^AUTTMCS(SUFPTR,0),U))
+21 ;S POL=$P(MCRSTR,U,3)
+22 ;S:POL'="" POLNUM=POL_SUF
+23 SET PHPTR="M"_MCRPTR
+24 SET PH=$PIECE($GET(^AUPNMCR(DFN,21)),U)
+25 SET RECPTR=MCRPTR
SET ISACTIVE="I"
SET PLANNAME=""
+26 ;NEW CODE PATCH 2
+27 SET MCRELIG=$GET(^AUPNMCR(DFN,11,AGD1,0))
+28 SET RECPTR=DFN_",11,"_AGD1_","_0
+29 SET EFF=$PIECE(MCRELIG,U)
+30 SET END=$PIECE(MCRELIG,U,2)
+31 SET ISACTIVE=$$ISACTIVE(EFF,END)
+32 ;IHS/OIT/NKD AG*7.1*13
SET POLNUM=$$GETMCR^AGUTL(MCRPTR)
+33 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
+34 ;E Q:'ISACTIVE
+35 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+36 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+37 SET COVPTR=""
+38 SET COV=$PIECE(MCRELIG,U,3)
+39 ;BEGIN NEW CODE IHS/SD/TPF 12/5/05 AG*7.1*1
+40 ;I COV="D" D
+41 ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
IF $PIECE(MCRELIG,U,4)'=""
Begin DoDot:3
+42 SET PLANNAME=$PIECE(MCRELIG,U,4)
+43 SET POLNUM=$PIECE(MCRELIG,U,6)
+44 SET INSPTR=$PIECE(MCRELIG,U,4)
+45 SET INS=$SELECT(INSPTR="":"",1:$PIECE(^AUTNINS(INSPTR,0),U))
+46 ;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
+47 ;IHS/OIT/NKD AG*7.1*12
SET TYPE=$$INSTYP^AGUTL(INSPTR)
End DoDot:3
+48 ;END NEW CODE
+49 DO LOAD^AGINS1
End DoDot:2
+50 IF '$ORDER(^AUPNMCR(MCRPTR,11,0))
Begin DoDot:2
+51 SET COV=""
SET COVPTR=""
SET EFF=""
SET END=""
+52 SET ISACTIVE=$$ISACTIVE(EFF,END)
+53 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
+54 ;E Q:'ISACTIVE
+55 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+56 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+57 SET RECPTR=MCRPTR
+58 DO LOAD^AGINS1
End DoDot:2
End DoDot:1
+59 KILL MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH
+60 QUIT
FINDMCD(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR,PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE
+3 SET (MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR)=""
+4 SET (PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE)=""
+5 SET MCDPTR=0
SET PHSTR=""
+6 FOR
SET MCDPTR=$ORDER(^AUPNMCD("B",DFN,MCDPTR))
IF 'MCDPTR
QUIT
Begin DoDot:1
+7 SET MCDSTR=$GET(^AUPNMCD(MCDPTR,0))
+8 SET PLANPTR=$PIECE(MCDSTR,U,10)
+9 SET PLANNAME=PLANPTR
+10 SET INSPTR=$PIECE(MCDSTR,U,2)
+11 SET MCDRATE=$PIECE(MCDSTR,U,11)
+12 SET PCP=$PIECE(MCDSTR,U,14)
+13 SET GRPNAME=$PIECE(MCDSTR,U,17)
+14 IF GRPNAME'=""
SET GRPNUMB=$PIECE($GET(^AUTNEGRP(GRPNAME,0)),U,2)
+15 IF $PIECE(MCDSTR,U,10)'=""
Begin DoDot:2
+16 SET INS=$SELECT(INSPTR="":"",1:$PIECE(^AUTNINS(INSPTR,0),U))
+17 SET TYPE="D"
End DoDot:2
+18 IF $PIECE(MCDSTR,U,10)=""
SET INS="MEDICAID"
SET INSPTR=$PIECE(MCDSTR,U,2)
SET TYPE="D"
+19 SET POLNUM=$PIECE(MCDSTR,U,3)
+20 SET PH=$PIECE($GET(^AUPNMCD(MCDPTR,21)),U)
+21 SET PHPTR="D"_MCDPTR
+22 SET RECPTR=MCDPTR
+23 SET ISACTIVE="I"
+24 SET AGD1=0
+25 FOR
SET AGD1=$ORDER(^AUPNMCD(MCDPTR,11,AGD1))
IF 'AGD1
QUIT
Begin DoDot:2
+26 SET MCDELIG=$GET(^AUPNMCD(MCDPTR,11,AGD1,0))
+27 SET RECPTR=MCDPTR_",11,"_AGD1_","_0
+28 SET EFF=$PIECE(MCDELIG,U)
+29 SET END=$PIECE(MCDELIG,U,2)
+30 SET ISACTIVE=$$ISACTIVE(EFF,END)
+31 SET COVPTR=""
+32 SET COV=$PIECE(MCDELIG,U,3)
End DoDot:2
+33 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+34 ;E Q:'ISACTIVE
+35 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+36 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+37 DO LOAD^AGINS1
End DoDot:1
+38 KILL MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR
+39 KILL PCP,GRPNAME,PLANNAME,MCDRATE,POLNUM,ISACTIVE
+40 QUIT
FINDRRE(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR,EFF,END,ISACTIVE,COVPTR,COV
+3 SET (PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR)=""
+4 SET (EFF,END,ISACTIVE,COVPTR,COV)=""
+5 SET RREPTR=""
+6 FOR
SET RREPTR=$ORDER(^AUPNRRE("B",DFN,RREPTR))
IF 'RREPTR
QUIT
Begin DoDot:1
+7 ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
+8 ;NEXT 11 LINES OF CODE MOVED TO NEXT FOR LOOP
+9 SET AGD1=0
+10 FOR
SET AGD1=$ORDER(^AUPNRRE(DFN,11,AGD1))
IF 'AGD1
QUIT
Begin DoDot:2
+11 ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
+12 SET RRESTR=$GET(^AUPNRRE(DFN,0))
+13 SET INSPTR=$PIECE(RRESTR,U,2)
+14 SET PCP=$PIECE(RRESTR,U,14)
+15 SET PLANNAME=$PIECE(RRESTR,U,4)
+16 SET INS=$SELECT(INSPTR="":"",1:$PIECE($GET(^AUTNINS(INSPTR,0)),U))
+17 SET TYPE="R"
+18 ;IHS/OIT/NKD AG*7.1*13
+19 ;S PRE=$S($P(RRESTR,U,3)="":"",1:$P($G(^AUTTRRP($P(RRESTR,U,3),0)),U))
+20 ;S POL=$P(RRESTR,U,4)
+21 ;S POLNUM=PRE_POL
+22 SET PHPTR="R"_RREPTR
+23 SET PH=$PIECE($GET(^AUPNRRE(DFN,21)),U)
+24 SET RREELIG=$GET(^AUPNRRE(DFN,11,AGD1,0))
+25 SET RECPTR=DFN_",11,"_AGD1_","_0
+26 SET EFF=$PIECE(RREELIG,U)
+27 SET END=$PIECE(RREELIG,U,2)
+28 SET ISACTIVE=$$ISACTIVE(EFF,END)
+29 ;IHS/OIT/NKD AG*7.1*13
SET POLNUM=$$GETRRE^AGUTL(RREPTR)
+30 SET PLANNAME=""
+31 SET COVPTR=""
+32 SET COV=$PIECE(RREELIG,U,3)
+33 ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
IF $PIECE(RREELIG,U,4)'=""
Begin DoDot:3
+34 SET PLANNAME=$PIECE(RREELIG,U,4)
+35 SET POLNUM=$PIECE(RREELIG,U,6)
+36 SET INSPTR=$PIECE(RREELIG,U,4)
+37 SET INS=$SELECT(INSPTR="":"",1:$PIECE(^AUTNINS(INSPTR,0),U))
+38 ;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
+39 ;IHS/OIT/NKD AG*7.1*12
SET TYPE=$$INSTYP^AGUTL(INSPTR)
End DoDot:3
+40 ;END NEW CODE
+41 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+42 ;E Q:'ISACTIVE
+43 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+44 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+45 DO LOAD^AGINS1
End DoDot:2
+46 IF '$ORDER(^AUPNRRE(RREPTR,11,0))
Begin DoDot:2
+47 SET COV=""
+48 SET COVPTR=""
+49 SET EFF=""
+50 SET END=""
+51 SET ISACTIVE=$$ISACTIVE(EFF,END)
+52 SET RECPTR=RREPTR
+53 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+54 ;E Q:'ISACTIVE
+55 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+56 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+57 DO LOAD^AGINS1
End DoDot:2
End DoDot:1
+58 KILL PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR
+59 KILL EFF,END,ISACTIVE,COVPTR,COV
+60 QUIT
FINDPVT(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,EFF
+3 SET (PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,RELPOLHO,EFF)=""
+4 SET AGSEL=0
+5 KILL AGPHFLAG
+6 SET AGD1=0
+7 FOR
SET AGD1=$ORDER(^AUPNPRVT(DFN,11,AGD1))
IF 'AGD1
QUIT
Begin DoDot:1
+8 SET PVTSTR=$GET(^AUPNPRVT(DFN,11,AGD1,0))
+9 SET RECPTR=DFN_",11,"_AGD1_","_0
+10 SET INSPTR=$PIECE(PVTSTR,U)
+11 SET RELPOLHO=$PIECE(PVTSTR,U,5)
+12 ;S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
+13 ;AG*7.1*1 IM19391
SET INS=$SELECT(INSPTR="":"",1:$PIECE($GET(^AUTNINS(INSPTR,0)),U))
+14 SET TYPE="P"
+15 SET PHPTR=TYPE_$PIECE($GET(^AUPNPRVT(DFN,11,AGD1,0)),U,8)
+16 IF $DATA(PHPTR)&(PHPTR'="")&($LENGTH(PHPTR)>1)
Begin DoDot:2
+17 SET PHREC=$GET(^AUPN3PPH($EXTRACT(PHPTR,2,10),0))
+18 SET GRPNUMB=$PIECE($GET(^AUPN3PPH($EXTRACT(PHPTR,2,9),0)),U,6)
+19 SET GRPNAME=$SELECT(GRPNUMB="":"",1:$PIECE($GET(^AUTNEGRP(GRPNUMB,0)),U))
+20 SET INSGEND=$PIECE(PHREC,U,8)
+21 SET PH=$PIECE(PHREC,U)
+22 SET COVPTR=$PIECE(PHREC,U,5)
+23 SET (COV,DATEINEF,OPCOPAY,AOPCOINS,FAMDEDUC,INDDEDUC)=""
+24 IF COVPTR'=""
Begin DoDot:3
+25 SET COV=$SELECT(COVPTR="":"",1:$PIECE(^AUTTPIC(COVPTR,0),U))
+26 SET DATEINEF=DT+.01
SET DATEINEF=$ORDER(^AUTTPIC(COVPTR,19,"B",DATEINEF),-1)
+27 IF DATEINEF=""
SET (OPCOPAY,COINS,FAMDEDUC,INDDEDUC)=""
QUIT
+28 SET DATEINEF=$ORDER(^AUTTPIC(COVPTR,19,"B",DATEINEF,""))
+29 SET OPCOPAY=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,2)
+30 SET OPCOINS=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,3)
+31 SET FAMDEDUC=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,11)
+32 SET INDDEDUC=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,12)
End DoDot:3
+33 SET POLNUM=$PIECE(PHREC,U,4)
End DoDot:2
+34 IF '$DATA(PHPTR)
SET PHPTR="P"
+35 IF $LENGTH(PHPTR)'>1
SET (PHPTR,PH,COVPTR,COV,POLNUM)=""
+36 SET EFF=$PIECE(PVTSTR,U,6)
+37 SET END=$PIECE(PVTSTR,U,7)
+38 SET ISACTIVE=$$ISACTIVE(EFF,END)
+39 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+40 ;E Q:'ISACTIVE
+41 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+42 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+43 DO LOAD^AGINS1
End DoDot:1
+44 KILL PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,AGD1,PVTSTR,INS,PHEC,PHPAT
+45 QUIT
FINDTPL(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
+3 SET (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1)=""
+4 SET AGTPLDT=0
+5 FOR
SET AGTPLDT=$ORDER(^AUPNTPL(DFN,1,AGTPLDT))
IF 'AGTPLDT
QUIT
Begin DoDot:1
+6 SET AGDATA0=$GET(^AUPNTPL(DFN,1,AGTPLDT,0))
+7 SET AGDATA1=$GET(^AUPNTPL(DFN,1,AGTPLDT,1))
+8 SET GRPNAME=$PIECE(AGDATA0,U,6)
+9 ;S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),2))
+10 ;IM????? AG*7.1*2 FOUND BY DEVELOPER
SET GRPNUMB=$SELECT(GRPNAME="":"",1:$PIECE($GET(^AUTNEGRP(GRPNAME,0)),U,2))
+11 SET RECPTR=DFN_",1,"_AGTPLDT
+12 SET INSPTR=$PIECE(AGDATA0,U,2)
+13 SET EFF=$PIECE(AGDATA0,U,4)
+14 SET END=$PIECE(AGDATA0,U,5)
+15 SET ISACTIVE=$$ISACTIVE(EFF,END)
+16 SET POLNUM=$PIECE(AGDATA0,U,3)
+17 SET PH=$PIECE(AGDATA1,U)
+18 SET PHPTR=""
+19 SET INS=$SELECT(INSPTR'="":$PIECE($GET(^AUTNINS(INSPTR,0)),U),1:"UNDEFINED")
+20 SET INS=INS_" [T]"
+21 SET (COV,TYPE)="T"
+22 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+23 ;E Q:'ISACTIVE
+24 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+25 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+26 DO LOAD^AGINS1
End DoDot:1
+27 KILL PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
+28 QUIT
FINDWC(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
+3 SET (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB)=""
+4 SET AGTPLDT=0
+5 FOR
SET AGTPLDT=$ORDER(^AUPNWC(DFN,11,AGTPLDT))
IF 'AGTPLDT
QUIT
Begin DoDot:1
+6 SET AGDATA0=$GET(^AUPNWC(DFN,11,AGTPLDT,0))
+7 SET AGDATA1=$GET(^AUPNWC(DFN,11,AGTPLDT,1))
+8 SET RECPTR=DFN_","_AGTPLDT
+9 SET GRPNAME=$PIECE(AGDATA0,U,11)
+10 IF GRPNAME'=""
SET GRPNUMB=$PIECE($GET(^AUTNEGRP(GRPNAME,0)),U,2)
+11 SET ENTITY=$PIECE(AGDATA0,U,10)
SET INSPTR=ENTITY
+12 SET EFF=$PIECE(AGDATA0,U,12)
+13 SET END=$PIECE(AGDATA0,U,13)
+14 SET ISACTIVE=$$ISACTIVE(EFF,END)
+15 SET POLNUM=$PIECE(AGDATA0,U,4)
+16 ;EMPL PTR NOT PH PTR
SET PHPTR=$PIECE(AGDATA0,U,6)
+17 ;S PH=$S(PHPTR="":"",1:$E($P(^AUTNEMPL(PHPTR,0),U),1,23))
+18 ;IHS/SD/TPF AG*7.1*1 9/6/2005 IM18762
SET PH=$SELECT(PHPTR="":"",1:$EXTRACT($PIECE($GET(^AUTNEMPL(PHPTR,0)),U),1,23))
+19 SET INS=$SELECT(ENTITY'="":$PIECE($GET(^AUTNINS(ENTITY,0)),U),1:"UNDEFINED")
+20 SET INS=INS_" [W]"
+21 SET (COV,TYPE)="W"
+22 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+23 ;E Q:'ISACTIVE
+24 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+25 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+26 DO LOAD^AGINS1
End DoDot:1
+27 KILL AGTPLDT,AGDATA0,AGDATA1,PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
+28 QUIT
FINDGUAR(DFN) ;EP
+1 IF 'DFN
QUIT
+2 NEW PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP
+3 SET (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP)=""
+4 SET AGGUAR=0
+5 FOR
SET AGGUAR=$ORDER(^AUPNGUAR(DFN,1,AGGUAR))
IF 'AGGUAR
QUIT
Begin DoDot:1
+6 SET INSPTR=$PIECE($PIECE($GET(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";")_",0)"
+7 SET POLNUM=$PIECE($GET(^AUPNGUAR(DFN,1,AGGUAR,0)),U,3)
+8 SET INSGLO=U_$PIECE($PIECE($GET(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";",2)
+9 SET INSGLORF=INSGLO_INSPTR
+10 ;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
+11 ;S INS=$P(@INSGLORF,U)
+12 SET INS=$PIECE($GET(@INSGLORF),U)
+13 ;S RECPTR=DFN_","_AGGUAR_","
+14 ;IHS/SD/TPF AG*7.1*1 9/7/2005
SET RECPTR=DFN_",1,"_AGGUAR
+15 IF INSGLORF[("AUPNPAT")
Begin DoDot:2
+16 SET GSTREET=$SELECT($PIECE($GET(^DPT(INS,.11)),U)'="":1,1:"")
+17 SET GCITY=$SELECT($PIECE($GET(^DPT(INS,.11)),U,4)'="":1,1:"")
+18 SET GSTATE=$SELECT($PIECE($GET(^DPT(INS,.11)),U,5)'="":1,1:"")
+19 SET GZIP=$SELECT($PIECE($GET(^DPT(INS,.11)),U,6)'="":1,1:"")
+20 SET INS=$PIECE($GET(^DPT(INS,0)),U)
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 SET GSTREET=$SELECT($PIECE($GET(@INSGLORF),U,2)'="":1,1:"")
+23 SET GCITY=$SELECT($PIECE($GET(@INSGLORF),U,3)'="":1,1:"")
+24 SET GSTATE=$SELECT($PIECE($GET(@INSGLORF),U,4)'="":1,1:"")
+25 SET GZIP=$SELECT($PIECE($GET(@INSGLORF),U,5)'="":1,1:"")
End DoDot:2
+26 SET INSGLORF=$TRANSLATE(INSGLORF,U)
+27 SET INS=INS_" [G]"
+28 SET (COV,TYPE)="G"
+29 SET AGGUARDT=0
+30 FOR
SET AGGUARDT=$ORDER(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT))
IF 'AGGUARDT
QUIT
Begin DoDot:2
+31 ;S RECPTR=DFN_","_AGGUAR_","_AGGUARDT ;IHS/SD/TPF AG*7.1*1 9/7/2005
+32 SET EFF=$PIECE($GET(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U)
+33 SET END=$PIECE($GET(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U,2)
+34 SET ISACTIVE=$$ISACTIVE(EFF,END)
+35 SET (COV,TYPE)="G"
+36 ;AG*71.*2 ADDED TO ACCOMODATE GUARNTOR IN ELIGIBLITY API ITEM 2 PAGE 11
SET INSPTR=INSGLORF
+37 ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
+38 ;E Q:'ISACTIVE
+39 ;AG*7.1*2 IM23575
IF '$DATA(AGSEENLY)
IF ($GET(SHOWINAC)=1)
IF ISACTIVE
QUIT
+40 IF '$TEST
IF '$DATA(AGSEENLY)
IF 'ISACTIVE
QUIT
+41 DO LOAD^AGINS1
End DoDot:2
End DoDot:1
+42 KILL PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF
+43 QUIT
ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
+1 NEW OPENEND
+2 IF EFFDT=""
IF (ENDDT="")
QUIT 0
+3 SET ENDDT=ENDDT
+4 SET OPENEND=ENDDT=""
+5 IF OPENEND
IF DT=EFFDT!(DT>EFFDT)
QUIT 1
+6 IF DT=EFFDT!(DT=ENDDT)
QUIT 1
+7 IF DT>EFFDT&(DT<ENDDT)
QUIT 1
+8 QUIT 0
