AGEDERR4 ; VNGT/HS/BEE - EDIT CHECK CALLS ; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**8,9,11**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
Q
;EDIT CHK #44 - AOB MISSING
;ERROR VERSION (SEE EDIT CHK #1 FOR WARNING VERSION)
AOBMISS(DFN) ;EP
;
;Quit if AOB not required
I '$$RQAOB(DUZ(2)) Q 0
;
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 #45 - AOB COMP
;ERROR VERSION (SEE EDIT CHK #3 FOR WARNING VERSION)
;LAST DATE IS OLDER THAN ONE YEAR OR BEFORE AN ACTIVE BEGIN DATE
AOBDUE(DFN) ;EP
;
;Quit if AOB not required
I '$$RQAOB(DUZ(2)) Q 0
;
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 #46 - ROI MISSING
;ERROR VERSION (SEE EDIT CHK #13 FOR WARNING VERSION)
;
ROIMISS(DFN) ;EP
;
;Quit if ROI not required
I '$$RQROI(DUZ(2)) Q 0
;
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
;
I '$$ISDEPEND^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,365) Q 0
;
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
;RTNS T IF EXPIRED
ROIEXP(DFN) ;EP
;
;Quit if ROI not required
I '$$RQROI(DUZ(2)) Q 0
;
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 #48 - COMMUNITY MISSING
;ERROR CHECK
COMM(DFN) ;EP
;
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 $$GET1^DIQ(9000001,DFN_",",1118,"E")="" Q 1
Q 0
;
;IHS/OIT/NKD AG*7.1*11 MU2 - ADD PATIENT SEX UNKNOWN WARNING
;EDIT CHK #54 - PAT SEX UNKNOWN
;RTNS T IF UNKNOWN
PSEXUNK(DFN) ;EP
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 $$GET1^DIQ(2,DFN,.02,"I")="U"
;
RQROI(FAC) ;Determine whether ROI is required
N FLIEN,ROIEN,RQROI
S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
S ROIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","RELEASE OF INFORMATION",""))
S RQROI=$$GET1^DIQ(9009061.1101,ROIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQROI
;
RQAOB(FAC) ;Determine whether AOB is required
N FLIEN,AOBIEN,RQAOB
S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
S AOBIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","ASSIGN BENEFITS OBTAINED DATE",""))
S RQAOB=$$GET1^DIQ(9009061.1101,AOBIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQAOB
;
RQPRM(FAC) ;Determine whether Primary Language is required - AG*7.1*9
N FLIEN,PRMIEN,RQPRM
S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
S PRMIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))
S RQPRM=$$GET1^DIQ(9009061.1101,PRMIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQPRM
;
RQPRF(FAC) ;Determine whether Preferred Language is required - AG*7.1*9
N FLIEN,PRFIEN,RQPRF
S FLIEN=$O(^AGFAC(FAC,11,"B",9000001,"")) I FLIEN="" Q 0
S PRFIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))
S RQPRF=$$GET1^DIQ(9009061.1101,PRFIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQPRF
;
RQETH(FAC) ;Determine whether Ethnicity is required - AG*7.1*9
N FLIEN,ETHIEN,RQETH
S FLIEN=$O(^AGFAC(FAC,11,"B",2,"")) I FLIEN="" Q 0
S ETHIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))
S RQETH=$$GET1^DIQ(9009061.1101,ETHIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQETH
;
RQRACE(FAC) ;Determine whether Race is required - AG*7.1*9
N FLIEN,RACEIEN,RQRACE
S FLIEN=$O(^AGFAC(FAC,11,"B",2,"")) I FLIEN="" Q 0
S RACEIEN=$O(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))
S RQRACE=$$GET1^DIQ(9009061.1101,RACEIEN_","_FLIEN_","_FAC_",",.02,"I")
Q RQRACE
AGEDERR4 ; VNGT/HS/BEE - EDIT CHECK CALLS ; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**8,9,11**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
+3 QUIT
+4 ;EDIT CHK #44 - AOB MISSING
+5 ;ERROR VERSION (SEE EDIT CHK #1 FOR WARNING VERSION)
AOBMISS(DFN) ;EP
+1 ;
+2 ;Quit if AOB not required
+3 IF '$$RQAOB(DUZ(2))
QUIT 0
+4 ;
+5 IF DFN=""
QUIT 1
+6 NEW X
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 IF '$$CURRUPD^AGEDERR2(DFN,365)
QUIT 0
+10 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+11 IF '$$ISDEPEND^AGEDERR2(DFN)
QUIT 0
+12 ;AOB CHECKED FOR PATIENTS W/ PRVT ONLY
+13 IF '$DATA(^AUPNPRVT("B",DFN))
QUIT
+14 SET X=1_U_"PVT"_U
+15 IF '$$ACTELIG^AGEDERR2(DFN,X)_U_X
QUIT 0
+16 ;END NEW
+17 IF $GET(AGOPT("VERSION"))<7.1
QUIT $PIECE($GET(^AUPNPAT(DFN,0)),U,17)=""
+18 QUIT $ORDER(^AUPNPAT(DFN,71,0))=""
+19 ;EDIT CHK #45 - AOB COMP
+20 ;ERROR VERSION (SEE EDIT CHK #3 FOR WARNING VERSION)
+21 ;LAST DATE IS OLDER THAN ONE YEAR OR BEFORE AN ACTIVE BEGIN DATE
AOBDUE(DFN) ;EP
+1 ;
+2 ;Quit if AOB not required
+3 IF '$$RQAOB(DUZ(2))
QUIT 0
+4 ;
+5 IF DFN=""
QUIT 1
+6 NEW TARDT,X,X1,X2,X3
+7 ;1/20/05
+8 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+9 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+10 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+11 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+12 ;END NEW
+13 ;ADRIAN 6/16/2005
+14 ;AOB SHOULD BE CHECKED FOR PRVT INS. ONLY
+15 IF '$DATA(^AUPNPRVT("B",DFN))
QUIT 0
+16 SET X=1_U_"PVT"_U
+17 IF '$$ACTELIG^AGEDERR2(DFN,X)_U_X
QUIT 0
+18 SET TARDT=$$AOBCHEK^AGEDERR2(DFN)
+19 ;END
+20 IF $GET(AGOPT("VERSION"))<7.1
QUIT $$AOBDUE7(DFN)
+21 ;DON'T CHK IF NO AOB ENTRIES
+22 ;S X3=$O(^AUPNPAT(DFN,71,"B",""),-1)
+23 ;Q:X3="" 0
+24 SET X2=$ORDER(^AUPNPAT(DFN,71,"B",""),-1)
+25 ;DO NOT REPORT ON MISSING THATS FOR ERROR #1
IF X2=""
QUIT 0
+26 ;AOB
IF X2<TARDT
QUIT 1
+27 SET X1=DT
+28 DO ^%DTC
+29 QUIT X>365
+30 ;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 ;
+7 ;EDIT CHK #46 - ROI MISSING
+8 ;ERROR VERSION (SEE EDIT CHK #13 FOR WARNING VERSION)
+9 ;
ROIMISS(DFN) ;EP
+1 ;
+2 ;Quit if ROI not required
+3 IF '$$RQROI(DUZ(2))
QUIT 0
+4 ;
+5 IF DFN=""
QUIT 1
+6 ;
+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 ;
+12 IF '$$ISDEPEND^AGEDERR2(DFN)
QUIT 0
+13 IF '$$CURRUPD^AGEDERR2(DFN,365)
QUIT 0
+14 ;
+15 IF $GET(AGOPT("VERSION"))<7.1
QUIT $PIECE($GET(^AUPNPAT(DFN,0)),U,4)=""
+16 QUIT $ORDER(^AUPNPAT(DFN,36,"B",""),-1)=""
+17 ;
+18 ;EDIT CHK #14 - ROI EXPIRED
+19 ;RTNS T IF EXPIRED
ROIEXP(DFN) ;EP
+1 ;
+2 ;Quit if ROI not required
+3 IF '$$RQROI(DUZ(2))
QUIT 0
+4 ;
+5 IF DFN=""
QUIT 1
+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
+12 ;DO PRE 7.1 CHK
IF $GET(AGOPT("VERSION"))<7.1
QUIT $$ROIEXP7(DFN)
+13 ;DON'T CHK IF NO ROI ENTRY
+14 NEW X3
+15 SET X3=$ORDER(^AUPNPAT(DFN,36,"B",""),-1)
+16 IF X3=""
QUIT 0
+17 NEW X,X1,X2
+18 SET X2=$ORDER(^AUPNPAT(DFN,36,"B",""),-1)
+19 IF X2=""
QUIT 1
+20 SET X1=DT
+21 DO ^%DTC
+22 QUIT X>365
+23 ;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 ;
+7 ;EDIT CHK #48 - COMMUNITY MISSING
+8 ;ERROR CHECK
COMM(DFN) ;EP
+1 ;
+2 IF DFN=""
QUIT 1
+3 NEW X
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 IF '$$CURRUPD^AGEDERR2(DFN,365)
QUIT 0
+7 ;
+8 IF $$GET1^DIQ(9000001,DFN_",",1118,"E")=""
QUIT 1
+9 QUIT 0
+10 ;
+11 ;IHS/OIT/NKD AG*7.1*11 MU2 - ADD PATIENT SEX UNKNOWN WARNING
+12 ;EDIT CHK #54 - PAT SEX UNKNOWN
+13 ;RTNS T IF UNKNOWN
PSEXUNK(DFN) ;EP
+1 IF DFN=""
QUIT 1
+2 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+3 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+4 ;I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
+5 ;I '$$HASELIG^AGEDERR2(DFN) Q 0
+6 QUIT $$GET1^DIQ(2,DFN,.02,"I")="U"
+7 ;
RQROI(FAC) ;Determine whether ROI is required
+1 NEW FLIEN,ROIEN,RQROI
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",9000001,""))
IF FLIEN=""
QUIT 0
+3 SET ROIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","RELEASE OF INFORMATION",""))
+4 SET RQROI=$$GET1^DIQ(9009061.1101,ROIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQROI
+6 ;
RQAOB(FAC) ;Determine whether AOB is required
+1 NEW FLIEN,AOBIEN,RQAOB
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",9000001,""))
IF FLIEN=""
QUIT 0
+3 SET AOBIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","ASSIGN BENEFITS OBTAINED DATE",""))
+4 SET RQAOB=$$GET1^DIQ(9009061.1101,AOBIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQAOB
+6 ;
RQPRM(FAC) ;Determine whether Primary Language is required - AG*7.1*9
+1 NEW FLIEN,PRMIEN,RQPRM
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",9000001,""))
IF FLIEN=""
QUIT 0
+3 SET PRMIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","PRIMARY LANGUAGE",""))
+4 SET RQPRM=$$GET1^DIQ(9009061.1101,PRMIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQPRM
+6 ;
RQPRF(FAC) ;Determine whether Preferred Language is required - AG*7.1*9
+1 NEW FLIEN,PRFIEN,RQPRF
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",9000001,""))
IF FLIEN=""
QUIT 0
+3 SET PRFIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","PREFERRED LANGUAGE",""))
+4 SET RQPRF=$$GET1^DIQ(9009061.1101,PRFIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQPRF
+6 ;
RQETH(FAC) ;Determine whether Ethnicity is required - AG*7.1*9
+1 NEW FLIEN,ETHIEN,RQETH
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",2,""))
IF FLIEN=""
QUIT 0
+3 SET ETHIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","ETHNICITY INFORMATION",""))
+4 SET RQETH=$$GET1^DIQ(9009061.1101,ETHIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQETH
+6 ;
RQRACE(FAC) ;Determine whether Race is required - AG*7.1*9
+1 NEW FLIEN,RACEIEN,RQRACE
+2 SET FLIEN=$ORDER(^AGFAC(FAC,11,"B",2,""))
IF FLIEN=""
QUIT 0
+3 SET RACEIEN=$ORDER(^AGFAC(FAC,11,FLIEN,1,"B","RACE",""))
+4 SET RQRACE=$$GET1^DIQ(9009061.1101,RACEIEN_","_FLIEN_","_FAC_",",.02,"I")
+5 QUIT RQRACE
