AGINSUPD.m

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)