Routine: AGAPIS1

AGAPIS1 ;IHS/ASDS/TPF - THESE APIS CALLS ARE CALLED FROM AGAPIS AND ARE LIMITED TO THE ELIGIBILITY API

 ;;7.1;PATIENT REGISTRATION;**2,4**;AUG 25,2005

 W !,"DO NOT CALL FROM ROOT!"

 ;GET RAILROAD RETIREMENT PART A & B

GETRRAB(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET TOP LEVEL

 S TPRECPTR=$P(RECPTR,",")

 D GETS^DIQ(9000005,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 M AGGINS=AGGDATA

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000005,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000005.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 I STDT="" S ENDDT="" Q

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000005,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M AGGINS=AGGDATA

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 K AGGDATA,AGGERR,AGGINS

 ;GET MEDICARE PART A & B

GETMCRAB(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET TOP LEVEL

 S TPRECPTR=$P(RECPTR,",")

 D GETS^DIQ(9000003,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 K AGGDATA,AGGERR

 D GETS^DIQ(9000003.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000003.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000003,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 K AGGDATA,AGGERR

 ;GET MEDICAID

GETMCD(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET TOP LEVEL FIELDS

 S TPRECPTR=$P(RECPTR,",")

 D GETS^DIQ(9000004,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000004.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")  ;MEDICAID

 Q:$D(AGGERR)

 S AGGFILE=9000004.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000004,TPRECPTR) Q

 I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 K AGGDATA,AGGERR

 ;GET RAILROAD RETIREMENT PART D

GETRRD(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000005.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000005.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000005,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M AGGINS=AGGDATA

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 K AGGINS,AGGDATA,AGGERR

 ;GET MEDICARE PART D

GETMCRD(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 K AGGDATA,AGGERR

 D GETS^DIQ(9000003.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000003.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000003,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 K AGGDATA,AGGERR

 ;GET GUARANTOR

GETGUAR(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET TOP LEVEL FIELDS

 S TPRECPTR=$P(RECPTR,",")

 D GETS^DIQ(9000043,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000043.0101,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")  ;MEDICAID

 Q:$D(AGGERR)

 S AGGFILE=9000043.0101

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000043.0101,TPRECPTR) Q

 I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 K AGGDATA,AGGERR

GETTPL(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000041.0101,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000041.0101

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000041.0101,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M AGGINS=AGGDATA

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 K AGGINS,AGGDATA,AGGERR

WCOMP(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",2)_","_$P(RECPTR,",")_","

 D GETS^DIQ(9000042.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000042.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000042.11,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M AGGINS=AGGDATA

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 K AGGERR,AGGDATA,AGGERR

GETPRVT(CATPRIOR) ;EP - CALLED BY AGAPIS

 ;GET JUST THE ONE SUB LEVEL

 S SBRECPTR=$P(RECPTR,",",3)_","_$P(RECPTR,",")_","

 K AGGDATA,AGGERR

 D GETS^DIQ(9000006.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 Q:$D(AGGERR)

 S AGGFILE=9000006.11

 D GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000006.11,TPRECPTR) Q

 I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR) Q  ;BAR*1.8*4 IM

 K STDT,ENDDT

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 ;NOW LETS GET THE POLICY HOLDER ENTRY

 K AGGPOLH,AGGERR

 D GETS^DIQ(9000006.11,SBRECPTR,.08,"I","AGGPOLH","AGGERR")

 Q:$D(AGGERR)

 S POLHPTR=$G(AGGPOLH(9000006.11,SBRECPTR,.08,"I"))

 Q:POLHPTR=""

 K AGGPOLH,AGGERR

 D GETS^DIQ(9000003.1,POLHPTR,"*",AGGFLAG,"AGGPOLH","AGGERR")

 Q:$D(AGGERR)

 M CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGPOLH

 K AGGPOLH,AGGDATA,AGGERR

 ;TAKE EXTERNAL DATE AND MAKE INTERNAL

INT(DATE) ;

 K %DT

 S X=DATE D ^%DT

 K %DT

Q Y

ISACTIVE(EFFDT,ENDDT,DOS) ;EP - DETERMINE WHETHER THE POLICY IS ACTIVE AS OF DOS

 N OPENEND

 I EFFDT="",(ENDDT="") Q 0  ;NO DATES CONSIDERED INACTIVE

 S ENDDT=ENDDT  ;TRUE IF END DATE IS AT COB OF END DATE - ANSWER FROM

 S OPENEND=ENDDT=""

 I OPENEND I DOS=EFFDT!(DOS>EFFDT) Q 1

 I DOS=EFFDT!(DOS=ENDDT) Q 1

 I DOS>EFFDT&(DOS<ENDDT) Q 1

Q 0

GETDATES(AGGFLAG,AGGDATA,AGGFILE) ;

 I AGGFLAG="R" D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE")))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE")))

 .S STDT=$$INT(STDT)

 .Q:ENDDT=""

 .S ENDDT=$$INT(ENDDT)

 I AGGFLAG="E" D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"E"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"E"))

 .S STDT=$$INT(STDT)

 .Q:ENDDT=""

 .S ENDDT=$$INT(ENDDT)

 I AGGFLAG="I" D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"I"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"I"))

 .S STDT=$$INT(STDT)

 .Q:ENDDT=""

 .S ENDDT=$$INT(ENDDT)

 I AGGFLAG["E"&(AGGFLAG["I")&(AGGFLAG'["R") D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"I"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"I"))

 I AGGFLAG["R"&(AGGFLAG["E")&(AGGFLAG'["I") D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"E"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"E"))

 .S STDT=$$INT(STDT)

 .Q:ENDDT=""

 .S ENDDT=$$INT(ENDDT)

 I AGGFLAG["R"&(AGGFLAG["I")&(AGGFLAG'["E") D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"I"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"I"))

 I AGGFLAG["R"&(AGGFLAG["E")&(AGGFLAG["I") D

 .S STDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"I"))

 .S ENDDT=$G(AGGDATA(AGGFILE,SBRECPTR,$S(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"I"))

AGAPIS1   ;IHS/ASDS/TPF - THESE APIS CALLS ARE CALLED FROM AGAPIS AND ARE LIMITED TO THE ELIGIBILITY API

 +1       ;;7.1;PATIENT REGISTRATION;**2,4**;AUG 25,2005

 +2        WRITE !,"DO NOT CALL FROM ROOT!"

 +3        QUIT

 +4       ;

 +5       ;GET RAILROAD RETIREMENT PART A & B

GETRRAB(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET TOP LEVEL

 +2        SET TPRECPTR=$PIECE(RECPTR,",")

 +3        DO GETS^DIQ(9000005,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        MERGE AGGINS=AGGDATA

 +6        MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 +7       ;GET JUST THE ONE SUB LEVEL

 +8        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +9        DO GETS^DIQ(9000005,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +10       IF $DATA(AGGERR)

               QUIT

 +11       SET AGGFILE=9000005.11

 +12       DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +13       IF STDT=""

               SET ENDDT=""

               QUIT

 +14      ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000005,TPRECPTR) Q

 +15      ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +16       KILL STDT,ENDDT

 +17       MERGE AGGINS=AGGDATA

 +18       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 +19       KILL AGGDATA,AGGERR,AGGINS

 +20       QUIT

 +21      ;GET MEDICARE PART A & B

GETMCRAB(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET TOP LEVEL

 +2        SET TPRECPTR=$PIECE(RECPTR,",")

 +3        DO GETS^DIQ(9000003,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +6       ;GET JUST THE ONE SUB LEVEL

 +7        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +8        KILL AGGDATA,AGGERR

 +9        DO GETS^DIQ(9000003.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +10       IF $DATA(AGGERR)

               QUIT

 +11       SET AGGFILE=9000003.11

 +12       DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +13      ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000003,TPRECPTR) Q

 +14      ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +15       KILL STDT,ENDDT

 +16       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +17       KILL AGGDATA,AGGERR

 +18       QUIT

 +19      ;GET MEDICAID

GETMCD(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET TOP LEVEL FIELDS

 +2        SET TPRECPTR=$PIECE(RECPTR,",")

 +3        DO GETS^DIQ(9000004,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +5       ;GET JUST THE ONE SUB LEVEL

 +6        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +7       ;MEDICAID

           DO GETS^DIQ(9000004.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +8        IF $DATA(AGGERR)

               QUIT

 +9        SET AGGFILE=9000004.11

 +10       DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +11      ;I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000004,TPRECPTR) Q

 +12      ;BAR*1.8*4 IM

           IF STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS))

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +13       KILL STDT,ENDDT

 +14       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +15       KILL AGGDATA,AGGERR

 +16       QUIT

 +17      ;GET RAILROAD RETIREMENT PART D

GETRRD(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET JUST THE ONE SUB LEVEL

 +2        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +3        DO GETS^DIQ(9000005.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        SET AGGFILE=9000005.11

 +6        DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +7       ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000005,TPRECPTR) Q

 +8       ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +9        KILL STDT,ENDDT

 +10       MERGE AGGINS=AGGDATA

 +11       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 +12       KILL AGGINS,AGGDATA,AGGERR

 +13       QUIT

 +14      ;GET MEDICARE PART D

GETMCRD(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET JUST THE ONE SUB LEVEL

 +2        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +3        KILL AGGDATA,AGGERR

 +4        DO GETS^DIQ(9000003.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +5        IF $DATA(AGGERR)

               QUIT

 +6        SET AGGFILE=9000003.11

 +7        DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +8       ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000003,TPRECPTR) Q

 +9       ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +10       KILL STDT,ENDDT

 +11       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +12       KILL AGGDATA,AGGERR

 +13       QUIT

 +14      ;GET GUARANTOR

GETGUAR(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET TOP LEVEL FIELDS

 +2        SET TPRECPTR=$PIECE(RECPTR,",")

 +3        DO GETS^DIQ(9000043,TPRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +6       ;GET JUST THE ONE SUB LEVEL

 +7        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +8       ;MEDICAID

           DO GETS^DIQ(9000043.0101,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +9        IF $DATA(AGGERR)

               QUIT

 +10       SET AGGFILE=9000043.0101

 +11       DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +12      ;I STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS)) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000043.0101,TPRECPTR) Q

 +13      ;BAR*1.8*4 IM

           IF STDT=""!('$$ISACTIVE(STDT,ENDDT,AGGDOS))

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +14       KILL STDT,ENDDT

 +15       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +16       KILL AGGDATA,AGGERR

 +17       QUIT

GETTPL(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET JUST THE ONE SUB LEVEL

 +2        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +3        DO GETS^DIQ(9000041.0101,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        SET AGGFILE=9000041.0101

 +6        DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +7       ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000041.0101,TPRECPTR) Q

 +8       ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +9        KILL STDT,ENDDT

 +10       MERGE AGGINS=AGGDATA

 +11       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 +12       KILL AGGINS,AGGDATA,AGGERR

 +13       QUIT

WCOMP(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET JUST THE ONE SUB LEVEL

 +2        SET SBRECPTR=$PIECE(RECPTR,",",2)_","_$PIECE(RECPTR,",")_","

 +3        DO GETS^DIQ(9000042.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +4        IF $DATA(AGGERR)

               QUIT

 +5        SET AGGFILE=9000042.11

 +6        DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +7       ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000042.11,TPRECPTR) Q

 +8       ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +9        KILL STDT,ENDDT

 +10       MERGE AGGINS=AGGDATA

 +11       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGINS

 +12       KILL AGGERR,AGGDATA,AGGERR

 +13       QUIT

GETPRVT(CATPRIOR) ;EP - CALLED BY AGAPIS

 +1       ;GET JUST THE ONE SUB LEVEL

 +2        SET SBRECPTR=$PIECE(RECPTR,",",3)_","_$PIECE(RECPTR,",")_","

 +3        KILL AGGDATA,AGGERR

 +4        DO GETS^DIQ(9000006.11,SBRECPTR,"*",AGGFLAG,"AGGDATA","AGGERR")

 +5        IF $DATA(AGGERR)

               QUIT

 +6        SET AGGFILE=9000006.11

 +7        DO GETDATES(AGGFLAG,.AGGDATA,AGGFILE)

 +8       ;I '$$ISACTIVE(STDT,ENDDT,AGGDOS) K AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR,9000006.11,TPRECPTR) Q

 +9       ;BAR*1.8*4 IM

           IF '$$ISACTIVE(STDT,ENDDT,AGGDOS)

               KILL AGGDATA,CATPRIOR(CATEGORY,PRIORITY,INSPTR)

               QUIT

 +10       KILL STDT,ENDDT

 +11       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGDATA

 +12      ;NOW LETS GET THE POLICY HOLDER ENTRY

 +13       KILL AGGPOLH,AGGERR

 +14       DO GETS^DIQ(9000006.11,SBRECPTR,.08,"I","AGGPOLH","AGGERR")

 +15       IF $DATA(AGGERR)

               QUIT

 +16       SET POLHPTR=$GET(AGGPOLH(9000006.11,SBRECPTR,.08,"I"))

 +17       IF POLHPTR=""

               QUIT

 +18       KILL AGGPOLH,AGGERR

 +19       DO GETS^DIQ(9000003.1,POLHPTR,"*",AGGFLAG,"AGGPOLH","AGGERR")

 +20       IF $DATA(AGGERR)

               QUIT

 +21       MERGE CATPRIOR(CATEGORY,PRIORITY,INSPTR)=AGGPOLH

 +22       KILL AGGPOLH,AGGDATA,AGGERR

 +23       QUIT

 +24      ;TAKE EXTERNAL DATE AND MAKE INTERNAL

INT(DATE) ;

 +1        KILL %DT

 +2        SET X=DATE

           DO ^%DT

 +3        KILL %DT

 +4        QUIT Y

ISACTIVE(EFFDT,ENDDT,DOS) ;EP - DETERMINE WHETHER THE POLICY IS ACTIVE AS OF DOS

 +1        NEW OPENEND

 +2       ;NO DATES CONSIDERED INACTIVE

           IF EFFDT=""

               IF (ENDDT="")

                   QUIT 0

 +3       ;TRUE IF END DATE IS AT COB OF END DATE - ANSWER FROM

           SET ENDDT=ENDDT

 +4        SET OPENEND=ENDDT=""

 +5        IF OPENEND

               IF DOS=EFFDT!(DOS>EFFDT)

                   QUIT 1

 +6        IF DOS=EFFDT!(DOS=ENDDT)

               QUIT 1

 +7        IF DOS>EFFDT&(DOS<ENDDT)

               QUIT 1

 +8        QUIT 0

GETDATES(AGGFLAG,AGGDATA,AGGFILE) ;

 +1        IF AGGFLAG="R"

               Begin DoDot:1

 +2                SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE")))

 +3                SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE")))

 +4                SET STDT=$$INT(STDT)

 +5                IF ENDDT=""

                       QUIT

 +6                SET ENDDT=$$INT(ENDDT)

               End DoDot:1

 +7        IF AGGFLAG="E"

               Begin DoDot:1

 +8                SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"E"))

 +9                SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"E"))

 +10               SET STDT=$$INT(STDT)

 +11               IF ENDDT=""

                       QUIT

 +12               SET ENDDT=$$INT(ENDDT)

               End DoDot:1

 +13       IF AGGFLAG="I"

               Begin DoDot:1

 +14               SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"I"))

 +15               SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"I"))

 +16               SET STDT=$$INT(STDT)

 +17               IF ENDDT=""

                       QUIT

 +18               SET ENDDT=$$INT(ENDDT)

               End DoDot:1

 +19       IF AGGFLAG["E"&(AGGFLAG["I")&(AGGFLAG'["R")

               Begin DoDot:1

 +20               SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.13,AGGFILE=9000041.0101:.04,AGGFILE=9000006.11:.06,1:.01),"I"))

 +21               SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000042.11:.14,AGGFILE=9000041.0101:.05,AGGFILE=9000006.11:.07,1:.02),"I"))

               End DoDot:1

 +22       IF AGGFLAG["R"&(AGGFLAG["E")&(AGGFLAG'["I")

               Begin DoDot:1

 +23               SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"E"))

 +24               SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"E"))

 +25               SET STDT=$$INT(STDT)

 +26               IF ENDDT=""

                       QUIT

 +27               SET ENDDT=$$INT(ENDDT)

               End DoDot:1

 +28       IF AGGFLAG["R"&(AGGFLAG["I")&(AGGFLAG'["E")

               Begin DoDot:1

 +29               SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"I"))

 +30               SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"I"))

               End DoDot:1

 +31       IF AGGFLAG["R"&(AGGFLAG["E")&(AGGFLAG["I")

               Begin DoDot:1

 +32               SET STDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"EFFECTIVE DATE",1:"ELIG. DATE"),"I"))

 +33               SET ENDDT=$GET(AGGDATA(AGGFILE,SBRECPTR,$SELECT(AGGFILE=9000043.0101!(AGGFILE=9000042.11)!(AGGFILE=9000041.0101):"ENDING DATE",1:"ELIG. END DATE"),"I"))

               End DoDot:1

 +34       QUIT

AGAPIS1.m