AGEDERR2.m

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)