- 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