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

AGINS.m

Go to the documentation of this file.
  1. 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
  1. ;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
  1. ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
  1. ;IHS/OIT/NKD AG*7.1*13 MBI IMPLEMENTATION
  1. ;
  1. EP ;
  1. K AGINS
  1. K AGINSN1,AGINSNN,MAX
  1. S SEL=0
  1. ;BEGIN IHS/SD/TPF 9/30/2005 AG*7.1*1 FIX BAD DATA CALL ITEM 16
  1. K FIXLIST
  1. S FIXLIST(DFN)="",NOMSG=1
  1. D FIXALL^AGDATA(.FIXLIST,NOMSG)
  1. K NOMSG
  1. ;END
  1. D FINDMCR(DFN)
  1. D FINDMCD(DFN)
  1. D FINDRRE(DFN)
  1. D FINDPVT(DFN)
  1. D FINDTPL(DFN)
  1. D FINDWC(DFN)
  1. D FINDGUAR(DFN)
  1. ;D ADDSEQNM
  1. D ADDSEQNM^AGINS1 ;AG*7.1*3
  1. I $D(AGINS) S MAX=SEL
  1. K INS,INSPTR,SEL,COV,COVPTR,EFF,END,MCRPTR,RECPTR,RREPTR,SUFPTR,TYPE,PH,PHPTR,POLNUM
  1. Q
  1. FINDMCR(DFN) ;EP
  1. Q:'DFN
  1. N MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,COVPTR,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE
  1. S (SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH,INSPTR,SUFPTR,PCP,MCRPTR,TYPE,COVPTR)=""
  1. S MCRPTR=""
  1. F S MCRPTR=$O(^AUPNMCR("B",DFN,MCRPTR)) Q:'MCRPTR D
  1. . ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. . ;NEXT 14 LINES OF CODE MOVED TO NEXT FOR LOOP
  1. . S AGD1=0
  1. . F S AGD1=$O(^AUPNMCR(DFN,11,AGD1)) Q:'AGD1 D
  1. .. ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. .. S MCRSTR=$G(^AUPNMCR(MCRPTR,0))
  1. .. S PCP=$P(MCRSTR,U,14)
  1. .. S INSPTR=$P(MCRSTR,U,2)
  1. .. S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
  1. .. ;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
  1. .. S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
  1. .. ;S TYPE="R" AG*7.1*1 ITEM 2 IHS/SD/TPF 2/1/2006
  1. .. ;IHS/OIT/NKD AG*7.1*13
  1. .. ;S SUFPTR=$P(MCRSTR,U,4)
  1. .. ;S SUF=$S(SUFPTR="":"",1:$P(^AUTTMCS(SUFPTR,0),U))
  1. .. ;S POL=$P(MCRSTR,U,3)
  1. .. ;S:POL'="" POLNUM=POL_SUF
  1. .. S PHPTR="M"_MCRPTR
  1. .. S PH=$P($G(^AUPNMCR(DFN,21)),U)
  1. .. S RECPTR=MCRPTR,ISACTIVE="I",PLANNAME=""
  1. .. ;NEW CODE PATCH 2
  1. .. S MCRELIG=$G(^AUPNMCR(DFN,11,AGD1,0))
  1. .. S RECPTR=DFN_",11,"_AGD1_","_0
  1. .. S EFF=$P(MCRELIG,U)
  1. .. S END=$P(MCRELIG,U,2)
  1. .. S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .. S POLNUM=$$GETMCR^AGUTL(MCRPTR) ;IHS/OIT/NKD AG*7.1*13
  1. .. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
  1. .. ;E Q:'ISACTIVE
  1. .. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. .. E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .. S COVPTR=""
  1. .. S COV=$P(MCRELIG,U,3)
  1. ..;BEGIN NEW CODE IHS/SD/TPF 12/5/05 AG*7.1*1
  1. ..;I COV="D" D
  1. ..I $P(MCRELIG,U,4)'="" D ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. ...S PLANNAME=$P(MCRELIG,U,4)
  1. ...S POLNUM=$P(MCRELIG,U,6)
  1. ...S INSPTR=$P(MCRELIG,U,4)
  1. ...S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
  1. ...;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
  1. ...S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
  1. ..;END NEW CODE
  1. .. D LOAD^AGINS1
  1. . I '$O(^AUPNMCR(MCRPTR,11,0)) D
  1. .. S COV="",COVPTR="",EFF="",END=""
  1. .. S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2
  1. .. ;E Q:'ISACTIVE
  1. .. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. .. E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .. S RECPTR=MCRPTR
  1. .. D LOAD^AGINS1
  1. K MCRSTR,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH
  1. Q
  1. FINDMCD(DFN) ;EP
  1. Q:'DFN
  1. N MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR,PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE
  1. S (MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR)=""
  1. S (PCP,GRPNAME,PLANNAME,MCDRATE,ISACTIVE)=""
  1. S MCDPTR=0,PHSTR=""
  1. F S MCDPTR=$O(^AUPNMCD("B",DFN,MCDPTR)) Q:'MCDPTR D
  1. . S MCDSTR=$G(^AUPNMCD(MCDPTR,0))
  1. . S PLANPTR=$P(MCDSTR,U,10)
  1. . S PLANNAME=PLANPTR
  1. . S INSPTR=$P(MCDSTR,U,2)
  1. . S MCDRATE=$P(MCDSTR,U,11)
  1. . S PCP=$P(MCDSTR,U,14)
  1. . S GRPNAME=$P(MCDSTR,U,17)
  1. . S:GRPNAME'="" GRPNUMB=$P($G(^AUTNEGRP(GRPNAME,0)),U,2)
  1. . I $P(MCDSTR,U,10)'="" D
  1. .. S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
  1. .. S TYPE="D"
  1. . I $P(MCDSTR,U,10)="" S INS="MEDICAID",INSPTR=$P(MCDSTR,U,2),TYPE="D"
  1. . S POLNUM=$P(MCDSTR,U,3)
  1. . S PH=$P($G(^AUPNMCD(MCDPTR,21)),U)
  1. . S PHPTR="D"_MCDPTR
  1. . S RECPTR=MCDPTR
  1. . S ISACTIVE="I"
  1. . S AGD1=0
  1. . F S AGD1=$O(^AUPNMCD(MCDPTR,11,AGD1)) Q:'AGD1 D
  1. .. S MCDELIG=$G(^AUPNMCD(MCDPTR,11,AGD1,0))
  1. .. S RECPTR=MCDPTR_",11,"_AGD1_","_0
  1. .. S EFF=$P(MCDELIG,U)
  1. .. S END=$P(MCDELIG,U,2)
  1. .. S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .. S COVPTR=""
  1. .. S COV=$P(MCDELIG,U,3)
  1. . ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. . ;E Q:'ISACTIVE
  1. . I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. . E I '$D(AGSEENLY) Q:'ISACTIVE
  1. . D LOAD^AGINS1
  1. K MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR
  1. K PCP,GRPNAME,PLANNAME,MCDRATE,POLNUM,ISACTIVE
  1. Q
  1. FINDRRE(DFN) ;EP
  1. Q:'DFN
  1. N PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR,EFF,END,ISACTIVE,COVPTR,COV
  1. S (PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR)=""
  1. S (EFF,END,ISACTIVE,COVPTR,COV)=""
  1. S RREPTR=""
  1. F S RREPTR=$O(^AUPNRRE("B",DFN,RREPTR)) Q:'RREPTR D
  1. . ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. . ;NEXT 11 LINES OF CODE MOVED TO NEXT FOR LOOP
  1. . S AGD1=0
  1. . F S AGD1=$O(^AUPNRRE(DFN,11,AGD1)) Q:'AGD1 D
  1. .. ;BEGIN NEW CODE ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. .. S RRESTR=$G(^AUPNRRE(DFN,0))
  1. .. S INSPTR=$P(RRESTR,U,2)
  1. .. S PCP=$P(RRESTR,U,14)
  1. .. S PLANNAME=$P(RRESTR,U,4)
  1. .. S INS=$S(INSPTR="":"",1:$P($G(^AUTNINS(INSPTR,0)),U))
  1. .. S TYPE="R"
  1. .. ;IHS/OIT/NKD AG*7.1*13
  1. .. ;S PRE=$S($P(RRESTR,U,3)="":"",1:$P($G(^AUTTRRP($P(RRESTR,U,3),0)),U))
  1. .. ;S POL=$P(RRESTR,U,4)
  1. .. ;S POLNUM=PRE_POL
  1. .. S PHPTR="R"_RREPTR
  1. .. S PH=$P($G(^AUPNRRE(DFN,21)),U)
  1. .. S RREELIG=$G(^AUPNRRE(DFN,11,AGD1,0))
  1. .. S RECPTR=DFN_",11,"_AGD1_","_0
  1. .. S EFF=$P(RREELIG,U)
  1. .. S END=$P(RREELIG,U,2)
  1. .. S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .. S POLNUM=$$GETRRE^AGUTL(RREPTR) ;IHS/OIT/NKD AG*7.1*13
  1. .. S PLANNAME=""
  1. .. S COVPTR=""
  1. .. S COV=$P(RREELIG,U,3)
  1. ..I $P(RREELIG,U,4)'="" D ;IHS/SD/TPF 4/11/2006 AG*7.1*2 IM20417
  1. ...S PLANNAME=$P(RREELIG,U,4)
  1. ...S POLNUM=$P(RREELIG,U,6)
  1. ...S INSPTR=$P(RREELIG,U,4)
  1. ...S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
  1. ...;S TYPE=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,2),U))
  1. ...S TYPE=$$INSTYP^AGUTL(INSPTR) ;IHS/OIT/NKD AG*7.1*12
  1. ..;END NEW CODE
  1. .. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. .. ;E Q:'ISACTIVE
  1. .. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. .. E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .. D LOAD^AGINS1
  1. . I '$O(^AUPNRRE(RREPTR,11,0)) D
  1. .. S COV=""
  1. .. S COVPTR=""
  1. .. S EFF=""
  1. .. S END=""
  1. .. S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .. S RECPTR=RREPTR
  1. .. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. .. ;E Q:'ISACTIVE
  1. .. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. .. E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .. D LOAD^AGINS1
  1. K PCP,INSPTR,RREPTR,PLANNAME,INS,TYPE,PRE,POL,POLNUM,PHPTR,AGD1,RREELIG,RECPTR
  1. K EFF,END,ISACTIVE,COVPTR,COV
  1. Q
  1. FINDPVT(DFN) ;EP
  1. Q:'DFN
  1. N PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,EFF
  1. S (PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,RELPOLHO,EFF)=""
  1. S AGSEL=0
  1. K AGPHFLAG
  1. S AGD1=0
  1. F S AGD1=$O(^AUPNPRVT(DFN,11,AGD1)) Q:'AGD1 D
  1. . S PVTSTR=$G(^AUPNPRVT(DFN,11,AGD1,0))
  1. . S RECPTR=DFN_",11,"_AGD1_","_0
  1. . S INSPTR=$P(PVTSTR,U)
  1. . S RELPOLHO=$P(PVTSTR,U,5)
  1. . ;S INS=$S(INSPTR="":"",1:$P(^AUTNINS(INSPTR,0),U))
  1. . S INS=$S(INSPTR="":"",1:$P($G(^AUTNINS(INSPTR,0)),U)) ;AG*7.1*1 IM19391
  1. . S TYPE="P"
  1. . S PHPTR=TYPE_$P($G(^AUPNPRVT(DFN,11,AGD1,0)),U,8)
  1. . I $D(PHPTR)&(PHPTR'="")&($L(PHPTR)>1) D
  1. .. S PHREC=$G(^AUPN3PPH($E(PHPTR,2,10),0))
  1. .. S GRPNUMB=$P($G(^AUPN3PPH($E(PHPTR,2,9),0)),U,6)
  1. .. S GRPNAME=$S(GRPNUMB="":"",1:$P($G(^AUTNEGRP(GRPNUMB,0)),U))
  1. .. S INSGEND=$P(PHREC,U,8)
  1. .. S PH=$P(PHREC,U)
  1. .. S COVPTR=$P(PHREC,U,5)
  1. .. S (COV,DATEINEF,OPCOPAY,AOPCOINS,FAMDEDUC,INDDEDUC)=""
  1. .. I COVPTR'="" D
  1. ... S COV=$S(COVPTR="":"",1:$P(^AUTTPIC(COVPTR,0),U))
  1. ... S DATEINEF=DT+.01,DATEINEF=$O(^AUTTPIC(COVPTR,19,"B",DATEINEF),-1)
  1. ... I DATEINEF="" S (OPCOPAY,COINS,FAMDEDUC,INDDEDUC)="" Q
  1. ... S DATEINEF=$O(^AUTTPIC(COVPTR,19,"B",DATEINEF,""))
  1. ... S OPCOPAY=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,2)
  1. ... S OPCOINS=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,3)
  1. ... S FAMDEDUC=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,11)
  1. ... S INDDEDUC=$P($G(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,12)
  1. .. S POLNUM=$P(PHREC,U,4)
  1. . I '$D(PHPTR) S PHPTR="P"
  1. . I $L(PHPTR)'>1 S (PHPTR,PH,COVPTR,COV,POLNUM)=""
  1. . S EFF=$P(PVTSTR,U,6)
  1. . S END=$P(PVTSTR,U,7)
  1. . S ISACTIVE=$$ISACTIVE(EFF,END)
  1. . ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. . ;E Q:'ISACTIVE
  1. . I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. . E I '$D(AGSEENLY) Q:'ISACTIVE
  1. . D LOAD^AGINS1
  1. K PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,OPCOPAY,OPCOINS,FAMDEDUC,INDDEDUC,AGD1,PVTSTR,INS,PHEC,PHPAT
  1. Q
  1. FINDTPL(DFN) ;EP
  1. Q:'DFN
  1. N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
  1. S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1)=""
  1. S AGTPLDT=0
  1. F S AGTPLDT=$O(^AUPNTPL(DFN,1,AGTPLDT)) Q:'AGTPLDT D
  1. .S AGDATA0=$G(^AUPNTPL(DFN,1,AGTPLDT,0))
  1. .S AGDATA1=$G(^AUPNTPL(DFN,1,AGTPLDT,1))
  1. .S GRPNAME=$P(AGDATA0,U,6)
  1. .;S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),2))
  1. .S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),U,2)) ;IM????? AG*7.1*2 FOUND BY DEVELOPER
  1. .S RECPTR=DFN_",1,"_AGTPLDT
  1. .S INSPTR=$P(AGDATA0,U,2)
  1. .S EFF=$P(AGDATA0,U,4)
  1. .S END=$P(AGDATA0,U,5)
  1. .S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .S POLNUM=$P(AGDATA0,U,3)
  1. .S PH=$P(AGDATA1,U)
  1. .S PHPTR=""
  1. .S INS=$S(INSPTR'="":$P($G(^AUTNINS(INSPTR,0)),U),1:"UNDEFINED")
  1. .S INS=INS_" [T]"
  1. .S (COV,TYPE)="T"
  1. . ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. . ;E Q:'ISACTIVE
  1. . I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. . E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .D LOAD^AGINS1
  1. K PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,AGTPLDT,AGDATA0,AGDATA1
  1. Q
  1. FINDWC(DFN) ;EP
  1. Q:'DFN
  1. N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
  1. S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB)=""
  1. S AGTPLDT=0
  1. F S AGTPLDT=$O(^AUPNWC(DFN,11,AGTPLDT)) Q:'AGTPLDT D
  1. .S AGDATA0=$G(^AUPNWC(DFN,11,AGTPLDT,0))
  1. .S AGDATA1=$G(^AUPNWC(DFN,11,AGTPLDT,1))
  1. .S RECPTR=DFN_","_AGTPLDT
  1. .S GRPNAME=$P(AGDATA0,U,11)
  1. .S:GRPNAME'="" GRPNUMB=$P($G(^AUTNEGRP(GRPNAME,0)),U,2)
  1. .S ENTITY=$P(AGDATA0,U,10),INSPTR=ENTITY
  1. .S EFF=$P(AGDATA0,U,12)
  1. .S END=$P(AGDATA0,U,13)
  1. .S ISACTIVE=$$ISACTIVE(EFF,END)
  1. .S POLNUM=$P(AGDATA0,U,4)
  1. .S PHPTR=$P(AGDATA0,U,6) ;EMPL PTR NOT PH PTR
  1. .;S PH=$S(PHPTR="":"",1:$E($P(^AUTNEMPL(PHPTR,0),U),1,23))
  1. .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
  1. .S INS=$S(ENTITY'="":$P($G(^AUTNINS(ENTITY,0)),U),1:"UNDEFINED")
  1. .S INS=INS_" [W]"
  1. .S (COV,TYPE)="W"
  1. . ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. . ;E Q:'ISACTIVE
  1. . I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. . E I '$D(AGSEENLY) Q:'ISACTIVE
  1. .D LOAD^AGINS1
  1. K AGTPLDT,AGDATA0,AGDATA1,PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
  1. Q
  1. FINDGUAR(DFN) ;EP
  1. Q:'DFN
  1. N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP
  1. S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,GSTREET,GCITY,GSTATE,GZIP)=""
  1. S AGGUAR=0
  1. F S AGGUAR=$O(^AUPNGUAR(DFN,1,AGGUAR)) Q:'AGGUAR D
  1. .S INSPTR=$P($P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";")_",0)"
  1. .S POLNUM=$P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U,3)
  1. .S INSGLO=U_$P($P($G(^AUPNGUAR(DFN,1,AGGUAR,0)),U),";",2)
  1. .S INSGLORF=INSGLO_INSPTR
  1. .;IHS/OIT/NKD AG*7.1*11 ALLOW DISPLAY OF GUARANTOR IF THE ENTRY WAS DELETED
  1. .;S INS=$P(@INSGLORF,U)
  1. .S INS=$P($G(@INSGLORF),U)
  1. .;S RECPTR=DFN_","_AGGUAR_","
  1. .S RECPTR=DFN_",1,"_AGGUAR ;IHS/SD/TPF AG*7.1*1 9/7/2005
  1. .I INSGLORF[("AUPNPAT") D
  1. ..S GSTREET=$S($P($G(^DPT(INS,.11)),U)'="":1,1:"")
  1. ..S GCITY=$S($P($G(^DPT(INS,.11)),U,4)'="":1,1:"")
  1. ..S GSTATE=$S($P($G(^DPT(INS,.11)),U,5)'="":1,1:"")
  1. ..S GZIP=$S($P($G(^DPT(INS,.11)),U,6)'="":1,1:"")
  1. ..S INS=$P($G(^DPT(INS,0)),U)
  1. .E D
  1. ..S GSTREET=$S($P($G(@INSGLORF),U,2)'="":1,1:"")
  1. ..S GCITY=$S($P($G(@INSGLORF),U,3)'="":1,1:"")
  1. ..S GSTATE=$S($P($G(@INSGLORF),U,4)'="":1,1:"")
  1. ..S GZIP=$S($P($G(@INSGLORF),U,5)'="":1,1:"")
  1. .S INSGLORF=$TR(INSGLORF,U)
  1. .S INS=INS_" [G]"
  1. .S (COV,TYPE)="G"
  1. .S AGGUARDT=0
  1. .F S AGGUARDT=$O(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT)) Q:'AGGUARDT D
  1. ..;S RECPTR=DFN_","_AGGUAR_","_AGGUARDT ;IHS/SD/TPF AG*7.1*1 9/7/2005
  1. ..S EFF=$P($G(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U)
  1. ..S END=$P($G(^AUPNGUAR(DFN,1,AGGUAR,11,AGGUARDT,0)),U,2)
  1. ..S ISACTIVE=$$ISACTIVE(EFF,END)
  1. ..S (COV,TYPE)="G"
  1. ..S INSPTR=INSGLORF ;AG*71.*2 ADDED TO ACCOMODATE GUARNTOR IN ELIGIBLITY API ITEM 2 PAGE 11
  1. .. ;I $G(SHOWINAC)=1 Q:ISACTIVE ;IHS/SD/TPF 6/27/2006 AG*7.1*2 ATTACHMENT VIII.1
  1. .. ;E Q:'ISACTIVE
  1. .. I '$D(AGSEENLY),($G(SHOWINAC)=1) Q:ISACTIVE ;AG*7.1*2 IM23575
  1. .. E I '$D(AGSEENLY) Q:'ISACTIVE
  1. ..D LOAD^AGINS1
  1. K PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF
  1. Q
  1. ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
  1. N OPENEND
  1. I EFFDT="",(ENDDT="") Q 0
  1. S ENDDT=ENDDT
  1. S OPENEND=ENDDT=""
  1. I OPENEND I DT=EFFDT!(DT>EFFDT) Q 1
  1. I DT=EFFDT!(DT=ENDDT) Q 1
  1. I DT>EFFDT&(DT<ENDDT) Q 1
  1. Q 0