AGEDERR2 ; IHS/SD/EFG - EDIT CHECK CALLS ; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**2,7,9,11,12**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*11 MU2 MULTIPLE RACES
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;THIS RTN CONTAINS EDIT CHK SUBRTNS FOR USE IN THE EDIT
;CHK SYSTEM
;
Q
HASELIG(DFN) ;EP - DOES THE PATIENT HAVE ELIGIBILITY AT ALL
N X
S X=1_U
I '$D(^AUPNMCR("B",DFN))&'$D(^AUPNMCD("B",DFN))&'$D(^AUPNRRE("B",DFN))&'$D(^AUPNPRVT("B",DFN)) Q 0
I $D(^AUPNMCR("B",DFN)) S X=X_"MCR"_U
I $D(^AUPNMCD("B",DFN)) S X=X_"MCD"_U
I $D(^AUPNRRE("B",DFN)) S X=X_"RRE"_U
I $D(^AUPNPRVT("B",DFN)) S X=X_"PVT"_U
Q $$ACTELIG(DFN,X)_U_X
;DOES THE PATIENT HAVE ACTIVE ELIGIBILITY?
;ELIGSTR = STRING FROM ABOVE
ACTELIG(DFN,ELIGSTR) ;EP - DOES THE PATIENT HAVE ACTIVE ELIGIBILITY?
N AGINS,PIECE,SEL,ACTIVE,SEQ,CALL
S SEL=0,ACTIVE=0
F PIECE=2:1:$L(ELIGSTR) S TYPE=$P(ELIGSTR,U,PIECE) Q:TYPE=""!(ACTIVE) D
.S CALL="FIND"_TYPE_U_"AGINS("_DFN_")"
.D @CALL
.S ACTIVE=0
.S SEQ=0
.F S SEQ=$O(AGINS(SEQ)) Q:SEQ=""!ACTIVE D
..S ACTIVE=$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
Q ACTIVE
;THIS TAG IS USED TO DETERMINE WHAT DATE TO USE AS THE AOB DATE
AOBCHEK(DFN) ;EP - DETERMINE AOB DATE TO CHECK FOR OVERDUE
N AGINS,SEL,ACTIVE,SEQ,CALL,BEGDT,ENDDT,MSTRESDT,MSTREEDT,TARDT
S SEL=0,ACTIVE=0
S CALL="FINDPVT^AGINS("_DFN_")"
D @CALL
S ACTIVE=0
S MSTRESDT=0,MSTREEDT=0
S SEQ=0
F S SEQ=$O(AGINS(SEQ)) Q:SEQ="" D
.S BEGDT=$P(AGINS(SEQ),U,5)
.S ENDDT=$P(AGINS(SEQ),U,6)
.Q:'$$ISACTIVE^AGINS(BEGDT,ENDDT)
.I BEGDT>MSTRESDT S MSTRESDT=BEGDT
.I ENDDT>MSTREEDT S MSTREEDT=ENDDT
S TARDT=MSTRESDT
Q TARDT
ISDEPEND(DFN) ;EP - IF PATIENT IS LISTED AS A DEPENDENT IN THE POLICY HOLDER
;FILE, DISPLAY THE ERROR
N ISDEPEND
S ISDEPEND=0
I '$D(^AUPNPRVT("B",DFN)) Q 0
S REC=0
F S REC=$O(^AUPNPRVT(DFN,11,REC)) Q:'REC!ISDEPEND D
.I $P($G(^AUPNPRVT(DFN,11,REC,0)),U,5)'=25&($D(^AUPN3PPH("C",DFN))) S ISDEPEND=1 Q
Q ISDEPEND
CURRUPD(DFN,DAYS) ;EP - HAS THE PATIENT BEEN UPDATED IN THE PAST YEAR
N X2,X1,X
S X2=$P($G(^AUPNPAT(DFN,0)),U,3) ;DATE OF LAST REG. UPDATE
I X2="" S X2=$P($G(^AUPNPAT(DFN,0)),U,2) ;DATE ESTABLISHED
I X2="" S X2=DT-40000
S X1=DT
D ^%DTC
I X>DAYS Q 0
Q 1
OVER65(DFN) ;EP - CHECK TO SEE IF PATIENT IS OVER 65 YEARS OLD
Q $$AGE^AUPNPAT(DFN)>65
DECEASED(DFN) ;EP - IS THE PATIENT DECEASED?
Q $P($G(^DPT(DFN,.35)),U)'=""
PTACTIVE(DFN) ;EP - SEE IF PATIENT IS ACTIVE IN AT LEAST ONE FACILTY
S ACTIVE=0
S FAC=0
F S FAC=$O(^AUPNPAT(DFN,41,FAC)) Q:'FAC!ACTIVE D
.I $P($G(^AUPNPAT(DFN,41,FAC,0)),U,5)="" S ACTIVE=1 Q
Q ACTIVE
;CALLED BY SEQMAN^AGEDERR TO FIND FAC FOR EDIT CHECK # 33
FACCHK(DFN) ;EP - CALLED BY SEQMAN^AGEDERR TO FIND FAC FOR EDIT CHECK # 33
N FAC
S SEQREQ=0
S FAC=0
F S FAC=$O(^AUPNPAT(DFN,41,FAC)) Q:'FAC!SEQREQ D
.I $$NEEDTOSQ^AGUTILS(DFN,FAC) S SEQREQ=1 Q
Q SEQREQ
;RETURN TRUE IF ALL ADDRESS FIELDS ARE EMPTY
;ONLY CHECKED FOR INSURER AND EMPLOYER FILES
;CALLED FROM AGEDGUAR.
GUARADD(GUARINFO) ;EP
N ALLMISS
S ALLMISS=0
Q:GUARINFO="" 0
S GUARPTR=U_$P(GUARINFO,U,14)
Q:GUARPTR[("AUPNPAT") 1 ;ALWAYS ALLOWED TO EDIT PATIENT ADDRESS
Q:GUARPTR'[("AUTNINS")&(GUARPTR'[("AUTNEMPL")) 0
S X=$G(@GUARPTR)
S ALLMISS=X="" Q:ALLMISS
S ALLMISS=($P(X,U,2)="")&($P(X,U,3)="")&($P(X,U,4)="")&($P(X,U,5)="")
Q ALLMISS
ISMCD(INSPTR) ;EP - RETURN TRUE IF MEDICAID INSURER
Q:INSPTR="" 0
;Q $P($G(^AUTNINS(INSPTR,2)),U)="D"
Q $$INSTYP^AGUTL(INSPTR)="D" ;IHS/OIT/NKD AG*7.1*12
;ERROR CHECK # 37 DOES PATIENT HAVE INTERNET ACCESS?
WEB(DFN) ;
Q:DFN="" 1
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
S LSTUPD=$O(^AUPNPAT(DFN,81,"B",""),-1)
Q:LSTUPD="" 1
S X2=LSTUPD
S X1=DT
D ^%DTC
Q X>365
;EDIT CHK #53 - PATIENT RACE MISSING - AG*7.1*9
;WARNING VERSION (SEE EDIT CHECK #52 FOR ERROR VERSION)
;RETURNS TRUE IF MISSING
PRACE(DFN) ;EP
;N RACE
Q:DFN="" 1
;
;Quit if Race required
I $$RQRACE^AGEDERR4(DUZ(2)) Q 0
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;IHS/OIT/NKD AG*7.1*11 MU2 - CHANGED WARNING TO USE RACE MULTIPLE
;S RACE=$$GET1^DIQ(2,DFN_",",".06","I")
;I RACE]"" Q 0
I +$$RACE^AGUTL(DFN)>0 Q 0
Q 1
;EDIT CHK #52 - PATIENT RACE MISSING - AG*7.1*9
;ERROR VERSION (SEE EDIT CHECK #53 FOR WARNING VERSION)
;RETURNS TRUE IF MISSING
PRACEE(DFN) ;EP
;N RACE
Q:DFN="" 1
;
;Quit if Race optional
I '$$RQRACE^AGEDERR4(DUZ(2)) Q 0
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;IHS/OIT/NKD AG*7.1*11 MU2 - CHANGED ERROR TO USE RACE MULTIPLE
;S RACE=$$GET1^DIQ(2,DFN_",",".06","I")
;I RACE]"" Q 0
I +$$RACE^AGUTL(DFN)>0 Q 0
Q 1
;EDIT CHK #38 - PATIENT ETHNICITY OR METHOD OF COLLECTION MISSING - AG*7.1*7
;WARNING VERSION (SEE EDIT CHECK #51 FOR ERROR VERSION)
;RETURNS TRUE IF MISSING
PETHNIC(DFN) ;EP
N ETHNIC,MOC
Q:DFN="" 1
;
;Quit if Ethnicity required
I $$RQETH^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
S ETHNIC=$O(^DPT(DFN,.06,0))
I ETHNIC S MOC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".02","I") I MOC="" Q 1 ;Method of Collection
I ETHNIC S ETHNIC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".01","I")
I ETHNIC]"" Q 0 ;Ethnicity
Q 1
;EDIT CHK #51 - PATIENT ETHNICITY OR METHOD OF COLLECTION MISSING - AG*7.1*9
;ERROR VERSION (SEE EDIT CHECK #38 FOR WARNING VERSION)
;RETURNS TRUE IF MISSING
PETHNICE(DFN) ;EP
N ETHNIC,MOC
Q:DFN="" 1
;
;Quit if Ethnicity optional
I '$$RQETH^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
S ETHNIC=$O(^DPT(DFN,.06,0))
I ETHNIC S MOC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".02","I") I MOC="" Q 1 ;Method of Collection
I ETHNIC S ETHNIC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".01","I")
I ETHNIC]"" Q 0 ;Ethnicity
Q 1
;EDIT CHK #39 - PATIENT MIGRANT STATUS OR TYPE MISSING - AG*7.1*7
;RETURNS TRUE IF MISSING
PMIG(DFN) ;EP
N MIG,MSTS,MTYP
Q:DFN="" 1
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;Quit if not getting displayed
I $G(AGOPT(26))'="Y" Q 0 ;AG*7.1*9
;
S MIG=$$CMIG^AGED10A(DFN)
S MSTS=$P($P(MIG,U,3),":")
I MSTS="" Q 1 ;Error if no status
I MSTS="N" Q 0 ;Quit if status in "NO"
;
S MTYP=$P($P(MIG,U,4),":")
I MSTS="Y",MTYP="" Q 1 ;Error if status is yes and no type
Q 0
;EDIT CHK #40 - PATIENT HOMELESS STATUS OR TYPE MISSING - AG*7.1*7
;RETURNS TRUE IF MISSING
PHOM(DFN) ;EP
N HOM,HSTS,HTYP
Q:DFN="" 1
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;Quit if not getting displayed
I $G(AGOPT(27))'="Y" Q 0 ;AG*7.1*9
;
S HOM=$$CHOM^AGED10A(DFN)
S HSTS=$P($P(HOM,U,3),":")
I HSTS="" Q 1 ;Error if no status
I HSTS="N" Q 0 ;Quit if status in "NO"
;
S HTYP=$P($P(HOM,U,4),":")
I HSTS="Y",HTYP="" Q 1 ;Error if status is yes and no type
Q 0
;EDIT CHK #41 - PATIENT PRIMARY LANGUAGE MISSING - AG*7.1*7
;WARNING VERSION (SEE EDIT CHK #50 FOR ERROR VERSION)
;RETURNS TRUE IF MISSING
LPRM(DFN) ;EP
N LNG,VAL
Q:DFN="" 1
;
;Quit if Primary Language required
I $$RQPRM^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
S VAL=$$CLANG^AGED10B(DFN)
S LNG=$P($P(VAL,U,2),":",2)
I LNG="" Q 1
I LNG'="ENGLISH",$P($P(VAL,U,3),":")="" Q 1 ;Check Interpreter Required
I LNG="ENGLISH"!($P(VAL,U,5)["ENGLISH"),$P($P(VAL,U,6),":")="" Q 1 ;Check English Proficiency
Q 0
;EDIT CHK #50 - PATIENT PRIMARY LANGUAGE MISSING - AG*7.1*9
;ERROR VERSION (SEE EDIT CHK #41 FOR WARNING VERSION)
;RETURNS TRUE IF MISSING
LPRME(DFN) ;EP
N LNG,VAL
Q:DFN="" 1
;
;Quit if Primary Language optional
I '$$RQPRM^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
S VAL=$$CLANG^AGED10B(DFN)
S LNG=$P($P(VAL,U,2),":",2)
I LNG="" Q 1
I LNG'="ENGLISH",$P($P(VAL,U,3),":")="" Q 1 ;Check Interpreter Required
I LNG="ENGLISH"!($P(VAL,U,5)["ENGLISH"),$P($P(VAL,U,6),":")="" Q 1 ;Check English Proficiency
Q 0
;EDIT CHK #42 - PATIENT PREFERRED LANGUAGE MISSING - AG*7.1*7
;WARNING VERSION (SEE EDIT CHK #49 FOR ERROR VERSION)
;RETURNS TRUE IF MISSING
LPRE(DFN) ;EP
N DEF,IEN,PRE,PRMX,FND,LNG,OLNG,ERROR
Q:DFN="" 1
;
;Quit if Preferred Language required
I $$RQPRF^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;Error if blank
S DEF=$$CLANG^AGED10B(DFN) ;AG*7.1*9 - Changed from AGPATDFN to DFN
S PRE=$P($P(DEF,U,4),":",2)
I PRE="" Q 1
;
;Error if Preferred Language not in the Primary or Other Spoken Language fields
S IEN=$P(DEF,U) ;IEN
S PRMX=$P($P(DEF,U,2),":",2) ;External Primary Language
I PRMX=PRE Q 0 ;No Error if Primary equals Preferred
;
D GETS^DIQ(9000001.86,IEN_","_DFN_",",".05*","E","OLNG","ERROR")
S (FND,IEN)="" F S IEN=$O(OLNG("9000001.8605",IEN)) Q:IEN="" D Q:FND=1
. S LNG=$G(OLNG("9000001.8605",IEN,".01","E")) Q:LNG=""
. I PRE=LNG S FND=1
I FND="" Q 1 ;Error if Preferred not in Other Spoken Language list either
Q 0
;EDIT CHK #49 - PATIENT PREFERRED LANGUAGE MISSING - AG*7.1*9
;ERROR VERSION (SEE EDIT CHK #42 FOR WARNING VERSION)
;RETURNS TRUE IF MISSING
LPREE(DFN) ;EP
N DEF,IEN,PRE,PRMX,FND,LNG,OLNG,ERROR
Q:DFN="" 1
;
;Quit if Preferred Language optional
I '$$RQPRF^AGEDERR4(DUZ(2)) Q 0 ;AG*7.1*9
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
;Error if blank
S DEF=$$CLANG^AGED10B(DFN) ;AG*7.1*9 - Changed from AGPATDFN to DFN
S PRE=$P($P(DEF,U,4),":",2)
I PRE="" Q 1
;
;Error if Preferred Language not in the Primary or Other Spoken Language fields
S IEN=$P(DEF,U) ;IEN
S PRMX=$P($P(DEF,U,2),":",2) ;External Primary Language
I PRMX=PRE Q 0 ;No Error if Primary equals Preferred
;
D GETS^DIQ(9000001.86,IEN_","_DFN_",",".05*","E","OLNG","ERROR")
S (FND,IEN)="" F S IEN=$O(OLNG("9000001.8605",IEN)) Q:IEN="" D Q:FND=1
. S LNG=$G(OLNG("9000001.8605",IEN,".01","E")) Q:LNG=""
. I PRE=LNG S FND=1
I FND="" Q 1 ;Error if Preferred not in Other Spoken Language list either
Q 0
;EDIT CHK #43 - PATIENT HOUSEHOLD INCOME PERIOD MISSING - AG*7.1*7
;RETURNS TRUE IF MISSING
HIP(DFN) ;EP
N HIC,HIP
Q:DFN="" 1
;
I $$DECEASED^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
;
I AGOPT(22)="N" Q 0
S HIC=$$GET1^DIQ(9000001,DFN_",",".36","E")
I HIC'>0 Q 0
S HIP=$$GET1^DIQ(9000001,DFN_",","8701","E")
I HIP="" Q 1
Q 0
AGEDERR2 ; IHS/SD/EFG - EDIT CHECK CALLS ; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**2,7,9,11,12**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 MULTIPLE RACES
+3 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+4 ;THIS RTN CONTAINS EDIT CHK SUBRTNS FOR USE IN THE EDIT
+5 ;CHK SYSTEM
+6 ;
+7 QUIT
HASELIG(DFN) ;EP - DOES THE PATIENT HAVE ELIGIBILITY AT ALL
+1 NEW X
+2 SET X=1_U
+3 IF '$DATA(^AUPNMCR("B",DFN))&'$DATA(^AUPNMCD("B",DFN))&'$DATA(^AUPNRRE("B",DFN))&'$DATA(^AUPNPRVT("B",DFN))
QUIT 0
+4 IF $DATA(^AUPNMCR("B",DFN))
SET X=X_"MCR"_U
+5 IF $DATA(^AUPNMCD("B",DFN))
SET X=X_"MCD"_U
+6 IF $DATA(^AUPNRRE("B",DFN))
SET X=X_"RRE"_U
+7 IF $DATA(^AUPNPRVT("B",DFN))
SET X=X_"PVT"_U
+8 QUIT $$ACTELIG(DFN,X)_U_X
+9 ;DOES THE PATIENT HAVE ACTIVE ELIGIBILITY?
+10 ;ELIGSTR = STRING FROM ABOVE
ACTELIG(DFN,ELIGSTR) ;EP - DOES THE PATIENT HAVE ACTIVE ELIGIBILITY?
+1 NEW AGINS,PIECE,SEL,ACTIVE,SEQ,CALL
+2 SET SEL=0
SET ACTIVE=0
+3 FOR PIECE=2:1:$LENGTH(ELIGSTR)
SET TYPE=$PIECE(ELIGSTR,U,PIECE)
IF TYPE=""!(ACTIVE)
QUIT
Begin DoDot:1
+4 SET CALL="FIND"_TYPE_U_"AGINS("_DFN_")"
+5 DO @CALL
+6 SET ACTIVE=0
+7 SET SEQ=0
+8 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""!ACTIVE
QUIT
Begin DoDot:2
+9 SET ACTIVE=$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
End DoDot:2
End DoDot:1
+10 QUIT ACTIVE
+11 ;THIS TAG IS USED TO DETERMINE WHAT DATE TO USE AS THE AOB DATE
AOBCHEK(DFN) ;EP - DETERMINE AOB DATE TO CHECK FOR OVERDUE
+1 NEW AGINS,SEL,ACTIVE,SEQ,CALL,BEGDT,ENDDT,MSTRESDT,MSTREEDT,TARDT
+2 SET SEL=0
SET ACTIVE=0
+3 SET CALL="FINDPVT^AGINS("_DFN_")"
+4 DO @CALL
+5 SET ACTIVE=0
+6 SET MSTRESDT=0
SET MSTREEDT=0
+7 SET SEQ=0
+8 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+9 SET BEGDT=$PIECE(AGINS(SEQ),U,5)
+10 SET ENDDT=$PIECE(AGINS(SEQ),U,6)
+11 IF '$$ISACTIVE^AGINS(BEGDT,ENDDT)
QUIT
+12 IF BEGDT>MSTRESDT
SET MSTRESDT=BEGDT
+13 IF ENDDT>MSTREEDT
SET MSTREEDT=ENDDT
End DoDot:1
+14 SET TARDT=MSTRESDT
+15 QUIT TARDT
ISDEPEND(DFN) ;EP - IF PATIENT IS LISTED AS A DEPENDENT IN THE POLICY HOLDER
+1 ;FILE, DISPLAY THE ERROR
+2 NEW ISDEPEND
+3 SET ISDEPEND=0
+4 IF '$DATA(^AUPNPRVT("B",DFN))
QUIT 0
+5 SET REC=0
+6 FOR
SET REC=$ORDER(^AUPNPRVT(DFN,11,REC))
IF 'REC!ISDEPEND
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^AUPNPRVT(DFN,11,REC,0)),U,5)'=25&($DATA(^AUPN3PPH("C",DFN)))
SET ISDEPEND=1
QUIT
End DoDot:1
+8 QUIT ISDEPEND
CURRUPD(DFN,DAYS) ;EP - HAS THE PATIENT BEEN UPDATED IN THE PAST YEAR
+1 NEW X2,X1,X
+2 ;DATE OF LAST REG. UPDATE
SET X2=$PIECE($GET(^AUPNPAT(DFN,0)),U,3)
+3 ;DATE ESTABLISHED
IF X2=""
SET X2=$PIECE($GET(^AUPNPAT(DFN,0)),U,2)
+4 IF X2=""
SET X2=DT-40000
+5 SET X1=DT
+6 DO ^%DTC
+7 IF X>DAYS
QUIT 0
+8 QUIT 1
OVER65(DFN) ;EP - CHECK TO SEE IF PATIENT IS OVER 65 YEARS OLD
+1 QUIT $$AGE^AUPNPAT(DFN)>65
DECEASED(DFN) ;EP - IS THE PATIENT DECEASED?
+1 QUIT $PIECE($GET(^DPT(DFN,.35)),U)'=""
PTACTIVE(DFN) ;EP - SEE IF PATIENT IS ACTIVE IN AT LEAST ONE FACILTY
+1 SET ACTIVE=0
+2 SET FAC=0
+3 FOR
SET FAC=$ORDER(^AUPNPAT(DFN,41,FAC))
IF 'FAC!ACTIVE
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNPAT(DFN,41,FAC,0)),U,5)=""
SET ACTIVE=1
QUIT
End DoDot:1
+5 QUIT ACTIVE
+6 ;CALLED BY SEQMAN^AGEDERR TO FIND FAC FOR EDIT CHECK # 33
FACCHK(DFN) ;EP - CALLED BY SEQMAN^AGEDERR TO FIND FAC FOR EDIT CHECK # 33
+1 NEW FAC
+2 SET SEQREQ=0
+3 SET FAC=0
+4 FOR
SET FAC=$ORDER(^AUPNPAT(DFN,41,FAC))
IF 'FAC!SEQREQ
QUIT
Begin DoDot:1
+5 IF $$NEEDTOSQ^AGUTILS(DFN,FAC)
SET SEQREQ=1
QUIT
End DoDot:1
+6 QUIT SEQREQ
+7 ;RETURN TRUE IF ALL ADDRESS FIELDS ARE EMPTY
+8 ;ONLY CHECKED FOR INSURER AND EMPLOYER FILES
+9 ;CALLED FROM AGEDGUAR.
GUARADD(GUARINFO) ;EP
+1 NEW ALLMISS
+2 SET ALLMISS=0
+3 IF GUARINFO=""
QUIT 0
+4 SET GUARPTR=U_$PIECE(GUARINFO,U,14)
+5 ;ALWAYS ALLOWED TO EDIT PATIENT ADDRESS
IF GUARPTR[("AUPNPAT")
QUIT 1
+6 IF GUARPTR'[("AUTNINS")&(GUARPTR'[("AUTNEMPL"))
QUIT 0
+7 SET X=$GET(@GUARPTR)
+8 SET ALLMISS=X=""
IF ALLMISS
QUIT
+9 SET ALLMISS=($PIECE(X,U,2)="")&($PIECE(X,U,3)="")&($PIECE(X,U,4)="")&($PIECE(X,U,5)="")
+10 QUIT ALLMISS
ISMCD(INSPTR) ;EP - RETURN TRUE IF MEDICAID INSURER
+1 IF INSPTR=""
QUIT 0
+2 ;Q $P($G(^AUTNINS(INSPTR,2)),U)="D"
+3 ;IHS/OIT/NKD AG*7.1*12
QUIT $$INSTYP^AGUTL(INSPTR)="D"
+4 ;ERROR CHECK # 37 DOES PATIENT HAVE INTERNET ACCESS?
WEB(DFN) ;
+1 IF DFN=""
QUIT 1
+2 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+3 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+4 SET LSTUPD=$ORDER(^AUPNPAT(DFN,81,"B",""),-1)
+5 IF LSTUPD=""
QUIT 1
+6 SET X2=LSTUPD
+7 SET X1=DT
+8 DO ^%DTC
+9 QUIT X>365
+10 ;EDIT CHK #53 - PATIENT RACE MISSING - AG*7.1*9
+11 ;WARNING VERSION (SEE EDIT CHECK #52 FOR ERROR VERSION)
+12 ;RETURNS TRUE IF MISSING
PRACE(DFN) ;EP
+1 ;N RACE
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Race required
+5 IF $$RQRACE^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 ;IHS/OIT/NKD AG*7.1*11 MU2 - CHANGED WARNING TO USE RACE MULTIPLE
+11 ;S RACE=$$GET1^DIQ(2,DFN_",",".06","I")
+12 ;I RACE]"" Q 0
+13 IF +$$RACE^AGUTL(DFN)>0
QUIT 0
+14 QUIT 1
+15 ;EDIT CHK #52 - PATIENT RACE MISSING - AG*7.1*9
+16 ;ERROR VERSION (SEE EDIT CHECK #53 FOR WARNING VERSION)
+17 ;RETURNS TRUE IF MISSING
PRACEE(DFN) ;EP
+1 ;N RACE
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Race optional
+5 IF '$$RQRACE^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 ;IHS/OIT/NKD AG*7.1*11 MU2 - CHANGED ERROR TO USE RACE MULTIPLE
+11 ;S RACE=$$GET1^DIQ(2,DFN_",",".06","I")
+12 ;I RACE]"" Q 0
+13 IF +$$RACE^AGUTL(DFN)>0
QUIT 0
+14 QUIT 1
+15 ;EDIT CHK #38 - PATIENT ETHNICITY OR METHOD OF COLLECTION MISSING - AG*7.1*7
+16 ;WARNING VERSION (SEE EDIT CHECK #51 FOR ERROR VERSION)
+17 ;RETURNS TRUE IF MISSING
PETHNIC(DFN) ;EP
+1 NEW ETHNIC,MOC
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Ethnicity required
+5 ;AG*7.1*9
IF $$RQETH^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 SET ETHNIC=$ORDER(^DPT(DFN,.06,0))
+11 ;Method of Collection
IF ETHNIC
SET MOC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".02","I")
IF MOC=""
QUIT 1
+12 IF ETHNIC
SET ETHNIC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".01","I")
+13 ;Ethnicity
IF ETHNIC]""
QUIT 0
+14 QUIT 1
+15 ;EDIT CHK #51 - PATIENT ETHNICITY OR METHOD OF COLLECTION MISSING - AG*7.1*9
+16 ;ERROR VERSION (SEE EDIT CHECK #38 FOR WARNING VERSION)
+17 ;RETURNS TRUE IF MISSING
PETHNICE(DFN) ;EP
+1 NEW ETHNIC,MOC
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Ethnicity optional
+5 ;AG*7.1*9
IF '$$RQETH^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 SET ETHNIC=$ORDER(^DPT(DFN,.06,0))
+11 ;Method of Collection
IF ETHNIC
SET MOC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".02","I")
IF MOC=""
QUIT 1
+12 IF ETHNIC
SET ETHNIC=$$GET1^DIQ(2.06,ETHNIC_","_DFN_",",".01","I")
+13 ;Ethnicity
IF ETHNIC]""
QUIT 0
+14 QUIT 1
+15 ;EDIT CHK #39 - PATIENT MIGRANT STATUS OR TYPE MISSING - AG*7.1*7
+16 ;RETURNS TRUE IF MISSING
PMIG(DFN) ;EP
+1 NEW MIG,MSTS,MTYP
+2 IF DFN=""
QUIT 1
+3 ;
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 ;
+7 ;Quit if not getting displayed
+8 ;AG*7.1*9
IF $GET(AGOPT(26))'="Y"
QUIT 0
+9 ;
+10 SET MIG=$$CMIG^AGED10A(DFN)
+11 SET MSTS=$PIECE($PIECE(MIG,U,3),":")
+12 ;Error if no status
IF MSTS=""
QUIT 1
+13 ;Quit if status in "NO"
IF MSTS="N"
QUIT 0
+14 ;
+15 SET MTYP=$PIECE($PIECE(MIG,U,4),":")
+16 ;Error if status is yes and no type
IF MSTS="Y"
IF MTYP=""
QUIT 1
+17 QUIT 0
+18 ;EDIT CHK #40 - PATIENT HOMELESS STATUS OR TYPE MISSING - AG*7.1*7
+19 ;RETURNS TRUE IF MISSING
PHOM(DFN) ;EP
+1 NEW HOM,HSTS,HTYP
+2 IF DFN=""
QUIT 1
+3 ;
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 ;
+7 ;Quit if not getting displayed
+8 ;AG*7.1*9
IF $GET(AGOPT(27))'="Y"
QUIT 0
+9 ;
+10 SET HOM=$$CHOM^AGED10A(DFN)
+11 SET HSTS=$PIECE($PIECE(HOM,U,3),":")
+12 ;Error if no status
IF HSTS=""
QUIT 1
+13 ;Quit if status in "NO"
IF HSTS="N"
QUIT 0
+14 ;
+15 SET HTYP=$PIECE($PIECE(HOM,U,4),":")
+16 ;Error if status is yes and no type
IF HSTS="Y"
IF HTYP=""
QUIT 1
+17 QUIT 0
+18 ;EDIT CHK #41 - PATIENT PRIMARY LANGUAGE MISSING - AG*7.1*7
+19 ;WARNING VERSION (SEE EDIT CHK #50 FOR ERROR VERSION)
+20 ;RETURNS TRUE IF MISSING
LPRM(DFN) ;EP
+1 NEW LNG,VAL
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Primary Language required
+5 ;AG*7.1*9
IF $$RQPRM^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 SET VAL=$$CLANG^AGED10B(DFN)
+11 SET LNG=$PIECE($PIECE(VAL,U,2),":",2)
+12 IF LNG=""
QUIT 1
+13 ;Check Interpreter Required
IF LNG'="ENGLISH"
IF $PIECE($PIECE(VAL,U,3),":")=""
QUIT 1
+14 ;Check English Proficiency
IF LNG="ENGLISH"!($PIECE(VAL,U,5)["ENGLISH")
IF $PIECE($PIECE(VAL,U,6),":")=""
QUIT 1
+15 QUIT 0
+16 ;EDIT CHK #50 - PATIENT PRIMARY LANGUAGE MISSING - AG*7.1*9
+17 ;ERROR VERSION (SEE EDIT CHK #41 FOR WARNING VERSION)
+18 ;RETURNS TRUE IF MISSING
LPRME(DFN) ;EP
+1 NEW LNG,VAL
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Primary Language optional
+5 ;AG*7.1*9
IF '$$RQPRM^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 SET VAL=$$CLANG^AGED10B(DFN)
+11 SET LNG=$PIECE($PIECE(VAL,U,2),":",2)
+12 IF LNG=""
QUIT 1
+13 ;Check Interpreter Required
IF LNG'="ENGLISH"
IF $PIECE($PIECE(VAL,U,3),":")=""
QUIT 1
+14 ;Check English Proficiency
IF LNG="ENGLISH"!($PIECE(VAL,U,5)["ENGLISH")
IF $PIECE($PIECE(VAL,U,6),":")=""
QUIT 1
+15 QUIT 0
+16 ;EDIT CHK #42 - PATIENT PREFERRED LANGUAGE MISSING - AG*7.1*7
+17 ;WARNING VERSION (SEE EDIT CHK #49 FOR ERROR VERSION)
+18 ;RETURNS TRUE IF MISSING
LPRE(DFN) ;EP
+1 NEW DEF,IEN,PRE,PRMX,FND,LNG,OLNG,ERROR
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Preferred Language required
+5 ;AG*7.1*9
IF $$RQPRF^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 ;Error if blank
+11 ;AG*7.1*9 - Changed from AGPATDFN to DFN
SET DEF=$$CLANG^AGED10B(DFN)
+12 SET PRE=$PIECE($PIECE(DEF,U,4),":",2)
+13 IF PRE=""
QUIT 1
+14 ;
+15 ;Error if Preferred Language not in the Primary or Other Spoken Language fields
+16 ;IEN
SET IEN=$PIECE(DEF,U)
+17 ;External Primary Language
SET PRMX=$PIECE($PIECE(DEF,U,2),":",2)
+18 ;No Error if Primary equals Preferred
IF PRMX=PRE
QUIT 0
+19 ;
+20 DO GETS^DIQ(9000001.86,IEN_","_DFN_",",".05*","E","OLNG","ERROR")
+21 SET (FND,IEN)=""
FOR
SET IEN=$ORDER(OLNG("9000001.8605",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+22 SET LNG=$GET(OLNG("9000001.8605",IEN,".01","E"))
IF LNG=""
QUIT
+23 IF PRE=LNG
SET FND=1
End DoDot:1
IF FND=1
QUIT
+24 ;Error if Preferred not in Other Spoken Language list either
IF FND=""
QUIT 1
+25 QUIT 0
+26 ;EDIT CHK #49 - PATIENT PREFERRED LANGUAGE MISSING - AG*7.1*9
+27 ;ERROR VERSION (SEE EDIT CHK #42 FOR WARNING VERSION)
+28 ;RETURNS TRUE IF MISSING
LPREE(DFN) ;EP
+1 NEW DEF,IEN,PRE,PRMX,FND,LNG,OLNG,ERROR
+2 IF DFN=""
QUIT 1
+3 ;
+4 ;Quit if Preferred Language optional
+5 ;AG*7.1*9
IF '$$RQPRF^AGEDERR4(DUZ(2))
QUIT 0
+6 ;
+7 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+8 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+9 ;
+10 ;Error if blank
+11 ;AG*7.1*9 - Changed from AGPATDFN to DFN
SET DEF=$$CLANG^AGED10B(DFN)
+12 SET PRE=$PIECE($PIECE(DEF,U,4),":",2)
+13 IF PRE=""
QUIT 1
+14 ;
+15 ;Error if Preferred Language not in the Primary or Other Spoken Language fields
+16 ;IEN
SET IEN=$PIECE(DEF,U)
+17 ;External Primary Language
SET PRMX=$PIECE($PIECE(DEF,U,2),":",2)
+18 ;No Error if Primary equals Preferred
IF PRMX=PRE
QUIT 0
+19 ;
+20 DO GETS^DIQ(9000001.86,IEN_","_DFN_",",".05*","E","OLNG","ERROR")
+21 SET (FND,IEN)=""
FOR
SET IEN=$ORDER(OLNG("9000001.8605",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+22 SET LNG=$GET(OLNG("9000001.8605",IEN,".01","E"))
IF LNG=""
QUIT
+23 IF PRE=LNG
SET FND=1
End DoDot:1
IF FND=1
QUIT
+24 ;Error if Preferred not in Other Spoken Language list either
IF FND=""
QUIT 1
+25 QUIT 0
+26 ;EDIT CHK #43 - PATIENT HOUSEHOLD INCOME PERIOD MISSING - AG*7.1*7
+27 ;RETURNS TRUE IF MISSING
HIP(DFN) ;EP
+1 NEW HIC,HIP
+2 IF DFN=""
QUIT 1
+3 ;
+4 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+5 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+6 ;
+7 IF AGOPT(22)="N"
QUIT 0
+8 SET HIC=$$GET1^DIQ(9000001,DFN_",",".36","E")
+9 IF HIC'>0
QUIT 0
+10 SET HIP=$$GET1^DIQ(9000001,DFN_",","8701","E")
+11 IF HIP=""
QUIT 1
+12 QUIT 0
