AGEDERR1 ; IHS/SD/TPF - EDIT CHECK CALLS ; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**1,2,3,4,5,7,8,10,12**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
Q
;EDIT CHK #1
AOBMISS(DFN) ;EP
;Quit if AOB required
I $$RQAOB^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*8
;
Q:DFN="" 1
N X
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
I '$$ISDEPEND^AGEDERR2(DFN) Q 0
;AOB CHECKED FOR PATIENTS W/ PRVT ONLY
Q:'$D(^AUPNPRVT("B",DFN))
S X=1_U_"PVT"_U
Q:'$$ACTELIG^AGEDERR2(DFN,X)_U_X 0
;END NEW
I $G(AGOPT("VERSION"))<7.1 Q $P($G(^AUPNPAT(DFN,0)),U,17)=""
Q $O(^AUPNPAT(DFN,71,0))=""
;EDIT CHK #2 - EMPLOYER INFO INC.
;TRUE IF NO EMPL STATUS
EMPMISS(DFN) ;EP - PER ALPHA TEST AND ADRIAN - ONLY CHECK FOR EMPLOYER
;IF EMPL STATUS IS NOT "UNEMPLOYED", "RETIRED", OR "UNKNOWN"
N X
Q:DFN="" 1
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
Q:$P($G(^AUPNPAT(DFN,0)),U,21)="" 1 ;EMPLOYMENT STATUS
S EMPSTAT=$P($G(^AUPNPAT(DFN,0)),U,21)
;IF EMPLOYMENT STATUS IS UNEMPLOYED, RETIRED, OR UNKNOWN DO NOT
;CHECK FOR EMPLOYER PTR
Q:EMPSTAT=3!(EMPSTAT=5)!(EMPSTAT=9) 0
S X=$P($G(^AUPNPAT(DFN,0)),U,19)
Q:X="" 1
S X=$G(^AUTNEMPL(X,0))
Q:$P(X,U,2)="" 1
Q:$P(X,U,3)="" 1
Q:$P(X,U,4)="" 1
Q:$P(X,U,5)="" 1
Q 0
;EDIT CHK #3 - AOB COMP
;LAST DATE IS OLDER THAN ONE YEAR OR BEFORE AN ACTIVE BEGIN DATE
AOBDUE(DFN) ;EP
;Quit if AOB required
I $$RQAOB^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*8
;
Q:DFN="" 1
N TARDT,X,X1,X2,X3
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END NEW
;ADRIAN 6/16/2005
;AOB SHOULD BE CHECKED FOR PRVT INS. ONLY
Q:'$D(^AUPNPRVT("B",DFN)) 0
S X=1_U_"PVT"_U
Q:'$$ACTELIG^AGEDERR2(DFN,X)_U_X 0
S TARDT=$$AOBCHEK^AGEDERR2(DFN)
;END
I $G(AGOPT("VERSION"))<7.1 Q $$AOBDUE7(DFN)
;DON'T CHK IF NO AOB ENTRIES
;S X3=$O(^AUPNPAT(DFN,71,"B",""),-1)
;Q:X3="" 0
S X2=$O(^AUPNPAT(DFN,71,"B",""),-1)
Q:X2="" 0 ;DO NOT REPORT ON MISSING THATS FOR ERROR #1
Q:X2<TARDT 1 ;AOB
S X1=DT
D ^%DTC
Q X>365
;7.0 CHK FOR AOB OVERDUE
AOBDUE7(DFN) ;EP
I $P($G(^AUPNPAT(DFN,0)),U,17)="" Q 1
S X2=$P($G(^AUPNPAT(DFN,0)),U,17)
S X1=DT
D ^%DTC
Q X>365
;EDIT CHK #4 - MSP MISSING
;RTNS T IF MISSING
MSPMISS(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
I '$$OVER65^AGEDERR2(DFN) Q 0
;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*1 IM19440 IF NO ACTIVE MEDICARE DON'T CHECK
;BEGIN AG*7.1*3 IM23545
I $P($G(AGSELECT),U,2)=2 Q:$$HASELIG^AGEDERR2(DFN)'[("MCR") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0
;E Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
;END AG*7.1*3 IM23545
;AG*7.1*3 IM25531
E I $P($G(AGSELECT),U,2)=1 Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
;END 1/20/05
I $G(AGOPT("VERSION"))<7.1 Q $P($G(^AUPNMCR(DFN,0)),U,5)=""
Q $O(^AUPNMSP("C",DFN,""),-1)=""
;EDIT CHK #5 - MSP EXPIRED
;TRUE IF PERIOD IS PAST 90 DAYS
MSPEXP(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
;I $$HASELIG^AGEDERR2(DFN)'[("MCR") Q 0 ;NO MEDICARE
;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*1 IM19440 IF NO ACTIVE MEDICARE DON'T CHECK
;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*5 H2771 ASKED TO PUT THIS CHECK BACK;AG*7.1*10 Removed check
;Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0 ;AG*7.1*5 H2771 ASKED TO PUT THIS CHECK BACK;AG*7.1*10 Removed check
;BEGIN AG*7.1*3 IM23545
I $P($G(AGSELECT),U,2)=2 Q:$$HASELIG^AGEDERR2(DFN)'[("MCR") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0
;E Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
;END AG*7.1*3 IM23545
;AG*7.1*3 IM25531
E I $P($G(AGSELECT),U,2)=1 Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
;END
I $G(AGOPT("VERSION"))<7.1 Q $$MSPEXP7(DFN) ;DO PRE 7.1 CHK
;DON'T CHK IF NO MCR ENTRIES
N X3
S X3=$O(^AUPNMCR("B",DFN,""),-1)
Q:X3="" 0
N X3
S X3=$O(^AUPNMSP("C",DFN,""),-1)
Q:X3="" 0
N X,X1,X2
S X2=$O(^AUPNMSP("C",DFN,""),-1)
Q:X2="" 1
S X1=DT
D ^%DTC
Q X>89
;PRE 7.1 CHK FOR EXP MSP DT
MSPEXP7(DFN) ;EP
S X2=$P($G(^AUPNMCR(DFN,0)),U,5)
S X1=DT
D ^%DTC
Q X>89
;EDIT CHK # 6 - PAT ADDR INC
PADDRINC(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
N X
S X=$G(^DPT(DFN,.11))
Q:X="" 1
Q:$P(X,U)="" 1
Q:$P(X,U,4)="" 1
Q:$P(X,U,5)="" 1
Q:$P(X,U,6)="" 1
Q 0
;EDIT CHK #7 - PAT DOB IS INC
PDOBINC(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
Q $P($G(^DPT(DFN,0)),U,3)=""
;EDIT CHK #8 - PT MARITAL STAT MISS
PMARMISS(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
Q $P($G(^DPT(DFN,0)),U,5)=""
;EDIT CHK #9 - PAT SEX MISSING
;RTNS T IF MISSING
PSEXMISS(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
Q $P($G(^DPT(DFN,0)),U,2)=""
;EDIT CHK #10 - PH ADDR MISSING
PHADDMIS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS,PHPTR,PH,INS
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
S FINDCALL="FINDPVT" ;ONLY CHK PRVT INS. AT THIS TIME.
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S SEQ=0,MISSING=0
F S SEQ=$O(AGINS(SEQ)) Q:SEQ="" D Q:MISSING
.;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
.Q:'$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
.;END 1/20/05
.S INS=$P(AGINS(SEQ),U)
.S PHPTR=$E($P(AGINS(SEQ),U,7),2,10)
.S PH=$P(AGINS(SEQ),U,8)
.S POLNUM=$P(AGINS(SEQ),U,9)
.S MISSING=PHPTR=""
.S:MISSING MISSING=MISSING_U_$$ERRDATA^AGEDERR(10)_"|"_$G(POLNUM)_"|"_$G(PH)_"|"_$G(INS) Q:MISSING
.S X=$G(^AUPN3PPH(PHPTR,0))
.S:$P(X,U,9)="" MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$G(POLNUM)_"|"_$G(PH)_"|"_$G(INS)
.S:$P(X,U,11)="" MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$G(POLNUM)_"|"_$G(PH)_"|"_$G(INS)
.S:$P(X,U,12)="" MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$G(POLNUM)_"|"_$G(PH)_"|"_$G(INS)
.S:$P(X,U,13)="" MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$G(POLNUM)_"|"_$G(PH)_"|"_$G(INS)
K AGINS
Q MISSING
;EDIT CHK #11 - POL IS SUPPLEMENTAL TO MEDICARE
MEDSUP(DFN,FINDCALL) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
S FINDCALL="FINDPVT" ;ONLY CHK PRVT INS. AT THIS TIME
N X,AGINS,MISSING
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
Q:'$D(AGINS) 0 ;NO AGINS ENTRY SO ALL WERE DELETED
S SEQ=0
S MISSING=0
F S SEQ=$O(AGINS(SEQ)) Q:SEQ="" D Q:MISSING
.;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
.Q:'$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
.;END 1/20/05
.S INSPTR=$P(AGINS(SEQ),U,2)
.S MISSING=INSPTR="" Q:MISSING
.S X=$G(^AUTNINS(INSPTR,0))
.S MISSING=X="" Q:MISSING
.S INS=$P(X,U)
.;S MISSING=$P($G(^AUTNINS(INSPTR,2)),U)="M" Q:MISSING
.S MISSING=$$INSTYP^AGUTL(INSPTR)="M" Q:MISSING ;IHS/OIT/NKD AG*7.1*12
K AGINS
Q MISSING_U_$$ERRDATA(11)_"|"_$G(INS)
;EDIT CHK #12 - GUARAN NAME AND ADDR MISSING
GURANMIS(DFN,FINDCALL) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
N X,SEQ,MISSING,AGINS
S FINDCALL="FINDGUAR" ;ONLY APPROPRIATE FOR GUARAN
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS^AGEDERR(21,12,"",9) Q:MISSING MISSING
S MISSING=$$CHKAGINS^AGEDERR(22,12,"",9) Q:MISSING MISSING
S MISSING=$$CHKAGINS^AGEDERR(23,12,"",9) Q:MISSING MISSING
S MISSING=$$CHKAGINS^AGEDERR(24,12,"",9) Q:MISSING MISSING
K AGINS
Q MISSING
;EDIT CHK #13 - ROI MISSING
;WARNING VERSION (SEE EDIT CHK #46 FOR ERROR VERSION)
ROIMISS(DFN) ;EP
;Quit if ROI required
I $$RQROI^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*8
;
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
;1/20/05
I '$$ISDEPEND^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
;END 1/20/05
I $G(AGOPT("VERSION"))<7.1 Q $P($G(^AUPNPAT(DFN,0)),U,4)=""
Q $O(^AUPNPAT(DFN,36,"B",""),-1)=""
;EDIT CHK #14 - ROI EXPIRED
;WARNING VERSION (SEE EDIT CHK #47 FOR ERROR VERSION)
ROIEXP(DFN) ;EP
;Quit if ROI required
I $$RQROI^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*8
;
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
I $G(AGOPT("VERSION"))<7.1 Q $$ROIEXP7(DFN) ;DO PRE 7.1 CHK
;DON'T CHK IF NO ROI ENTRY
N X3
S X3=$O(^AUPNPAT(DFN,36,"B",""),-1)
Q:X3="" 0
N X,X1,X2
S X2=$O(^AUPNPAT(DFN,36,"B",""),-1)
Q:X2="" 1
S X1=DT
D ^%DTC
Q X>365
;PRE 7.1 CHK FOR EXPIRED ROI
ROIEXP7(DFN) ;EP
N X1,X2
S X2=$P($G(^AUPNPAT(DFN,0)),U,4)
S X1=DT
D ^%DTC
Q X>365
;EDIT CHK #15 - EC INFO INCOMPLETE
;RTNS T IF INCOMPLETE
EMERCONT(DFN) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
N X
S X=$G(^AUPNPAT(DFN,31)) ;EC RELATIONSHIP
Q:$P(X,U,2)="" 1
S X=$G(^DPT(DFN,.33)) ;EC CONTACT INFO
Q:X="" 1
Q:$P(X,U,3)="" 1
Q:$P(X,U,6)="" 1
Q:$P(X,U,7)="" 1
Q:$P(X,U,8)="" 1
Q:$P(X,U,9)="" 1
Q 0
;EDIT CHK #16 - RELATIONSHIP TO PH MISSING
;RTNS T IF MISSING
RELPHMIS(DFN,FINDCALL) ;EP
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
S FINDCALL="FINDPVT" ;ONLY CHK PRVT INS. AT THIS TIME.
N X,AGINS,MISSING
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS^AGEDERR(16,16,"",9)
K AGINS
Q MISSING
;EDIT CHK #17 - COV TYPE NOT DEFINED(MISSING) FOR POL
;RTNS T IF MISSING
CVTYPMIS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
Q:'DFN 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS^AGEDERR(4,17,"","9,1")
K AGINS
Q MISSING
;EDIT CHK #18 - MISSING EFF DT OF ELIG
;THIS LOOKS AT ALL INSURANCES
;RTNS T IF MISSING IN ANY OF THEM
ELGDTMIS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS^AGEDERR(5,18,"","9,1")
K AGINS
Q MISSING
;EDIT CHK #19 - MISSING PH'S EMPLOYMENT STATUS
;RTNS T IF MISSING
EMPSTAMS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS,PHPTR
Q:DFN="" 1
;1/20/05
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I '$$HASELIG^AGEDERR2(DFN) Q 0
;END
S FINDCALL="FINDPVT" ;ONLY DO PRIVATE INSURANCE
;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
;SELECTED AN INSURER FROM THE AGINS ARRAY
I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
E D
.;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.I FINDCALL="" D FINDALL^AGEDERR(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS^AGEDERR(7,19,"",9)
I MISSING K AGINS Q MISSING
S SEQ=0
S MISSING=0
F S SEQ=$O(AGINS(SEQ)) Q:SEQ="" D Q:MISSING
.;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
.Q:'$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
.;END 1/20/05
.S PHPTR=$E($P(AGINS(SEQ),U,7),2,20)
.I PHPTR="" S MISSING=1 Q:MISSING
.S:$E(PHPTR)?1A PHPTR=$E($P(AGINS(SEQ),U,7),2,20)
.S MISSING=$P($G(^AUPN3PPH(PHPTR,0)),U,15)="" Q:MISSING
K AGINS
Q MISSING
;RETURN ERROR DATA
ERRDATA(ERR) ;EP
Q $P($G(^AGEDERRS(ERR,0)),U,1,3)
AGEDERR1 ; IHS/SD/TPF - EDIT CHECK CALLS ; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**1,2,3,4,5,7,8,10,12**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+3 QUIT
+4 ;EDIT CHK #1
AOBMISS(DFN) ;EP
+1 ;Quit if AOB required
+2 ;AG*7.1*8
IF $$RQAOB^AGEDERR4(DUZ(2))
QUIT 0
+3 ;
+4 IF DFN=""
QUIT 1
+5 NEW X
+6 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+7 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+8 IF '$$CURRUPD^AGEDERR2(DFN,365)
QUIT 0
+9 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+10 IF '$$ISDEPEND^AGEDERR2(DFN)
QUIT 0
+11 ;AOB CHECKED FOR PATIENTS W/ PRVT ONLY
+12 IF '$DATA(^AUPNPRVT("B",DFN))
QUIT
+13 SET X=1_U_"PVT"_U
+14 IF '$$ACTELIG^AGEDERR2(DFN,X)_U_X
QUIT 0
+15 ;END NEW
+16 IF $GET(AGOPT("VERSION"))<7.1
QUIT $PIECE($GET(^AUPNPAT(DFN,0)),U,17)=""
+17 QUIT $ORDER(^AUPNPAT(DFN,71,0))=""
+18 ;EDIT CHK #2 - EMPLOYER INFO INC.
+19 ;TRUE IF NO EMPL STATUS
EMPMISS(DFN) ;EP - PER ALPHA TEST AND ADRIAN - ONLY CHECK FOR EMPLOYER
+1 ;IF EMPL STATUS IS NOT "UNEMPLOYED", "RETIRED", OR "UNKNOWN"
+2 NEW X
+3 IF DFN=""
QUIT 1
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+7 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+8 ;EMPLOYMENT STATUS
IF $PIECE($GET(^AUPNPAT(DFN,0)),U,21)=""
QUIT 1
+9 SET EMPSTAT=$PIECE($GET(^AUPNPAT(DFN,0)),U,21)
+10 ;IF EMPLOYMENT STATUS IS UNEMPLOYED, RETIRED, OR UNKNOWN DO NOT
+11 ;CHECK FOR EMPLOYER PTR
+12 IF EMPSTAT=3!(EMPSTAT=5)!(EMPSTAT=9)
QUIT 0
+13 SET X=$PIECE($GET(^AUPNPAT(DFN,0)),U,19)
+14 IF X=""
QUIT 1
+15 SET X=$GET(^AUTNEMPL(X,0))
+16 IF $PIECE(X,U,2)=""
QUIT 1
+17 IF $PIECE(X,U,3)=""
QUIT 1
+18 IF $PIECE(X,U,4)=""
QUIT 1
+19 IF $PIECE(X,U,5)=""
QUIT 1
+20 QUIT 0
+21 ;EDIT CHK #3 - AOB COMP
+22 ;LAST DATE IS OLDER THAN ONE YEAR OR BEFORE AN ACTIVE BEGIN DATE
AOBDUE(DFN) ;EP
+1 ;Quit if AOB required
+2 ;AG*7.1*8
IF $$RQAOB^AGEDERR4(DUZ(2))
QUIT 0
+3 ;
+4 IF DFN=""
QUIT 1
+5 NEW TARDT,X,X1,X2,X3
+6 ;1/20/05
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+10 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+11 ;END NEW
+12 ;ADRIAN 6/16/2005
+13 ;AOB SHOULD BE CHECKED FOR PRVT INS. ONLY
+14 IF '$DATA(^AUPNPRVT("B",DFN))
QUIT 0
+15 SET X=1_U_"PVT"_U
+16 IF '$$ACTELIG^AGEDERR2(DFN,X)_U_X
QUIT 0
+17 SET TARDT=$$AOBCHEK^AGEDERR2(DFN)
+18 ;END
+19 IF $GET(AGOPT("VERSION"))<7.1
QUIT $$AOBDUE7(DFN)
+20 ;DON'T CHK IF NO AOB ENTRIES
+21 ;S X3=$O(^AUPNPAT(DFN,71,"B",""),-1)
+22 ;Q:X3="" 0
+23 SET X2=$ORDER(^AUPNPAT(DFN,71,"B",""),-1)
+24 ;DO NOT REPORT ON MISSING THATS FOR ERROR #1
IF X2=""
QUIT 0
+25 ;AOB
IF X2<TARDT
QUIT 1
+26 SET X1=DT
+27 DO ^%DTC
+28 QUIT X>365
+29 ;7.0 CHK FOR AOB OVERDUE
AOBDUE7(DFN) ;EP
+1 IF $PIECE($GET(^AUPNPAT(DFN,0)),U,17)=""
QUIT 1
+2 SET X2=$PIECE($GET(^AUPNPAT(DFN,0)),U,17)
+3 SET X1=DT
+4 DO ^%DTC
+5 QUIT X>365
+6 ;EDIT CHK #4 - MSP MISSING
+7 ;RTNS T IF MISSING
MSPMISS(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 IF '$$OVER65^AGEDERR2(DFN)
QUIT 0
+8 ;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*1 IM19440 IF NO ACTIVE MEDICARE DON'T CHECK
+9 ;BEGIN AG*7.1*3 IM23545
+10 IF $PIECE($GET(AGSELECT),U,2)=2
IF $$HASELIG^AGEDERR2(DFN)'[("MCR")
QUIT 0
IF '$$ACTELIG^AGEDERR2(DFN,"^MCR")
QUIT 0
+11 ;E Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
+12 ;END AG*7.1*3 IM23545
+13 ;AG*7.1*3 IM25531
+14 IF '$TEST
IF $PIECE($GET(AGSELECT),U,2)=1
IF $$HASELIG^AGEDERR2(DFN)'[("RRE")
QUIT 0
IF '$$ACTELIG^AGEDERR2(DFN,"^RRE")
QUIT 0
+15 ;END 1/20/05
+16 IF $GET(AGOPT("VERSION"))<7.1
QUIT $PIECE($GET(^AUPNMCR(DFN,0)),U,5)=""
+17 QUIT $ORDER(^AUPNMSP("C",DFN,""),-1)=""
+18 ;EDIT CHK #5 - MSP EXPIRED
+19 ;TRUE IF PERIOD IS PAST 90 DAYS
MSPEXP(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 ;I $$HASELIG^AGEDERR2(DFN)'[("MCR") Q 0 ;NO MEDICARE
+7 ;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*1 IM19440 IF NO ACTIVE MEDICARE DON'T CHECK
+8 ;Q:'$$ACTELIG^AGEDERR2(DFN,"^MCR") 0 ;AG*7.1*5 H2771 ASKED TO PUT THIS CHECK BACK;AG*7.1*10 Removed check
+9 ;Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0 ;AG*7.1*5 H2771 ASKED TO PUT THIS CHECK BACK;AG*7.1*10 Removed check
+10 ;BEGIN AG*7.1*3 IM23545
+11 IF $PIECE($GET(AGSELECT),U,2)=2
IF $$HASELIG^AGEDERR2(DFN)'[("MCR")
QUIT 0
IF '$$ACTELIG^AGEDERR2(DFN,"^MCR")
QUIT 0
+12 ;E Q:$$HASELIG^AGEDERR2(DFN)'[("RRE") 0 Q:'$$ACTELIG^AGEDERR2(DFN,"^RRE") 0
+13 ;END AG*7.1*3 IM23545
+14 ;AG*7.1*3 IM25531
+15 IF '$TEST
IF $PIECE($GET(AGSELECT),U,2)=1
IF $$HASELIG^AGEDERR2(DFN)'[("RRE")
QUIT 0
IF '$$ACTELIG^AGEDERR2(DFN,"^RRE")
QUIT 0
+16 ;END
+17 ;DO PRE 7.1 CHK
IF $GET(AGOPT("VERSION"))<7.1
QUIT $$MSPEXP7(DFN)
+18 ;DON'T CHK IF NO MCR ENTRIES
+19 NEW X3
+20 SET X3=$ORDER(^AUPNMCR("B",DFN,""),-1)
+21 IF X3=""
QUIT 0
+22 NEW X3
+23 SET X3=$ORDER(^AUPNMSP("C",DFN,""),-1)
+24 IF X3=""
QUIT 0
+25 NEW X,X1,X2
+26 SET X2=$ORDER(^AUPNMSP("C",DFN,""),-1)
+27 IF X2=""
QUIT 1
+28 SET X1=DT
+29 DO ^%DTC
+30 QUIT X>89
+31 ;PRE 7.1 CHK FOR EXP MSP DT
MSPEXP7(DFN) ;EP
+1 SET X2=$PIECE($GET(^AUPNMCR(DFN,0)),U,5)
+2 SET X1=DT
+3 DO ^%DTC
+4 QUIT X>89
+5 ;EDIT CHK # 6 - PAT ADDR INC
PADDRINC(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 NEW X
+9 SET X=$GET(^DPT(DFN,.11))
+10 IF X=""
QUIT 1
+11 IF $PIECE(X,U)=""
QUIT 1
+12 IF $PIECE(X,U,4)=""
QUIT 1
+13 IF $PIECE(X,U,5)=""
QUIT 1
+14 IF $PIECE(X,U,6)=""
QUIT 1
+15 QUIT 0
+16 ;EDIT CHK #7 - PAT DOB IS INC
PDOBINC(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 QUIT $PIECE($GET(^DPT(DFN,0)),U,3)=""
+9 ;EDIT CHK #8 - PT MARITAL STAT MISS
PMARMISS(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 QUIT $PIECE($GET(^DPT(DFN,0)),U,5)=""
+9 ;EDIT CHK #9 - PAT SEX MISSING
+10 ;RTNS T IF MISSING
PSEXMISS(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 QUIT $PIECE($GET(^DPT(DFN,0)),U,2)=""
+9 ;EDIT CHK #10 - PH ADDR MISSING
PHADDMIS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS,PHPTR,PH,INS
+2 IF DFN=""
QUIT 1
+3 ;1/20/05
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+7 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+8 ;END
+9 ;ONLY CHK PRVT INS. AT THIS TIME.
SET FINDCALL="FINDPVT"
+10 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+11 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+12 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+13 IF '$TEST
Begin DoDot:1
+14 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+15 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+16 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+17 SET SEL=0
+18 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+19 IF '$TEST
DO @FINDCALL
End DoDot:1
+20 SET SEQ=0
SET MISSING=0
+21 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+22 ;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
+23 IF '$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
QUIT
+24 ;END 1/20/05
+25 SET INS=$PIECE(AGINS(SEQ),U)
+26 SET PHPTR=$EXTRACT($PIECE(AGINS(SEQ),U,7),2,10)
+27 SET PH=$PIECE(AGINS(SEQ),U,8)
+28 SET POLNUM=$PIECE(AGINS(SEQ),U,9)
+29 SET MISSING=PHPTR=""
+30 IF MISSING
SET MISSING=MISSING_U_$$ERRDATA^AGEDERR(10)_"|"_$GET(POLNUM)_"|"_$GET(PH)_"|"_$GET(INS)
IF MISSING
QUIT
+31 SET X=$GET(^AUPN3PPH(PHPTR,0))
+32 IF $PIECE(X,U,9)=""
SET MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$GET(POLNUM)_"|"_$GET(PH)_"|"_$GET(INS)
+33 IF $PIECE(X,U,11)=""
SET MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$GET(POLNUM)_"|"_$GET(PH)_"|"_$GET(INS)
+34 IF $PIECE(X,U,12)=""
SET MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$GET(POLNUM)_"|"_$GET(PH)_"|"_$GET(INS)
+35 IF $PIECE(X,U,13)=""
SET MISSING=1_U_$$ERRDATA^AGEDERR(10)_"|"_$GET(POLNUM)_"|"_$GET(PH)_"|"_$GET(INS)
End DoDot:1
IF MISSING
QUIT
+36 KILL AGINS
+37 QUIT MISSING
+38 ;EDIT CHK #11 - POL IS SUPPLEMENTAL TO MEDICARE
MEDSUP(DFN,FINDCALL) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 ;ONLY CHK PRVT INS. AT THIS TIME
SET FINDCALL="FINDPVT"
+9 NEW X,AGINS,MISSING
+10 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+11 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+12 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+13 IF '$TEST
Begin DoDot:1
+14 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+15 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+16 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+17 SET SEL=0
+18 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+19 IF '$TEST
DO @FINDCALL
End DoDot:1
+20 ;NO AGINS ENTRY SO ALL WERE DELETED
IF '$DATA(AGINS)
QUIT 0
+21 SET SEQ=0
+22 SET MISSING=0
+23 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+24 ;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
+25 IF '$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
QUIT
+26 ;END 1/20/05
+27 SET INSPTR=$PIECE(AGINS(SEQ),U,2)
+28 SET MISSING=INSPTR=""
IF MISSING
QUIT
+29 SET X=$GET(^AUTNINS(INSPTR,0))
+30 SET MISSING=X=""
IF MISSING
QUIT
+31 SET INS=$PIECE(X,U)
+32 ;S MISSING=$P($G(^AUTNINS(INSPTR,2)),U)="M" Q:MISSING
+33 ;IHS/OIT/NKD AG*7.1*12
SET MISSING=$$INSTYP^AGUTL(INSPTR)="M"
IF MISSING
QUIT
End DoDot:1
IF MISSING
QUIT
+34 KILL AGINS
+35 QUIT MISSING_U_$$ERRDATA(11)_"|"_$GET(INS)
+36 ;EDIT CHK #12 - GUARAN NAME AND ADDR MISSING
GURANMIS(DFN,FINDCALL) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 NEW X,SEQ,MISSING,AGINS
+9 ;ONLY APPROPRIATE FOR GUARAN
SET FINDCALL="FINDGUAR"
+10 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+11 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+12 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+13 IF '$TEST
Begin DoDot:1
+14 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+15 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+16 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+17 SET SEL=0
+18 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+19 IF '$TEST
DO @FINDCALL
End DoDot:1
+20 SET MISSING=$$CHKAGINS^AGEDERR(21,12,"",9)
IF MISSING
QUIT MISSING
+21 SET MISSING=$$CHKAGINS^AGEDERR(22,12,"",9)
IF MISSING
QUIT MISSING
+22 SET MISSING=$$CHKAGINS^AGEDERR(23,12,"",9)
IF MISSING
QUIT MISSING
+23 SET MISSING=$$CHKAGINS^AGEDERR(24,12,"",9)
IF MISSING
QUIT MISSING
+24 KILL AGINS
+25 QUIT MISSING
+26 ;EDIT CHK #13 - ROI MISSING
+27 ;WARNING VERSION (SEE EDIT CHK #46 FOR ERROR VERSION)
ROIMISS(DFN) ;EP
+1 ;Quit if ROI required
+2 ;AG*7.1*8
IF $$RQROI^AGEDERR4(DUZ(2))
QUIT 0
+3 ;
+4 IF DFN=""
QUIT 1
+5 ;1/20/05
+6 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+7 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+8 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+9 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+10 ;END
+11 ;1/20/05
+12 IF '$$ISDEPEND^AGEDERR2(DFN)
QUIT 0
+13 IF '$$CURRUPD^AGEDERR2(DFN,365)
QUIT 0
+14 ;END 1/20/05
+15 IF $GET(AGOPT("VERSION"))<7.1
QUIT $PIECE($GET(^AUPNPAT(DFN,0)),U,4)=""
+16 QUIT $ORDER(^AUPNPAT(DFN,36,"B",""),-1)=""
+17 ;EDIT CHK #14 - ROI EXPIRED
+18 ;WARNING VERSION (SEE EDIT CHK #47 FOR ERROR VERSION)
ROIEXP(DFN) ;EP
+1 ;Quit if ROI required
+2 ;AG*7.1*8
IF $$RQROI^AGEDERR4(DUZ(2))
QUIT 0
+3 ;
+4 IF DFN=""
QUIT 1
+5 ;1/20/05
+6 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+7 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+8 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+9 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+10 ;END
+11 ;DO PRE 7.1 CHK
IF $GET(AGOPT("VERSION"))<7.1
QUIT $$ROIEXP7(DFN)
+12 ;DON'T CHK IF NO ROI ENTRY
+13 NEW X3
+14 SET X3=$ORDER(^AUPNPAT(DFN,36,"B",""),-1)
+15 IF X3=""
QUIT 0
+16 NEW X,X1,X2
+17 SET X2=$ORDER(^AUPNPAT(DFN,36,"B",""),-1)
+18 IF X2=""
QUIT 1
+19 SET X1=DT
+20 DO ^%DTC
+21 QUIT X>365
+22 ;PRE 7.1 CHK FOR EXPIRED ROI
ROIEXP7(DFN) ;EP
+1 NEW X1,X2
+2 SET X2=$PIECE($GET(^AUPNPAT(DFN,0)),U,4)
+3 SET X1=DT
+4 DO ^%DTC
+5 QUIT X>365
+6 ;EDIT CHK #15 - EC INFO INCOMPLETE
+7 ;RTNS T IF INCOMPLETE
EMERCONT(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 NEW X
+9 ;EC RELATIONSHIP
SET X=$GET(^AUPNPAT(DFN,31))
+10 IF $PIECE(X,U,2)=""
QUIT 1
+11 ;EC CONTACT INFO
SET X=$GET(^DPT(DFN,.33))
+12 IF X=""
QUIT 1
+13 IF $PIECE(X,U,3)=""
QUIT 1
+14 IF $PIECE(X,U,6)=""
QUIT 1
+15 IF $PIECE(X,U,7)=""
QUIT 1
+16 IF $PIECE(X,U,8)=""
QUIT 1
+17 IF $PIECE(X,U,9)=""
QUIT 1
+18 QUIT 0
+19 ;EDIT CHK #16 - RELATIONSHIP TO PH MISSING
+20 ;RTNS T IF MISSING
RELPHMIS(DFN,FINDCALL) ;EP
+1 IF DFN=""
QUIT 1
+2 ;1/20/05
+3 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+7 ;END
+8 ;ONLY CHK PRVT INS. AT THIS TIME.
SET FINDCALL="FINDPVT"
+9 NEW X,AGINS,MISSING
+10 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+11 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+12 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+13 IF '$TEST
Begin DoDot:1
+14 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+15 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+16 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+17 SET SEL=0
+18 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+19 IF '$TEST
DO @FINDCALL
End DoDot:1
+20 SET MISSING=$$CHKAGINS^AGEDERR(16,16,"",9)
+21 KILL AGINS
+22 QUIT MISSING
+23 ;EDIT CHK #17 - COV TYPE NOT DEFINED(MISSING) FOR POL
+24 ;RTNS T IF MISSING
CVTYPMIS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF 'DFN
QUIT 1
+3 ;1/20/05
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+7 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+8 ;END
+9 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+10 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+11 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+12 IF '$TEST
Begin DoDot:1
+13 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+14 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+15 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+16 SET SEL=0
+17 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+18 IF '$TEST
DO @FINDCALL
End DoDot:1
+19 SET MISSING=$$CHKAGINS^AGEDERR(4,17,"","9,1")
+20 KILL AGINS
+21 QUIT MISSING
+22 ;EDIT CHK #18 - MISSING EFF DT OF ELIG
+23 ;THIS LOOKS AT ALL INSURANCES
+24 ;RTNS T IF MISSING IN ANY OF THEM
ELGDTMIS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF DFN=""
QUIT 1
+3 ;1/20/05
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+7 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+8 ;END
+9 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+10 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+11 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+12 IF '$TEST
Begin DoDot:1
+13 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+14 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+15 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+16 SET SEL=0
+17 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+18 IF '$TEST
DO @FINDCALL
End DoDot:1
+19 SET MISSING=$$CHKAGINS^AGEDERR(5,18,"","9,1")
+20 KILL AGINS
+21 QUIT MISSING
+22 ;EDIT CHK #19 - MISSING PH'S EMPLOYMENT STATUS
+23 ;RTNS T IF MISSING
EMPSTAMS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS,PHPTR
+2 IF DFN=""
QUIT 1
+3 ;1/20/05
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+7 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+8 ;END
+9 ;ONLY DO PRIVATE INSURANCE
SET FINDCALL="FINDPVT"
+10 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+11 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+12 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+13 IF '$TEST
Begin DoDot:1
+14 ;USER HAS NOT SELECTED FROM AGED4A SO CREATE OUR OWN AGINS
+15 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+16 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+17 SET SEL=0
+18 IF FINDCALL=""
DO FINDALL^AGEDERR(DFN,.AGINS)
+19 IF '$TEST
DO @FINDCALL
End DoDot:1
+20 SET MISSING=$$CHKAGINS^AGEDERR(7,19,"",9)
+21 IF MISSING
KILL AGINS
QUIT MISSING
+22 SET SEQ=0
+23 SET MISSING=0
+24 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+25 ;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE 1/20/05
+26 IF '$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
QUIT
+27 ;END 1/20/05
+28 SET PHPTR=$EXTRACT($PIECE(AGINS(SEQ),U,7),2,20)
+29 IF PHPTR=""
SET MISSING=1
IF MISSING
QUIT
+30 IF $EXTRACT(PHPTR)?1A
SET PHPTR=$EXTRACT($PIECE(AGINS(SEQ),U,7),2,20)
+31 SET MISSING=$PIECE($GET(^AUPN3PPH(PHPTR,0)),U,15)=""
IF MISSING
QUIT
End DoDot:1
IF MISSING
QUIT
+32 KILL AGINS
+33 QUIT MISSING
+34 ;RETURN ERROR DATA
ERRDATA(ERR) ;EP
+1 QUIT $PIECE($GET(^AGEDERRS(ERR,0)),U,1,3)
