AGINSUPD ; IHS/ITSC/TPF - UPDATE SELECTION VARIABLE AFTER SCREEN FIELD IS EDITED ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;THESE TAGS ARE CALLED FROM SCREEN EDIT ROUTINES WHICH NEED TO
;UPDATE THE 'SELECTION' VARIABLE FOR THE ITEM BEING EDITED
;
FINDMCR(AGSELECT) ;EP
N TEMPDFN,MCRDATA,SUBSCRIP,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH
S SUBSCRIP=$P(AGSELECT,U,11)
S TEMPDFN=$P(SUBSCRIP,",")
Q:$G(TEMPDFN)="" ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
S AGD1=$P(SUBSCRIP,",",3)
S:AGD1="" AGD1=$O(^AUPNMCR(TEMPDFN,11,0))
S RECPTR=TEMPDFN_",11,"_AGD1_","_0
S MCRDATA=$G(^AUPNMCR(TEMPDFN,0))
S PCP=$P(MCRDATA,U,14)
S (INSPTR,INS)=""
S INSPTR=$P(MCRDATA,U,2)
S:INSPTR'="" INS=$P($G(^AUTNINS(INSPTR,0)),U)
S TYPE="R"
S SUFPTR=$P(MCRDATA,U,4)
S SUF=$S($G(SUFPTR)="":"",1:$P(^AUTTMCS(SUFPTR,0),U))
S POL=$P(MCRDATA,U,3)
S:POL'="" POLNUM=POL_SUF
S PHPTR="M"_TEMPDFN
S PH=$P($G(^AUPNMCR(TEMPDFN,21)),U)
S MCRELIG=$S($G(AGD1)="":"",1:$G(^AUPNMCR(TEMPDFN,11,AGD1,0)))
S EFF=$S(MCRELIG="":"",1:$P(MCRELIG,U))
S END=$S(MCRELIG="":"",1:$P(MCRELIG,U,2))
S ISACTIVE=$$ISACTIVE(EFF,END)
S COVPTR=""
S COV=$S(MCRELIG="":"",1:$P(MCRELIG,U,3))
D LOAD
Q AGSELECT
FINDMCD(AGSELECT) ;EP
N MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR
N PCP,GRPNAME,PLANNAME,MCDRATE,POLNUM
S SUBSCRIP=$P(AGSELECT,U,11)
S MCDPTR=$P(SUBSCRIP,",")
S AGD1=$P(SUBSCRIP,",",3)
S:AGD1="" AGD1=$O(^AUPNMCD(MCDPTR,11,0))
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=$P(^AUTNINS(INSPTR,0),U)
. S TYPE="D"
I $P(MCDSTR,U,10)="" S INS="MEDICAID",INSPTR=$P(MCDSTR,U,2),TYPE="D"
I $P(MCDSTR,U,3)="" S POLNUM=""
I $P(MCDSTR,U,3)'="" S POLNUM=$P(MCDSTR,U,3)
I $D(^AUPNMCD(MCDPTR,21)) D
. I $P(^AUPNMCD(MCDPTR,21),U)'="" S PH=$P(^AUPNMCD(MCDPTR,21),U)
. I $P(^AUPNMCD(MCDPTR,21),U)="" S PH=""
I '$D(^AUPNMCD(MCDPTR,21)) S PH=""
S PHPTR="D"_MCDPTR
S MCDELIG=$S($G(AGD1)'="":$G(^AUPNMCD(MCDPTR,11,AGD1,0)),1:"")
S RECPTR=MCDPTR_",11,"_AGD1_","_0
S EFF=$P(MCDELIG,U)
S END=$P(MCDELIG,U,2)
S ISACTIVE=$$ISACTIVE(EFF,END)
S COVPTR=""
I $P(MCDELIG,U,3)'="" S COV=$P(MCDELIG,U,3)
I $P(MCDELIG,U,3)="" S COV=""
D LOAD
Q AGSELECT
FINDRRE(AGSELECT) ;EP
N TEMPDFN,SUBSCRIP,RREDATA,PRE,POL,POLNUM,AGD1,RREELIG,EFF,END,PHPTR,PH,POLNUM,COV,PCP,PLANNAME
S SUBSCRIP=$P(AGSELECT,U,11)
S TEMPDFN=$P(SUBSCRIP,",")
Q:$G(TEMPDFN)="" ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
S RREDATA=$G(^AUPNRRE(TEMPDFN,0))
S AGD1=$P(SUBSCRIP,",",3)
S:AGD1="" AGD1=$O(^AUPNRRE(TEMPDFN,11,0))
S PCP=$P(RREDATA,U,14)
S (INSPTR,INS)=""
S INSPTR=$P(RREDATA,U,2)
S:INSPTR'="" INS=$P($G(^AUTNINS(INSPTR,0)),U)
S TYPE="R"
S PRE=""
S PREPTR=$P(RREDATA,U,3)
S:PREPTR'="" PRE=$P(^AUTTRRP(PREPTR,0),U)
S POL=$P(RREDATA,U,4)
S:POL'="" POLNUM=PRE_POL
S PHPTR="R"_TEMPDFN
S PH=$P($G(^AUPNRRE(TEMPDFN,21)),U)
S RREELIG=$S($G(AGD1)'="":$G(^AUPNRRE(TEMPDFN,11,AGD1,0)),1:"")
S RECPTR=TEMPDFN_",11,"_AGD1_","_0
S EFF=$P(RREELIG,U)
S END=$P(RREELIG,U,2)
S ISACTIVE=$$ISACTIVE(EFF,END)
S PLANNAME=$P(RREELIG,U,4)
S COVPTR=""
S COV=$P(RREELIG,U,3)
D LOAD
Q AGSELECT
FINDPVT(AGSELECT) ;EP
N PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,AGD1,PVTSTR,INS,PHREC,PHPAT,EFF,END
S SUBSCRIP=$P(AGSELECT,U,11)
S AGD1=$P(SUBSCRIP,",",3)
S TEMPDFN=$P(SUBSCRIP,",")
Q:$G(TEMPDFN)="" ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
S:AGD1="" AGD1=$O(^AUPNPRVT(TEMPDFN,11,0))
S PVTSTR=$G(^AUPNPRVT(TEMPDFN,11,AGD1,0))
S RECPTR=TEMPDFN_",11,"_AGD1_","_0
S INSPTR=$P(PVTSTR,U)
S RELPOLHO=$P(PVTSTR,U,5)
S INS=$S($G(INSPTR)'="":$P($G(^AUTNINS(INSPTR,0)),U),1:"")
S TYPE="P"
S PHPTR=TYPE_$S($G(AGD1)'="":$P($G(^AUPNPRVT(TEMPDFN,11,AGD1,0)),U,8),1:"")
I $E($G(PHPTR),2,10)'="" 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,COV)=$P(PHREC,U,5)
. I COVPTR'="" D
.. S COV=$P(^AUTTPIC(COVPTR,0),U)
.. ;GET THE MOST CURRENT DATE IN AFFECT BY TAKING TODAYS DATE AND GOING BACK ONE
.. 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)
E D
.S (PHREC,GRPNUMB,GRPNAME,PH,COVPTR,COV,POLNUM)=""
I $G(PVTSTR)'="" S EFF=$P(PVTSTR,U,6),END=$P(PVTSTR,U,7)
E S (EFF,END)=""
S ISACTIVE=$$ISACTIVE(EFF,END)
D LOAD
Q AGSELECT
FINDTPL(AGSELECT) ;EP
N TEMPDFN
S (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB)=""
S SUBSCRIP=$P(AGSELECT,U,11)
S TEMPDFN=$P(SUBSCRIP,",")
Q:$G(TEMPDFN)="" ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
S AGTPLDT=$P(SUBSCRIP,",",2)
S:AGTPLDT="" AGTPLDT=$O(^AUPNTPL(TEMPDFN,1,0))
S AGDATA0=$S(AGTPLDT="":"",1:$G(^AUPNTPL(TEMPDFN,1,AGTPLDT,0)))
S AGDATA1=$S(AGTPLDT="":"",1:$G(^AUPNTPL(TEMPDFN,1,AGTPLDT,1)))
S GRPNAME=$P(AGDATA0,U,6)
S GRPNUMB=$S(GRPNAME="":"",1:$P($G(^AUTNEGRP(GRPNAME,0)),U,2))
S RECPTR=TEMPDFN_","_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 INS=$S(INSPTR'="":$P($G(^AUTNINS(INSPTR,0)),U),1:"UNDEFINED")
S (COV,TYPE)="T"
D LOAD
K AGTPLDT,AGDATA0,AGDATA1,PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
Q AGSELECT
FINDWC(AGSELECT) ;EP
N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,SUBSCRIP
S SUBSCRIP=$P(AGSELECT,U,11)
S TEMPDFN=$P(SUBSCRIP,",")
Q:$G(TEMPDFN)="" ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
S AGWCDT=$P(SUBSCRIP,",",2)
S:AGWCDT="" AGWCDT=$O(^AUPNWC(TEMPDFN,11,0))
I '$D(^AUPNWC(TEMPDFN,11,AGWCDT)) S AGWCDT=$O(^AUPNWC(TEMPDFN,11,AGWCDT,0))
S AGDATA0=$S($G(AGWCDT)="":"",1:$G(^AUPNWC(TEMPDFN,11,AGWCDT,0)))
S AGDATA1=$S($G(AGWCDT)="":"",1:$G(^AUPNWC(TEMPDFN,11,AGWCDT,1)))
S RECPTR=TEMPDFN_","_AGWCDT
S GRPNAME=$P(AGDATA0,U,11)
S GRPNUMB=$S(GRPNAME="":"",1:$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 PH=$P(AGDATA0,U,6)
S INS=$S(ENTITY'="":$P($G(^AUTNINS(ENTITY,0)),U),1:"UNDEFINED")
S (COV,TYPE)="W"
D LOAD
Q AGSELECT
FINDGUAR(AGSELECT) ;EP
N PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,TEMPDFN
S SUBSCRIP=$P(AGSELECT,U,11)
S TEMPDFN=$P(SUBSCRIP,",")
S AGGUAR=$P(SUBSCRIP,",",2)
S AGGUARDT=$P(SUBSCRIP,",",3)
S:AGGUARDT="" AGGUARDT=$O(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,0))
I '$D(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT)) S AGGUARDT=$O(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,0))
S POLNUM=$S($G(AGGUAR)="":"",1:$P($G(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U,3))
S RECPTR=TEMPDFN_","_AGGUAR_","_AGGUARDT
S INSPTR=$S($G(AGGUAR)="":"",1:$P($P($G(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U),";")_",0)")
S INSGLO=$S($G(AGGUAR)="":"",1:U_$P($P($G(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U),";",2))
S INSGLORF=INSGLO_INSPTR
S INS=$P(@INSGLORF,U)
I INSGLORF[("AUPNPAT") D
.S GSTREET=$S($G(INS)="":"",1:$P($G(^DPT(INS,.11)),U))
.S GCITY=$S($G(INS)="":"",1:$P($G(^DPT(INS,.11)),U,4))
.S GSTATE=$S($G(INS)="":"",1:$P($G(^DPT(INS,.11)),U,5))
.S GZIP=$S($G(INS)="":"",1:$P($G(^DPT(INS,.11)),U,6))
.S INS=$S($G(INS)="":"",1:$P($G(^DPT(INS,0)),U))
E D
.S GSTREET=$P($G(@INSGLORF),U,2)
.S GCITY=$P($G(@INSGLORF),U,3)
.S GSTATE=$P($G(@INSGLORF),U,4)
.S GZIP=$P($G(@INSGLORF),U,5)
S INSGLORF=$TR(INSGLORF,U)
I $G(AGGUAR)'="",($G(AGGUARDT)'="") S EFF=$P($G(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT,0)),U),END=$P($G(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT,0)),U,2)
E S (EFF,END)=""
S ISACTIVE=$$ISACTIVE(EFF,END)
S (COV,TYPE)="G"
D LOAD
Q AGSELECT
ISACTIVE(EFFDT,ENDDT) ;EP - IS THE POLICY ACTIVE AS OF TODAY
NEW OPENEND
I EFFDT="",(ENDDT="") Q 0 ;NO DATES CONSIDERED INACTIVE
S ENDDT=ENDDT ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
; IN FORCE FOR ALL OF TODAY
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
LOAD ;LOAD SELECTION VARIABLE WITH CURRENT ELIGIBILITY DATA
S AGSELECT=$G(INS)_U_$G(INSPTR)_U_$G(COVPTR)_U_$G(COV)_U_$G(EFF)_U_$G(END)_U_$G(PHPTR)_U_$G(PH)_U_$G(POLNUM)_U_$G(TYPE)_U_$G(RECPTR)_U_$G(PLANPTR)_U_$G(ISACTIVE)_U_$G(INSGLORF)_U_$G(MCDRATE)_U_$G(RELPOLHO)
S AGSELECT=AGSELECT_U_$G(PCP)_U_$G(PLANNAME)_U_$G(GRPNAME)_U_$G(GRPNUMB)_U_$G(GSTREET)_U_$G(GCITY)_U_$G(GSTATE)_U_$G(GZIP)_U_$G(INSGEND)_U_$G(OPCOPAY)_U_$G(OPCOINS)_U_$G(FAMDEDUC)_U_$G(INDDEDUC)
Q
AGINSUPD ; IHS/ITSC/TPF - UPDATE SELECTION VARIABLE AFTER SCREEN FIELD IS EDITED ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;THESE TAGS ARE CALLED FROM SCREEN EDIT ROUTINES WHICH NEED TO
+3 ;UPDATE THE 'SELECTION' VARIABLE FOR THE ITEM BEING EDITED
+4 ;
FINDMCR(AGSELECT) ;EP
+1 NEW TEMPDFN,MCRDATA,SUBSCRIP,SUF,POL,POLNUM,AGD1,MCRELIG,EFF,END,INS,COV,PHPTR,PH
+2 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+3 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+4 ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
IF $GET(TEMPDFN)=""
QUIT
+5 SET AGD1=$PIECE(SUBSCRIP,",",3)
+6 IF AGD1=""
SET AGD1=$ORDER(^AUPNMCR(TEMPDFN,11,0))
+7 SET RECPTR=TEMPDFN_",11,"_AGD1_","_0
+8 SET MCRDATA=$GET(^AUPNMCR(TEMPDFN,0))
+9 SET PCP=$PIECE(MCRDATA,U,14)
+10 SET (INSPTR,INS)=""
+11 SET INSPTR=$PIECE(MCRDATA,U,2)
+12 IF INSPTR'=""
SET INS=$PIECE($GET(^AUTNINS(INSPTR,0)),U)
+13 SET TYPE="R"
+14 SET SUFPTR=$PIECE(MCRDATA,U,4)
+15 SET SUF=$SELECT($GET(SUFPTR)="":"",1:$PIECE(^AUTTMCS(SUFPTR,0),U))
+16 SET POL=$PIECE(MCRDATA,U,3)
+17 IF POL'=""
SET POLNUM=POL_SUF
+18 SET PHPTR="M"_TEMPDFN
+19 SET PH=$PIECE($GET(^AUPNMCR(TEMPDFN,21)),U)
+20 SET MCRELIG=$SELECT($GET(AGD1)="":"",1:$GET(^AUPNMCR(TEMPDFN,11,AGD1,0)))
+21 SET EFF=$SELECT(MCRELIG="":"",1:$PIECE(MCRELIG,U))
+22 SET END=$SELECT(MCRELIG="":"",1:$PIECE(MCRELIG,U,2))
+23 SET ISACTIVE=$$ISACTIVE(EFF,END)
+24 SET COVPTR=""
+25 SET COV=$SELECT(MCRELIG="":"",1:$PIECE(MCRELIG,U,3))
+26 DO LOAD
+27 QUIT AGSELECT
FINDMCD(AGSELECT) ;EP
+1 NEW MCDPTR,MCDSTR,INSPTR,INS,COVPTR,COV,POL,PHPTR,PHSTR,PH,AGD1,MCDELIG,EFF,END,PLANPTR
+2 NEW PCP,GRPNAME,PLANNAME,MCDRATE,POLNUM
+3 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+4 SET MCDPTR=$PIECE(SUBSCRIP,",")
+5 SET AGD1=$PIECE(SUBSCRIP,",",3)
+6 IF AGD1=""
SET AGD1=$ORDER(^AUPNMCD(MCDPTR,11,0))
+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:1
+16 SET INS=$PIECE(^AUTNINS(INSPTR,0),U)
+17 SET TYPE="D"
End DoDot:1
+18 IF $PIECE(MCDSTR,U,10)=""
SET INS="MEDICAID"
SET INSPTR=$PIECE(MCDSTR,U,2)
SET TYPE="D"
+19 IF $PIECE(MCDSTR,U,3)=""
SET POLNUM=""
+20 IF $PIECE(MCDSTR,U,3)'=""
SET POLNUM=$PIECE(MCDSTR,U,3)
+21 IF $DATA(^AUPNMCD(MCDPTR,21))
Begin DoDot:1
+22 IF $PIECE(^AUPNMCD(MCDPTR,21),U)'=""
SET PH=$PIECE(^AUPNMCD(MCDPTR,21),U)
+23 IF $PIECE(^AUPNMCD(MCDPTR,21),U)=""
SET PH=""
End DoDot:1
+24 IF '$DATA(^AUPNMCD(MCDPTR,21))
SET PH=""
+25 SET PHPTR="D"_MCDPTR
+26 SET MCDELIG=$SELECT($GET(AGD1)'="":$GET(^AUPNMCD(MCDPTR,11,AGD1,0)),1:"")
+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 IF $PIECE(MCDELIG,U,3)'=""
SET COV=$PIECE(MCDELIG,U,3)
+33 IF $PIECE(MCDELIG,U,3)=""
SET COV=""
+34 DO LOAD
+35 QUIT AGSELECT
FINDRRE(AGSELECT) ;EP
+1 NEW TEMPDFN,SUBSCRIP,RREDATA,PRE,POL,POLNUM,AGD1,RREELIG,EFF,END,PHPTR,PH,POLNUM,COV,PCP,PLANNAME
+2 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+3 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+4 ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
IF $GET(TEMPDFN)=""
QUIT
+5 SET RREDATA=$GET(^AUPNRRE(TEMPDFN,0))
+6 SET AGD1=$PIECE(SUBSCRIP,",",3)
+7 IF AGD1=""
SET AGD1=$ORDER(^AUPNRRE(TEMPDFN,11,0))
+8 SET PCP=$PIECE(RREDATA,U,14)
+9 SET (INSPTR,INS)=""
+10 SET INSPTR=$PIECE(RREDATA,U,2)
+11 IF INSPTR'=""
SET INS=$PIECE($GET(^AUTNINS(INSPTR,0)),U)
+12 SET TYPE="R"
+13 SET PRE=""
+14 SET PREPTR=$PIECE(RREDATA,U,3)
+15 IF PREPTR'=""
SET PRE=$PIECE(^AUTTRRP(PREPTR,0),U)
+16 SET POL=$PIECE(RREDATA,U,4)
+17 IF POL'=""
SET POLNUM=PRE_POL
+18 SET PHPTR="R"_TEMPDFN
+19 SET PH=$PIECE($GET(^AUPNRRE(TEMPDFN,21)),U)
+20 SET RREELIG=$SELECT($GET(AGD1)'="":$GET(^AUPNRRE(TEMPDFN,11,AGD1,0)),1:"")
+21 SET RECPTR=TEMPDFN_",11,"_AGD1_","_0
+22 SET EFF=$PIECE(RREELIG,U)
+23 SET END=$PIECE(RREELIG,U,2)
+24 SET ISACTIVE=$$ISACTIVE(EFF,END)
+25 SET PLANNAME=$PIECE(RREELIG,U,4)
+26 SET COVPTR=""
+27 SET COV=$PIECE(RREELIG,U,3)
+28 DO LOAD
+29 QUIT AGSELECT
FINDPVT(AGSELECT) ;EP
+1 NEW PHPTR,PH,COVPTR,COV,POLNUM,PLANPTR,GRPNUMB,GRPNAME,PLANNAME,AGD1,PVTSTR,INS,PHREC,PHPAT,EFF,END
+2 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+3 SET AGD1=$PIECE(SUBSCRIP,",",3)
+4 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+5 ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
IF $GET(TEMPDFN)=""
QUIT
+6 IF AGD1=""
SET AGD1=$ORDER(^AUPNPRVT(TEMPDFN,11,0))
+7 SET PVTSTR=$GET(^AUPNPRVT(TEMPDFN,11,AGD1,0))
+8 SET RECPTR=TEMPDFN_",11,"_AGD1_","_0
+9 SET INSPTR=$PIECE(PVTSTR,U)
+10 SET RELPOLHO=$PIECE(PVTSTR,U,5)
+11 SET INS=$SELECT($GET(INSPTR)'="":$PIECE($GET(^AUTNINS(INSPTR,0)),U),1:"")
+12 SET TYPE="P"
+13 SET PHPTR=TYPE_$SELECT($GET(AGD1)'="":$PIECE($GET(^AUPNPRVT(TEMPDFN,11,AGD1,0)),U,8),1:"")
+14 IF $EXTRACT($GET(PHPTR),2,10)'=""
Begin DoDot:1
+15 SET PHREC=$GET(^AUPN3PPH($EXTRACT(PHPTR,2,10),0))
+16 SET GRPNUMB=$PIECE($GET(^AUPN3PPH($EXTRACT(PHPTR,2,9),0)),U,6)
+17 SET GRPNAME=$SELECT(GRPNUMB="":"",1:$PIECE($GET(^AUTNEGRP(GRPNUMB,0)),U))
+18 SET INSGEND=$PIECE(PHREC,U,8)
+19 SET PH=$PIECE(PHREC,U)
+20 SET (COVPTR,COV)=$PIECE(PHREC,U,5)
+21 IF COVPTR'=""
Begin DoDot:2
+22 SET COV=$PIECE(^AUTTPIC(COVPTR,0),U)
+23 ;GET THE MOST CURRENT DATE IN AFFECT BY TAKING TODAYS DATE AND GOING BACK ONE
+24 SET DATEINEF=DT+.01
SET DATEINEF=$ORDER(^AUTTPIC(COVPTR,19,"B",DATEINEF),-1)
+25 IF DATEINEF=""
SET (OPCOPAY,COINS,FAMDEDUC,INDDEDUC)=""
QUIT
+26 SET DATEINEF=$ORDER(^AUTTPIC(COVPTR,19,"B",DATEINEF,""))
+27 SET OPCOPAY=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,2)
+28 SET OPCOINS=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,3)
+29 SET FAMDEDUC=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,11)
+30 SET INDDEDUC=$PIECE($GET(^AUTTPIC(COVPTR,19,DATEINEF,0)),U,12)
End DoDot:2
+31 SET POLNUM=$PIECE(PHREC,U,4)
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 SET (PHREC,GRPNUMB,GRPNAME,PH,COVPTR,COV,POLNUM)=""
End DoDot:1
+34 IF $GET(PVTSTR)'=""
SET EFF=$PIECE(PVTSTR,U,6)
SET END=$PIECE(PVTSTR,U,7)
+35 IF '$TEST
SET (EFF,END)=""
+36 SET ISACTIVE=$$ISACTIVE(EFF,END)
+37 DO LOAD
+38 QUIT AGSELECT
FINDTPL(AGSELECT) ;EP
+1 NEW TEMPDFN
+2 SET (PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB)=""
+3 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+4 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+5 ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
IF $GET(TEMPDFN)=""
QUIT
+6 SET AGTPLDT=$PIECE(SUBSCRIP,",",2)
+7 IF AGTPLDT=""
SET AGTPLDT=$ORDER(^AUPNTPL(TEMPDFN,1,0))
+8 SET AGDATA0=$SELECT(AGTPLDT="":"",1:$GET(^AUPNTPL(TEMPDFN,1,AGTPLDT,0)))
+9 SET AGDATA1=$SELECT(AGTPLDT="":"",1:$GET(^AUPNTPL(TEMPDFN,1,AGTPLDT,1)))
+10 SET GRPNAME=$PIECE(AGDATA0,U,6)
+11 SET GRPNUMB=$SELECT(GRPNAME="":"",1:$PIECE($GET(^AUTNEGRP(GRPNAME,0)),U,2))
+12 SET RECPTR=TEMPDFN_","_AGTPLDT
+13 SET INSPTR=$PIECE(AGDATA0,U,2)
+14 SET EFF=$PIECE(AGDATA0,U,4)
+15 SET END=$PIECE(AGDATA0,U,5)
+16 SET ISACTIVE=$$ISACTIVE(EFF,END)
+17 SET POLNUM=$PIECE(AGDATA0,U,3)
+18 SET PH=$PIECE(AGDATA1,U)
+19 SET INS=$SELECT(INSPTR'="":$PIECE($GET(^AUTNINS(INSPTR,0)),U),1:"UNDEFINED")
+20 SET (COV,TYPE)="T"
+21 DO LOAD
+22 KILL AGTPLDT,AGDATA0,AGDATA1,PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB
+23 QUIT AGSELECT
FINDWC(AGSELECT) ;EP
+1 NEW PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,GRPNAME,GRPNUMB,SUBSCRIP
+2 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+3 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+4 ;IF NO DFN NO ENTRY CAN BE FOUND AT ALL
IF $GET(TEMPDFN)=""
QUIT
+5 SET AGWCDT=$PIECE(SUBSCRIP,",",2)
+6 IF AGWCDT=""
SET AGWCDT=$ORDER(^AUPNWC(TEMPDFN,11,0))
+7 IF '$DATA(^AUPNWC(TEMPDFN,11,AGWCDT))
SET AGWCDT=$ORDER(^AUPNWC(TEMPDFN,11,AGWCDT,0))
+8 SET AGDATA0=$SELECT($GET(AGWCDT)="":"",1:$GET(^AUPNWC(TEMPDFN,11,AGWCDT,0)))
+9 SET AGDATA1=$SELECT($GET(AGWCDT)="":"",1:$GET(^AUPNWC(TEMPDFN,11,AGWCDT,1)))
+10 SET RECPTR=TEMPDFN_","_AGWCDT
+11 SET GRPNAME=$PIECE(AGDATA0,U,11)
+12 SET GRPNUMB=$SELECT(GRPNAME="":"",1:$PIECE($GET(^AUTNEGRP(GRPNAME,0)),U,2))
+13 SET ENTITY=$PIECE(AGDATA0,U,10)
SET INSPTR=ENTITY
+14 SET EFF=$PIECE(AGDATA0,U,12)
+15 SET END=$PIECE(AGDATA0,U,13)
+16 SET ISACTIVE=$$ISACTIVE(EFF,END)
+17 SET POLNUM=$PIECE(AGDATA0,U,4)
+18 SET PH=$PIECE(AGDATA0,U,6)
+19 SET INS=$SELECT(ENTITY'="":$PIECE($GET(^AUTNINS(ENTITY,0)),U),1:"UNDEFINED")
+20 SET (COV,TYPE)="W"
+21 DO LOAD
+22 QUIT AGSELECT
FINDGUAR(AGSELECT) ;EP
+1 NEW PHPTR,PH,COVPTR,COV,POLNUM,INS,INSPTR,EFF,END,RECPTR,PLANPTR,INSGLORF,TEMPDFN
+2 SET SUBSCRIP=$PIECE(AGSELECT,U,11)
+3 SET TEMPDFN=$PIECE(SUBSCRIP,",")
+4 SET AGGUAR=$PIECE(SUBSCRIP,",",2)
+5 SET AGGUARDT=$PIECE(SUBSCRIP,",",3)
+6 IF AGGUARDT=""
SET AGGUARDT=$ORDER(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,0))
+7 IF '$DATA(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT))
SET AGGUARDT=$ORDER(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,0))
+8 SET POLNUM=$SELECT($GET(AGGUAR)="":"",1:$PIECE($GET(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U,3))
+9 SET RECPTR=TEMPDFN_","_AGGUAR_","_AGGUARDT
+10 SET INSPTR=$SELECT($GET(AGGUAR)="":"",1:$PIECE($PIECE($GET(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U),";")_",0)")
+11 SET INSGLO=$SELECT($GET(AGGUAR)="":"",1:U_$PIECE($PIECE($GET(^AUPNGUAR(TEMPDFN,1,AGGUAR,0)),U),";",2))
+12 SET INSGLORF=INSGLO_INSPTR
+13 SET INS=$PIECE(@INSGLORF,U)
+14 IF INSGLORF[("AUPNPAT")
Begin DoDot:1
+15 SET GSTREET=$SELECT($GET(INS)="":"",1:$PIECE($GET(^DPT(INS,.11)),U))
+16 SET GCITY=$SELECT($GET(INS)="":"",1:$PIECE($GET(^DPT(INS,.11)),U,4))
+17 SET GSTATE=$SELECT($GET(INS)="":"",1:$PIECE($GET(^DPT(INS,.11)),U,5))
+18 SET GZIP=$SELECT($GET(INS)="":"",1:$PIECE($GET(^DPT(INS,.11)),U,6))
+19 SET INS=$SELECT($GET(INS)="":"",1:$PIECE($GET(^DPT(INS,0)),U))
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET GSTREET=$PIECE($GET(@INSGLORF),U,2)
+22 SET GCITY=$PIECE($GET(@INSGLORF),U,3)
+23 SET GSTATE=$PIECE($GET(@INSGLORF),U,4)
+24 SET GZIP=$PIECE($GET(@INSGLORF),U,5)
End DoDot:1
+25 SET INSGLORF=$TRANSLATE(INSGLORF,U)
+26 IF $GET(AGGUAR)'=""
IF ($GET(AGGUARDT)'="")
SET EFF=$PIECE($GET(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT,0)),U)
SET END=$PIECE($GET(^AUPNGUAR(TEMPDFN,1,AGGUAR,11,AGGUARDT,0)),U,2)
+27 IF '$TEST
SET (EFF,END)=""
+28 SET ISACTIVE=$$ISACTIVE(EFF,END)
+29 SET (COV,TYPE)="G"
+30 DO LOAD
+31 QUIT AGSELECT
ISACTIVE(EFFDT,ENDDT) ;EP - IS THE POLICY ACTIVE AS OF TODAY
+1 NEW OPENEND
+2 ;NO DATES CONSIDERED INACTIVE
IF EFFDT=""
IF (ENDDT="")
QUIT 0
+3 ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
SET ENDDT=ENDDT
+4 ; IN FORCE FOR ALL OF TODAY
+5 SET OPENEND=ENDDT=""
+6 IF OPENEND
IF DT=EFFDT!(DT>EFFDT)
QUIT 1
+7 IF DT=EFFDT!(DT=ENDDT)
QUIT 1
+8 IF DT>EFFDT&(DT<ENDDT)
QUIT 1
+9 QUIT 0
LOAD ;LOAD SELECTION VARIABLE WITH CURRENT ELIGIBILITY DATA
+1 SET AGSELECT=$GET(INS)_U_$GET(INSPTR)_U_$GET(COVPTR)_U_$GET(COV)_U_$GET(EFF)_U_$GET(END)_U_$GET(PHPTR)_U_$GET(PH)_U_$GET(POLNUM)_U_$GET(TYPE)_U_$GET(RECPTR)_U_$GET(PLANPTR)_U_$GET(ISACTIVE)_U_$GET(INSGLORF)_U_$GET(MCDRATE)_U_$GET(RELPOLHO)
+2 SET AGSELECT=AGSELECT_U_$GET(PCP)_U_$GET(PLANNAME)_U_$GET(GRPNAME)_U_$GET(GRPNUMB)_U_$GET(GSTREET)_U_$GET(GCITY)_U_$GET(GSTATE)_U_$GET(GZIP)_U_$GET(INSGEND)_U_$GET(OPCOPAY)_U_$GET(OPCOINS)_U_$GET(FAMDEDUC)_U_$GET(INDDEDUC)
+3 QUIT
