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!"
Q
;
;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
Q
;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
Q
;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
Q
;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
Q
;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
Q
;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
Q
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
Q
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
Q
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
Q
;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"))
Q
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
