AGEDERR ; IHS/SD/TPF - MAIN EDIT CHECK 'DRIVERS'
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
;THIS CONTAINS EDIT CHECKS 26 - 36
;ALL CALLS HERE PERTAIN TO EDIT CHECKS SPECIFIED BY THE
;"PATIENT REGISTRATION REQUIREMENTS DOCUMENT JAN 29, 2004 FINAL VERSION"
;COMPILED BY ADRIAN LUJAN
;THESE ARE REFERRED TO AS "EDIT CHECKS" OR ERRORS OR WARNINGS
;
;THERE ARE TWO TYPES OF EDIT CHECK RESULTS - ERRORS AND WARNINGS.
;THE RESULT STRING WILL BE RETURNED. IN THE RESULT STRING OF "1^W^001" THE
;FIRST PIECE MEANS THE RESULT WAS TRUE (YES THERE IS AN ERROR OR WARNING),
;THE SECOND PIECE MEANS THIS IS A WARNING EDIT CHECK AND THE THIRD PIECE
;MEANS THE ERROR CODE IS 1. THE ERRORS/WARNINGS ARE STORED IN THE 'AG PATIENT
;REGISTRATION ERROR CODES' FILE #9009061.5
;
W !,"ALL CALLS TO THIS ROUTINE SHOULD BE DONE VIA TAG EPs"
Q ;DO NOT CALL ROOT
;EDIT CHECK #29 - MEDICARE ELIGIBILITY DATA INCOMPLETE
MCRELINC(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
Q:DFN="" 1
I '$$HASELIG^AGEDERR2(DFN) Q 0
I '$$PTACTIVE^AGEDERR2(DFN) Q 0
I '$$CURRUPD^AGEDERR2(DFN,1095) Q 0
I $$DECEASED^AGEDERR2(DFN) Q 0
S FINDCALL="FINDMCR"
;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 LETS 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(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 NEW SPECS REC'D 1/20/05
.Q:'$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
.;END NEW SPECS REC'D 1/20/05
.S INNAME=$P(AGINS(SEQ),U)
.S POLNUM=$P(AGINS(SEQ),U,9)
.S MISSING=$P(AGINS(SEQ),U,9)="" Q:MISSING
.S MISSING=$P(AGINS(SEQ),U,5)="" Q:MISSING
.S MISSING=$P(AGINS(SEQ),U,4)="" Q:MISSING
.N X
.S X=$P($G(^AUPNMCR(DFN,21)),U,2)
.S MISSING=X="" Q:MISSING
.I $$AGE^AUPNPAT(DFN)>65 D
..S X=$O(^AUPNMSP("C",DFN,""))
..S MISSING=X="" Q:MISSING
.N X
.S X=$P($G(^AUPNPAT(DFN,0)),U,4)
.S MISSING=X="" Q:MISSING
.N X
K AGINS
Q MISSING_U_$$ERRDATA(29)_"|"_$G(POLNUM)_"|"_$G(INNAME)
;EDIT CHECK #30 - MEDICAID COVERAGE TYPE MISSING
MCDCOVMS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
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
S FINDCALL="FINDMCD" ;THIS EDIT CHECK ONLY FOR MEDICAID
;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 LETS 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(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS(4,30,"","9,1")
K AGINS,FORMAT
Q MISSING
;EDIT CHECK #31 - MEDICAID RATE MISSING
MCGRTMS(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
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
S FINDCALL="FINDMCD" ;THIS EDIT CHECK ONLY FOR MEDICAID
;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 LETS 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(DFN,.AGINS)
.E D @FINDCALL
;NEW SPECS TO BE IN NEXT VERSION OR PATCH
;OVERRIRDE EDITCHECK DEPNEDING ON SOME OTHER FIELD E.G. IN INSURER FILE FIELD
;'MEDICAID RATE CODE REQUIRED
S MISSING=$$CHKAGINS(15,31,"","9,1")
K FORMAT
K AGINS,FORMAT
Q MISSING
;EDIT CHECK #32 - PATIENT BENEFITS INCOMPLETE
PATBENIN(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
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:FINDCALL'="FINDPVT" 0 ;THIS EDIT CHECK ONLY FOR 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 LETS 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(DFN,.AGINS)
.E D @FINDCALL
S MISSING=$$CHKAGINS(26,32,"",9)&$$CHKAGINS(27,32,"",9) Q:MISSING MISSING
S MISSING=$$CHKAGINS(28,32,"",9)!$$CHKAGINS(29,32,"",9) Q:MISSING MISSING
K AGINS
Q MISSING
;EDIT CHECK #33 - INSURER SEQUENCING REQUIRED
;ALSO LOCATED IN ^AGUTILS
SEQMAN(SITE) ;EP
;NEW SPECS REC'D 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 '$$FACCHK^AGEDERR2(DFN) Q 0
;Q $P($G(^AGFAC(SITE,21)),U)
Q 1
;END NEW SPECS
;EDIT CHECK # 34 - PATIENT CASE OPEN TO BENEFITS COORDINATOR
;RETURNS TRUE IF PATIENT HAS AN OPEN CASE
PATREFBC(DFN) ;EP
;NEW SPECS REC'D 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 SPECS
N X
S X=$O(^AUPNBENR("B",DFN,""))
Q:X="" 0
S SUBREC=0,MISSING=0
F S SUBREC=$O(^AUPNBENR(X,11,SUBREC)) Q:+SUBREC=0 D Q:MISSING
.S CASEREC=$G(^AUPNBENR(X,11,SUBREC,0))
.S Y=$P(CASEREC,U) D DD^%DT S DTREF=Y
.S MISSING=$P(CASEREC,U,7)="O"!($P(CASEREC,U,7)="") Q:MISSING
Q MISSING_U_$$ERRDATA(34)_"|"_$G(DTREF)
;EDIT CHECK # 35 - MOTHER AND FATHER'S EMPLOYER DATA MISSING
;IF PATIENT IS A MINOR
;RETURNS TRUE IF BOTH MISSING
PAREMPL(DFN) ;EP
Q:'DFN 1
;NEW SPECS REC'D 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 SPECS
Q:'$$ISMINOR(DFN) 0
N X
S X=$G(^AUPNPAT(DFN,27))
Q:'$P(X,U)&('$P(X,U,2)) 1
Q 0
;EDIT CHECK #36
;FOLLOWING CHECK ONLY APPLIES TO RAILROAD, MEDICAID AND MEDICARE NAME
PHNAME(DFN,FINDCALL) ;EP
N X,SEQ,MISSING,AGINS
Q:DFN="" 1
Q:FINDCALL="FINDMCD" 0 ;DOES NOT APPLY TO MEDICAID AG*7.1*1 IM19436
S MISSING=0
;NEW SPECS REC'D 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 SPECS
;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 LETS CREATE OUR OWN AGINS
;.;ARRAY BASED ON VALUE OF 'FINDCALL'
;.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
;.S SEL=0
;.I FINDCALL="" F FINDCALL="FINDMCR","FINDMCD","FINDRRE" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")" D @FINDCALL
;.E D @FINDCALL
;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME EXISTS
;S MISSING=$$CHKAGINS(8,36,"","9,1") Q:MISSING MISSING
;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME IS IN CORRECT FORMAT
;S MISSING=$$CHKAGINS(8,36,"D NAME^AUPNPED S X=$G(X)=""""","9,1")
;K AGINS
;Q MISSING
;I $G(AGSELECT)'="" S AGINS(1)=AGSELECT S MISSING=$$PHNMCHK(.AGINS) Q MISSING
;BUG POINTED OUT BY ADRIAN DURING PATCH 1 TESTING
I $G(AGSELECT)'="" Q:$P(AGSELECT,U,10)'="R"&($P(AGSELECT,U,10)'="D") 0 S AGINS(1)=AGSELECT S MISSING=$$PHNMCHK(.AGINS) Q MISSING
E D
.;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
.;ARRAY BASED ON VALUE OF 'FINDCALL'
.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.S SEL=0
.;I FINDCALL="" F FINDCALL="FINDMCR","FINDMCD","FINDRRE" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")" D @FINDCALL Q:MISSING
.I FINDCALL="" F FINDCALL="FINDMCR","FINDRRE" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")" D @FINDCALL Q:MISSING ;AG*7.1*1 IM19436
.E D @FINDCALL
.;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME EXISTS
. S MISSING=$$PHNMCHK(.AGINS)
K AGINS
Q MISSING
PHNMCHK(AGINS) ;EP
;CHECK TO SEE IF THE NAME IS POPULATED
S MISSING=$$CHKAGINS(8,36,"","9,1") Q:MISSING MISSING
;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME IS IN CORRECT FORMAT
S MISSING=$$CHKAGINS(8,36,"D NAME^AUPNPED S X=$G(X)=""""","9,1")
Q MISSING
;NO ERROR # ASSIGNED AT THIS TIME
CHKDEATH(DFN) ;EP - CHECK IF DATE OF DEATH FIELD IS POPULATED
I $P($G(^DPT(DFN,.35)),U) Q 1
Q 0
;IS PATIENT A MINOR <18
ISMINOR(DFN) ;EP - CHECK IF PATIENT IS A MINOR AGE PER SANDRI LAHI
Q:'DFN 1
;NEW SPECS REC'D 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 SPECS
S D0=DFN
X $P($G(^DD(2,.033,0)),U,5,299)
Q X<18 ;HARD CODED PER SANDRI LAHI
;BUILD AGINS ARRAY CALLING ALL FIND TAGS WITHIN ROUTINE AGINS
FINDALL(DFN,AGINS) ;EP
N SEL
S SEL=0
F FINDCALL="FINDMCR","FINDMCD","FINDRRE","FINDPVT","FINDTPL","FINDWC","FINDGUAR" D
.;DO NOT DO CALLS TO WORKMAN'S COMP OR THIRD PARTY OR GURANTOR WHEN VERSION NOT 7.1
.Q:($G(AGOPT("VERSION"))<7.1)&((FINDCALL="FINDTPL")!(FINDCALL="FINDWC")!(FINDCALL="FINDGUAR"))
.S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
.D @FINDCALL
Q
;CALL WHEN CHECKING THE AGINS ARRAY FOR SOMETHING MISSING
;PASS THE 'ERROR' NUMBER THIS IS CHECKING
;PASS THE 'PIECE' IN THE AGINS ARRAY NODE YOUR CHECKING FOR MISSING
;DATA RETURNS TRUE IF THE PIECE IS MISSING IN ANY NODE OF THE AGINS
;ARRAY PLUS THE ERROR INFO. IF YOU ARE CHECKING FOR A PATTERN ETC
;SEND IT AS 'FORMAT' ELSE THE CHECK IS ONLY FOR MISSING DATA.
;'RETPIECE' IS THE PIECES OF INFO YOU WANT RETURNED IF THE DATA IS
;MISSING OR IMPROPERLY FORMATTED (USED TO HELP IDENTIFY WHERE TO
;CORRECT THE DATA)\ 'FORMAT'- SEND AS XECUTABLE M CODE THAT RETURNS
;X AS TRUE IF WRONG PATTERN OR INCORRECT IN SOME WAY
CHKAGINS(PIECE,ERROR,FORMAT,RETPIECE) ;EP
S RETPIECE=$G(RETPIECE)
N SEQ,MISSING,X
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 NEW SPECS REC'D 1/20/05
.;ERROR 18 IS CHECKED REGARDLESS OF WHETHER THE POLICY IS INACTIVE OR NOT
.;PER ADRIAN 2/4/2005
.;ALMOST TIME TO ADD A CALL FOR "ERROR OVERRIDES"
.I ERROR'=18 Q:'$$ISACTIVE^AGINS($P(AGINS(SEQ),U,5),$P(AGINS(SEQ),U,6))
.;END NEW SPECS REC'D 1/20/05
.;NEW REQUEST OF APRIL 15,2005 PER ADRIAN
.;CHECK TO SEE IF OVERRIDES EXIST IN THE 'AG PATIENT REGISTRATION ERROR CODES
.;FILE FOR A PARTICULAR ERROR
.I $$OVERRIDE(ERROR,AGINS(SEQ)) S MISSING=0 Q
.I FORMAT="" S MISSING=$P(AGINS(SEQ),U,PIECE)=""
.E S X=$P(AGINS(SEQ),U,PIECE) X FORMAT S MISSING=X
.S:MISSING MISSING=MISSING_U_$$ERRDATA(ERROR)
I MISSING F P=1:1 Q:$P(RETPIECE,",",P)="" S RET=$P(RETPIECE,",",P) S MISSING=MISSING_"|"_$P(AGINS(SEQ),U,RET)
Q MISSING
;
OVERRIDE(ERROR,RECORD) ;
N OVERRIDE,RETURN
Q:$G(^AGEDERRS(ERROR,12))="" 0
X $G(^AGEDERRS(ERROR,12))
Q RETURN
;CALL THIS WITH ERROR NUMBERS YOU WISH TO CHECK IN FOLLOWING
;MANNER. 'ERRORS' IS AN ARRAY DEFINED WITH THE FIRST SUBSCRIPT
;EQUAL TO THE ERROR NUMBER YOU WISH TO CHECK. YOU CAN CHECK
;MULTIPLE ERRORS. PASS IN ARRAY(1)="" TO CHECK ERROR #1
;'VARS' IS AN ARRAY OF VALUES IN THE FORM VAR("DFN")=3456 THE
;SUBSCRIPT IN THE ARRAY SHOULD MATCH THE VARIABLE NAME OF THE
;ERROR CALL I.E. DFN,SITE,FINDCALL ARE ALL POSSIBLE SUBSCRIPTS
;TO SET VARIABLES USED TO PASS INFO TO THE FUNCTIONS
;PASS 'DISPLAY' AS TRUE IF YOU WANT THIS ROUTINE TO DISPLAY THE
;ERRORS
EDITCHEK(ERRORS,VARS,DISPLAY) ;EP
;LOAD VARIABLES
S VAR=""
F S VAR=$O(VARS(VAR)) Q:VAR="" N @VAR S X1="@VAR=VARS(VAR)",@X1
S ERRORNUM=0
F S ERRORNUM=$O(ERRORS(ERRORNUM)) Q:ERRORNUM="" D
.S AGERRCAL=$P($G(^AGEDERRS(ERRORNUM,0)),U,4,5)
.I $P(AGERRCAL,U)=""!($P(AGERRCAL,U,2)="") S ERRORS(ERRORNUM)="0^Routine or tag not defined." Q
.S AGERNODE=$G(^AGEDERRS(ERRORNUM,0))
.S AGERRTYP=$P($G(^AGEDERRS(ERRORNUM,0)),U,2)
.S AGERRMSG=$P($G(^AGEDERRS(ERRORNUM,0)),U,3)
.S AGERRSOL=$$GET1^DIQ(9009061.5,ERRORNUM,501,"Z","AGERRSOL","ERRMSG")
.I 1 D
..S AGERRCAL="S MISSING=$$"_AGERRCAL
..X AGERRCAL
..I MISSING S ERRORS(ERRORNUM)=MISSING M ERRORS(ERRORNUM,"SOLUTION")=AGERRSOL S ERRORS("C",AGERRTYP,ERRORNUM)=""
..E S ERRORS(ERRORNUM)=0
I DISPLAY D DISPLAY(.ERRORS)
Q
DISPLAY(ERRORS) ;EP
N ERRNUM,ERRTYPE,ERRNODE,TRUE,X
S ERRNUM=""
F S ERRNUM=$O(ERRORS(ERRNUM)) Q:'ERRNUM D
.S ERRNODE=ERRORS(ERRNUM)
.S TRUE=$P(ERRNODE,U)
.Q:'TRUE
.I $P(ERRNODE,U,2)="" S ERRNODE=ERRNODE_U_$$ERRDATA(ERRNUM)
.S ERRCODE=$P(ERRNODE,U,2)
.S ERRTYPE=$P(ERRNODE,U,3)
.S ERRMESG=$P($P(ERRNODE,U,4),"|")
.S ERRINFO=$P(ERRNODE,"|",2,10)
.I ERRMESG[("#") D
..S ERRMESG=$P(ERRMESG,"#")_ERRINFO_$P(ERRMESG,"#",2)
.I ERRTYPE="E" W $$S^AGVDF("RVN")
.W !,"***"_$S(ERRTYPE="E":"ERROR",ERRTYPE="W":"WARNING",ERRTYPE="F":"FATAL ERROR",ERRTYPE="A":"ALERT",1:"UNKNOWN")
.S X=ERRCODE
.S X="000"_X
.W ?11,$E(X,$L(X)-2,$L(X))_":"
.W ?16,ERRMESG
.I ERRTYPE="E" W $$S^AGVDF("RVF")
Q
;RETURN ARRAY OF EDIT CHECSK TO PERFORM BASED ON PAGE NUMBER
FETCHERR(PAGENUM,ARRAY) ;EP
N ERRNUM
I PAGENUM="ALL"!(PAGENUM="") D Q
.S ERRNUM=0
.F S ERRNUM=$O(^AGEDERRS(ERRNUM)) Q:'ERRNUM!(ERRNUM=999) S ARRAY(ERRNUM)=""
S ERRNUM=0
F S ERRNUM=$O(^AGEDERRS("AB",PAGENUM,ERRNUM)) Q:ERRNUM="" S ARRAY(ERRNUM)=""
Q
;VERIFY ROUTINE AND TAG ARE VALID
CHECKRTN(ERRCALL) ;EP
S X=$P(ERRCALL,U,2)
X ^%ZOSF("TEST")
Q $T
;RETURN ERROR DATA
ERRDATA(ERR) ;EP
Q $P($G(^AGEDERRS(ERR,0)),U,1,3)
;ERROR #?? NOT USED AT THIS TIME
;CLASSIFICATION/BENEFICIARY STATUS INDICATES NON-INDIAN
;RETURNS TRUE IF NON-INDIAN
NONIND(DFN) ;EP
N CLASS,CLASSNAM
Q:DFN="" 1
S CLASS=$P($G(^AUPNPAT(DFN,11)),U,11)
Q:'CLASS 0
S CLASSNAM=$P($G(^AUTTBEN(CLASS,0)),U)
Q CLASSNAM[("NON-INDIAN")
;CHECK GUARANTOR ADDRESS
GUARADD(GUARINFO) ;EP
N MISSING
Q:GUARINFO="" 1
S MISSING=0
S GUARPTR=U_$P(GUARINFO,U,14)
I GUARPTR[("AUTNINS")!(GUARPTR[("AUTNEMPL")) D Q MISSING
.S X=$G(@GUARPTR)
.S MISSING=X="" Q:MISSING
.S MISSING=$P(X,U,2)="" Q:MISSING
.S MISSING=$P(X,U,3)="" Q:MISSING
.S MISSING=$P(X,U,4)="" Q:MISSING
.S MISSING=$P(X,U,5)="" Q:MISSING
I GUARPTR[("AUPNPAT") D Q MISSING
.S DPTPTR=$P($P(GUARINFO,U,2),",")
.S:DPTPTR="" MISSING=1 Q:MISSING
.S GUARPTR="^DPT("_DPTPTR_",.11)"
.S X=$G(@GUARPTR)
.S MISSING=X="" Q:MISSING
.S MISSING=$P(X,U)="" Q:MISSING
.S MISSING=$P(X,U,4)="" Q:MISSING
.S MISSING=$P(X,U,5)="" Q:MISSING
.S MISSING=$P(X,U,6)="" Q:MISSING
Q MISSING
AGEDERR ; IHS/SD/TPF - MAIN EDIT CHECK 'DRIVERS'
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
+3 ;THIS CONTAINS EDIT CHECKS 26 - 36
+4 ;ALL CALLS HERE PERTAIN TO EDIT CHECKS SPECIFIED BY THE
+5 ;"PATIENT REGISTRATION REQUIREMENTS DOCUMENT JAN 29, 2004 FINAL VERSION"
+6 ;COMPILED BY ADRIAN LUJAN
+7 ;THESE ARE REFERRED TO AS "EDIT CHECKS" OR ERRORS OR WARNINGS
+8 ;
+9 ;THERE ARE TWO TYPES OF EDIT CHECK RESULTS - ERRORS AND WARNINGS.
+10 ;THE RESULT STRING WILL BE RETURNED. IN THE RESULT STRING OF "1^W^001" THE
+11 ;FIRST PIECE MEANS THE RESULT WAS TRUE (YES THERE IS AN ERROR OR WARNING),
+12 ;THE SECOND PIECE MEANS THIS IS A WARNING EDIT CHECK AND THE THIRD PIECE
+13 ;MEANS THE ERROR CODE IS 1. THE ERRORS/WARNINGS ARE STORED IN THE 'AG PATIENT
+14 ;REGISTRATION ERROR CODES' FILE #9009061.5
+15 ;
+16 WRITE !,"ALL CALLS TO THIS ROUTINE SHOULD BE DONE VIA TAG EPs"
+17 ;DO NOT CALL ROOT
QUIT
+18 ;EDIT CHECK #29 - MEDICARE ELIGIBILITY DATA INCOMPLETE
MCRELINC(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF DFN=""
QUIT 1
+3 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+4 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+5 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+6 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+7 SET FINDCALL="FINDMCR"
+8 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+9 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+10 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+11 IF '$TEST
Begin DoDot:1
+12 ;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+13 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+14 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+15 SET SEL=0
+16 IF FINDCALL=""
DO FINDALL(DFN,.AGINS)
+17 IF '$TEST
DO @FINDCALL
End DoDot:1
+18 SET SEQ=0
SET MISSING=0
+19 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+20 ;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE NEW SPECS REC'D 1/20/05
+21 IF '$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
QUIT
+22 ;END NEW SPECS REC'D 1/20/05
+23 SET INNAME=$PIECE(AGINS(SEQ),U)
+24 SET POLNUM=$PIECE(AGINS(SEQ),U,9)
+25 SET MISSING=$PIECE(AGINS(SEQ),U,9)=""
IF MISSING
QUIT
+26 SET MISSING=$PIECE(AGINS(SEQ),U,5)=""
IF MISSING
QUIT
+27 SET MISSING=$PIECE(AGINS(SEQ),U,4)=""
IF MISSING
QUIT
+28 NEW X
+29 SET X=$PIECE($GET(^AUPNMCR(DFN,21)),U,2)
+30 SET MISSING=X=""
IF MISSING
QUIT
+31 IF $$AGE^AUPNPAT(DFN)>65
Begin DoDot:2
+32 SET X=$ORDER(^AUPNMSP("C",DFN,""))
+33 SET MISSING=X=""
IF MISSING
QUIT
End DoDot:2
+34 NEW X
+35 SET X=$PIECE($GET(^AUPNPAT(DFN,0)),U,4)
+36 SET MISSING=X=""
IF MISSING
QUIT
+37 NEW X
End DoDot:1
IF MISSING
QUIT
+38 KILL AGINS
+39 QUIT MISSING_U_$$ERRDATA(29)_"|"_$GET(POLNUM)_"|"_$GET(INNAME)
+40 ;EDIT CHECK #30 - MEDICAID COVERAGE TYPE MISSING
MCDCOVMS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF 'DFN
QUIT 1
+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 ;THIS EDIT CHECK ONLY FOR MEDICAID
SET FINDCALL="FINDMCD"
+8 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+9 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+10 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+11 IF '$TEST
Begin DoDot:1
+12 ;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+13 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+14 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+15 SET SEL=0
+16 IF FINDCALL=""
DO FINDALL(DFN,.AGINS)
+17 IF '$TEST
DO @FINDCALL
End DoDot:1
+18 SET MISSING=$$CHKAGINS(4,30,"","9,1")
+19 KILL AGINS,FORMAT
+20 QUIT MISSING
+21 ;EDIT CHECK #31 - MEDICAID RATE MISSING
MCGRTMS(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF 'DFN
QUIT 1
+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 ;THIS EDIT CHECK ONLY FOR MEDICAID
SET FINDCALL="FINDMCD"
+8 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+9 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+10 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+11 IF '$TEST
Begin DoDot:1
+12 ;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+13 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+14 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+15 SET SEL=0
+16 IF FINDCALL=""
DO FINDALL(DFN,.AGINS)
+17 IF '$TEST
DO @FINDCALL
End DoDot:1
+18 ;NEW SPECS TO BE IN NEXT VERSION OR PATCH
+19 ;OVERRIRDE EDITCHECK DEPNEDING ON SOME OTHER FIELD E.G. IN INSURER FILE FIELD
+20 ;'MEDICAID RATE CODE REQUIRED
+21 SET MISSING=$$CHKAGINS(15,31,"","9,1")
+22 KILL FORMAT
+23 KILL AGINS,FORMAT
+24 QUIT MISSING
+25 ;EDIT CHECK #32 - PATIENT BENEFITS INCOMPLETE
PATBENIN(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF 'DFN
QUIT 1
+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 ;THIS EDIT CHECK ONLY FOR PRIVATE INSURANCE
IF FINDCALL'="FINDPVT"
QUIT 0
+8 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+9 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+10 IF $GET(AGSELECT)'=""
SET AGINS(1)=AGSELECT
+11 IF '$TEST
Begin DoDot:1
+12 ;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+13 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+14 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+15 SET SEL=0
+16 IF FINDCALL=""
DO FINDALL(DFN,.AGINS)
+17 IF '$TEST
DO @FINDCALL
End DoDot:1
+18 SET MISSING=$$CHKAGINS(26,32,"",9)&$$CHKAGINS(27,32,"",9)
IF MISSING
QUIT MISSING
+19 SET MISSING=$$CHKAGINS(28,32,"",9)!$$CHKAGINS(29,32,"",9)
IF MISSING
QUIT MISSING
+20 KILL AGINS
+21 QUIT MISSING
+22 ;EDIT CHECK #33 - INSURER SEQUENCING REQUIRED
+23 ;ALSO LOCATED IN ^AGUTILS
SEQMAN(SITE) ;EP
+1 ;NEW SPECS REC'D 1/20/05
+2 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+3 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+4 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+5 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+6 IF '$$FACCHK^AGEDERR2(DFN)
QUIT 0
+7 ;Q $P($G(^AGFAC(SITE,21)),U)
+8 QUIT 1
+9 ;END NEW SPECS
+10 ;EDIT CHECK # 34 - PATIENT CASE OPEN TO BENEFITS COORDINATOR
+11 ;RETURNS TRUE IF PATIENT HAS AN OPEN CASE
PATREFBC(DFN) ;EP
+1 ;NEW SPECS REC'D 1/20/05
+2 IF $$DECEASED^AGEDERR2(DFN)
QUIT 0
+3 IF '$$PTACTIVE^AGEDERR2(DFN)
QUIT 0
+4 IF '$$CURRUPD^AGEDERR2(DFN,1095)
QUIT 0
+5 IF '$$HASELIG^AGEDERR2(DFN)
QUIT 0
+6 ;END NEW SPECS
+7 NEW X
+8 SET X=$ORDER(^AUPNBENR("B",DFN,""))
+9 IF X=""
QUIT 0
+10 SET SUBREC=0
SET MISSING=0
+11 FOR
SET SUBREC=$ORDER(^AUPNBENR(X,11,SUBREC))
IF +SUBREC=0
QUIT
Begin DoDot:1
+12 SET CASEREC=$GET(^AUPNBENR(X,11,SUBREC,0))
+13 SET Y=$PIECE(CASEREC,U)
DO DD^%DT
SET DTREF=Y
+14 SET MISSING=$PIECE(CASEREC,U,7)="O"!($PIECE(CASEREC,U,7)="")
IF MISSING
QUIT
End DoDot:1
IF MISSING
QUIT
+15 QUIT MISSING_U_$$ERRDATA(34)_"|"_$GET(DTREF)
+16 ;EDIT CHECK # 35 - MOTHER AND FATHER'S EMPLOYER DATA MISSING
+17 ;IF PATIENT IS A MINOR
+18 ;RETURNS TRUE IF BOTH MISSING
PAREMPL(DFN) ;EP
+1 IF 'DFN
QUIT 1
+2 ;NEW SPECS REC'D 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 NEW SPECS
+8 IF '$$ISMINOR(DFN)
QUIT 0
+9 NEW X
+10 SET X=$GET(^AUPNPAT(DFN,27))
+11 IF '$PIECE(X,U)&('$PIECE(X,U,2))
QUIT 1
+12 QUIT 0
+13 ;EDIT CHECK #36
+14 ;FOLLOWING CHECK ONLY APPLIES TO RAILROAD, MEDICAID AND MEDICARE NAME
PHNAME(DFN,FINDCALL) ;EP
+1 NEW X,SEQ,MISSING,AGINS
+2 IF DFN=""
QUIT 1
+3 ;DOES NOT APPLY TO MEDICAID AG*7.1*1 IM19436
IF FINDCALL="FINDMCD"
QUIT 0
+4 SET MISSING=0
+5 ;NEW SPECS REC'D 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 NEW SPECS
+11 ;IF SELECTION IS DEFINED WE'RE COMING FROM AGED4A AND THE USER HAS
+12 ;SELECTED AN INSURER FROM THE AGINS ARRAY
+13 ;I $G(AGSELECT)'="" S AGINS(1)=AGSELECT
+14 ;E D
+15 ;.;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+16 ;.;ARRAY BASED ON VALUE OF 'FINDCALL'
+17 ;.I FINDCALL'="" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+18 ;.S SEL=0
+19 ;.I FINDCALL="" F FINDCALL="FINDMCR","FINDMCD","FINDRRE" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")" D @FINDCALL
+20 ;.E D @FINDCALL
+21 ;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME EXISTS
+22 ;S MISSING=$$CHKAGINS(8,36,"","9,1") Q:MISSING MISSING
+23 ;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME IS IN CORRECT FORMAT
+24 ;S MISSING=$$CHKAGINS(8,36,"D NAME^AUPNPED S X=$G(X)=""""","9,1")
+25 ;K AGINS
+26 ;Q MISSING
+27 ;I $G(AGSELECT)'="" S AGINS(1)=AGSELECT S MISSING=$$PHNMCHK(.AGINS) Q MISSING
+28 ;BUG POINTED OUT BY ADRIAN DURING PATCH 1 TESTING
+29 IF $GET(AGSELECT)'=""
IF $PIECE(AGSELECT,U,10)'="R"&($PIECE(AGSELECT,U,10)'="D")
QUIT 0
SET AGINS(1)=AGSELECT
SET MISSING=$$PHNMCHK(.AGINS)
QUIT MISSING
+30 IF '$TEST
Begin DoDot:1
+31 ;USER HAS NOT SELECTED FROM AGED4A SO LETS CREATE OUR OWN AGINS
+32 ;ARRAY BASED ON VALUE OF 'FINDCALL'
+33 IF FINDCALL'=""
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+34 SET SEL=0
+35 ;I FINDCALL="" F FINDCALL="FINDMCR","FINDMCD","FINDRRE" S FINDCALL=FINDCALL_U_"AGINS("_DFN_")" D @FINDCALL Q:MISSING
+36 ;AG*7.1*1 IM19436
IF FINDCALL=""
FOR FINDCALL="FINDMCR","FINDRRE"
SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
DO @FINDCALL
IF MISSING
QUIT
+37 IF '$TEST
DO @FINDCALL
+38 ;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME EXISTS
+39 SET MISSING=$$PHNMCHK(.AGINS)
End DoDot:1
+40 KILL AGINS
+41 QUIT MISSING
PHNMCHK(AGINS) ;EP
+1 ;CHECK TO SEE IF THE NAME IS POPULATED
+2 SET MISSING=$$CHKAGINS(8,36,"","9,1")
IF MISSING
QUIT MISSING
+3 ;CHECK TO SEE IF MCR NAME, MCD NAME, RR NAME IS IN CORRECT FORMAT
+4 SET MISSING=$$CHKAGINS(8,36,"D NAME^AUPNPED S X=$G(X)=""""","9,1")
+5 QUIT MISSING
+6 ;NO ERROR # ASSIGNED AT THIS TIME
CHKDEATH(DFN) ;EP - CHECK IF DATE OF DEATH FIELD IS POPULATED
+1 IF $PIECE($GET(^DPT(DFN,.35)),U)
QUIT 1
+2 QUIT 0
+3 ;IS PATIENT A MINOR <18
ISMINOR(DFN) ;EP - CHECK IF PATIENT IS A MINOR AGE PER SANDRI LAHI
+1 IF 'DFN
QUIT 1
+2 ;NEW SPECS REC'D 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 NEW SPECS
+8 SET D0=DFN
+9 XECUTE $PIECE($GET(^DD(2,.033,0)),U,5,299)
+10 ;HARD CODED PER SANDRI LAHI
QUIT X<18
+11 ;BUILD AGINS ARRAY CALLING ALL FIND TAGS WITHIN ROUTINE AGINS
FINDALL(DFN,AGINS) ;EP
+1 NEW SEL
+2 SET SEL=0
+3 FOR FINDCALL="FINDMCR","FINDMCD","FINDRRE","FINDPVT","FINDTPL","FINDWC","FINDGUAR"
Begin DoDot:1
+4 ;DO NOT DO CALLS TO WORKMAN'S COMP OR THIRD PARTY OR GURANTOR WHEN VERSION NOT 7.1
+5 IF ($GET(AGOPT("VERSION"))<7.1)&((FINDCALL="FINDTPL")!(FINDCALL="FINDWC")!(FINDCALL="FINDGUAR"))
QUIT
+6 SET FINDCALL=FINDCALL_U_"AGINS("_DFN_")"
+7 DO @FINDCALL
End DoDot:1
+8 QUIT
+9 ;CALL WHEN CHECKING THE AGINS ARRAY FOR SOMETHING MISSING
+10 ;PASS THE 'ERROR' NUMBER THIS IS CHECKING
+11 ;PASS THE 'PIECE' IN THE AGINS ARRAY NODE YOUR CHECKING FOR MISSING
+12 ;DATA RETURNS TRUE IF THE PIECE IS MISSING IN ANY NODE OF THE AGINS
+13 ;ARRAY PLUS THE ERROR INFO. IF YOU ARE CHECKING FOR A PATTERN ETC
+14 ;SEND IT AS 'FORMAT' ELSE THE CHECK IS ONLY FOR MISSING DATA.
+15 ;'RETPIECE' IS THE PIECES OF INFO YOU WANT RETURNED IF THE DATA IS
+16 ;MISSING OR IMPROPERLY FORMATTED (USED TO HELP IDENTIFY WHERE TO
+17 ;CORRECT THE DATA)\ 'FORMAT'- SEND AS XECUTABLE M CODE THAT RETURNS
+18 ;X AS TRUE IF WRONG PATTERN OR INCORRECT IN SOME WAY
CHKAGINS(PIECE,ERROR,FORMAT,RETPIECE) ;EP
+1 SET RETPIECE=$GET(RETPIECE)
+2 NEW SEQ,MISSING,X
+3 SET SEQ=0
SET MISSING=0
+4 FOR
SET SEQ=$ORDER(AGINS(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+5 ;DO NOT CHECK FOR ERRORS ON INSURANCE THAT IS INACTIVE NEW SPECS REC'D 1/20/05
+6 ;ERROR 18 IS CHECKED REGARDLESS OF WHETHER THE POLICY IS INACTIVE OR NOT
+7 ;PER ADRIAN 2/4/2005
+8 ;ALMOST TIME TO ADD A CALL FOR "ERROR OVERRIDES"
+9 IF ERROR'=18
IF '$$ISACTIVE^AGINS($PIECE(AGINS(SEQ),U,5),$PIECE(AGINS(SEQ),U,6))
QUIT
+10 ;END NEW SPECS REC'D 1/20/05
+11 ;NEW REQUEST OF APRIL 15,2005 PER ADRIAN
+12 ;CHECK TO SEE IF OVERRIDES EXIST IN THE 'AG PATIENT REGISTRATION ERROR CODES
+13 ;FILE FOR A PARTICULAR ERROR
+14 IF $$OVERRIDE(ERROR,AGINS(SEQ))
SET MISSING=0
QUIT
+15 IF FORMAT=""
SET MISSING=$PIECE(AGINS(SEQ),U,PIECE)=""
+16 IF '$TEST
SET X=$PIECE(AGINS(SEQ),U,PIECE)
XECUTE FORMAT
SET MISSING=X
+17 IF MISSING
SET MISSING=MISSING_U_$$ERRDATA(ERROR)
End DoDot:1
IF MISSING
QUIT
+18 IF MISSING
FOR P=1:1
IF $PIECE(RETPIECE,",",P)=""
QUIT
SET RET=$PIECE(RETPIECE,",",P)
SET MISSING=MISSING_"|"_$PIECE(AGINS(SEQ),U,RET)
+19 QUIT MISSING
+20 ;
OVERRIDE(ERROR,RECORD) ;
+1 NEW OVERRIDE,RETURN
+2 IF $GET(^AGEDERRS(ERROR,12))=""
QUIT 0
+3 XECUTE $GET(^AGEDERRS(ERROR,12))
+4 QUIT RETURN
+5 ;CALL THIS WITH ERROR NUMBERS YOU WISH TO CHECK IN FOLLOWING
+6 ;MANNER. 'ERRORS' IS AN ARRAY DEFINED WITH THE FIRST SUBSCRIPT
+7 ;EQUAL TO THE ERROR NUMBER YOU WISH TO CHECK. YOU CAN CHECK
+8 ;MULTIPLE ERRORS. PASS IN ARRAY(1)="" TO CHECK ERROR #1
+9 ;'VARS' IS AN ARRAY OF VALUES IN THE FORM VAR("DFN")=3456 THE
+10 ;SUBSCRIPT IN THE ARRAY SHOULD MATCH THE VARIABLE NAME OF THE
+11 ;ERROR CALL I.E. DFN,SITE,FINDCALL ARE ALL POSSIBLE SUBSCRIPTS
+12 ;TO SET VARIABLES USED TO PASS INFO TO THE FUNCTIONS
+13 ;PASS 'DISPLAY' AS TRUE IF YOU WANT THIS ROUTINE TO DISPLAY THE
+14 ;ERRORS
EDITCHEK(ERRORS,VARS,DISPLAY) ;EP
+1 ;LOAD VARIABLES
+2 SET VAR=""
+3 FOR
SET VAR=$ORDER(VARS(VAR))
IF VAR=""
QUIT
NEW @VAR
SET X1="@VAR=VARS(VAR)"
SET @X1
+4 SET ERRORNUM=0
+5 FOR
SET ERRORNUM=$ORDER(ERRORS(ERRORNUM))
IF ERRORNUM=""
QUIT
Begin DoDot:1
+6 SET AGERRCAL=$PIECE($GET(^AGEDERRS(ERRORNUM,0)),U,4,5)
+7 IF $PIECE(AGERRCAL,U)=""!($PIECE(AGERRCAL,U,2)="")
SET ERRORS(ERRORNUM)="0^Routine or tag not defined."
QUIT
+8 SET AGERNODE=$GET(^AGEDERRS(ERRORNUM,0))
+9 SET AGERRTYP=$PIECE($GET(^AGEDERRS(ERRORNUM,0)),U,2)
+10 SET AGERRMSG=$PIECE($GET(^AGEDERRS(ERRORNUM,0)),U,3)
+11 SET AGERRSOL=$$GET1^DIQ(9009061.5,ERRORNUM,501,"Z","AGERRSOL","ERRMSG")
+12 IF 1
Begin DoDot:2
+13 SET AGERRCAL="S MISSING=$$"_AGERRCAL
+14 XECUTE AGERRCAL
+15 IF MISSING
SET ERRORS(ERRORNUM)=MISSING
MERGE ERRORS(ERRORNUM,"SOLUTION")=AGERRSOL
SET ERRORS("C",AGERRTYP,ERRORNUM)=""
+16 IF '$TEST
SET ERRORS(ERRORNUM)=0
End DoDot:2
End DoDot:1
+17 IF DISPLAY
DO DISPLAY(.ERRORS)
+18 QUIT
DISPLAY(ERRORS) ;EP
+1 NEW ERRNUM,ERRTYPE,ERRNODE,TRUE,X
+2 SET ERRNUM=""
+3 FOR
SET ERRNUM=$ORDER(ERRORS(ERRNUM))
IF 'ERRNUM
QUIT
Begin DoDot:1
+4 SET ERRNODE=ERRORS(ERRNUM)
+5 SET TRUE=$PIECE(ERRNODE,U)
+6 IF 'TRUE
QUIT
+7 IF $PIECE(ERRNODE,U,2)=""
SET ERRNODE=ERRNODE_U_$$ERRDATA(ERRNUM)
+8 SET ERRCODE=$PIECE(ERRNODE,U,2)
+9 SET ERRTYPE=$PIECE(ERRNODE,U,3)
+10 SET ERRMESG=$PIECE($PIECE(ERRNODE,U,4),"|")
+11 SET ERRINFO=$PIECE(ERRNODE,"|",2,10)
+12 IF ERRMESG[("#")
Begin DoDot:2
+13 SET ERRMESG=$PIECE(ERRMESG,"#")_ERRINFO_$PIECE(ERRMESG,"#",2)
End DoDot:2
+14 IF ERRTYPE="E"
WRITE $$S^AGVDF("RVN")
+15 WRITE !,"***"_$SELECT(ERRTYPE="E":"ERROR",ERRTYPE="W":"WARNING",ERRTYPE="F":"FATAL ERROR",ERRTYPE="A":"ALERT",1:"UNKNOWN")
+16 SET X=ERRCODE
+17 SET X="000"_X
+18 WRITE ?11,$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))_":"
+19 WRITE ?16,ERRMESG
+20 IF ERRTYPE="E"
WRITE $$S^AGVDF("RVF")
End DoDot:1
+21 QUIT
+22 ;RETURN ARRAY OF EDIT CHECSK TO PERFORM BASED ON PAGE NUMBER
FETCHERR(PAGENUM,ARRAY) ;EP
+1 NEW ERRNUM
+2 IF PAGENUM="ALL"!(PAGENUM="")
Begin DoDot:1
+3 SET ERRNUM=0
+4 FOR
SET ERRNUM=$ORDER(^AGEDERRS(ERRNUM))
IF 'ERRNUM!(ERRNUM=999)
QUIT
SET ARRAY(ERRNUM)=""
End DoDot:1
QUIT
+5 SET ERRNUM=0
+6 FOR
SET ERRNUM=$ORDER(^AGEDERRS("AB",PAGENUM,ERRNUM))
IF ERRNUM=""
QUIT
SET ARRAY(ERRNUM)=""
+7 QUIT
+8 ;VERIFY ROUTINE AND TAG ARE VALID
CHECKRTN(ERRCALL) ;EP
+1 SET X=$PIECE(ERRCALL,U,2)
+2 XECUTE ^%ZOSF("TEST")
+3 QUIT $TEST
+4 ;RETURN ERROR DATA
ERRDATA(ERR) ;EP
+1 QUIT $PIECE($GET(^AGEDERRS(ERR,0)),U,1,3)
+2 ;ERROR #?? NOT USED AT THIS TIME
+3 ;CLASSIFICATION/BENEFICIARY STATUS INDICATES NON-INDIAN
+4 ;RETURNS TRUE IF NON-INDIAN
NONIND(DFN) ;EP
+1 NEW CLASS,CLASSNAM
+2 IF DFN=""
QUIT 1
+3 SET CLASS=$PIECE($GET(^AUPNPAT(DFN,11)),U,11)
+4 IF 'CLASS
QUIT 0
+5 SET CLASSNAM=$PIECE($GET(^AUTTBEN(CLASS,0)),U)
+6 QUIT CLASSNAM[("NON-INDIAN")
+7 ;CHECK GUARANTOR ADDRESS
GUARADD(GUARINFO) ;EP
+1 NEW MISSING
+2 IF GUARINFO=""
QUIT 1
+3 SET MISSING=0
+4 SET GUARPTR=U_$PIECE(GUARINFO,U,14)
+5 IF GUARPTR[("AUTNINS")!(GUARPTR[("AUTNEMPL"))
Begin DoDot:1
+6 SET X=$GET(@GUARPTR)
+7 SET MISSING=X=""
IF MISSING
QUIT
+8 SET MISSING=$PIECE(X,U,2)=""
IF MISSING
QUIT
+9 SET MISSING=$PIECE(X,U,3)=""
IF MISSING
QUIT
+10 SET MISSING=$PIECE(X,U,4)=""
IF MISSING
QUIT
+11 SET MISSING=$PIECE(X,U,5)=""
IF MISSING
QUIT
End DoDot:1
QUIT MISSING
+12 IF GUARPTR[("AUPNPAT")
Begin DoDot:1
+13 SET DPTPTR=$PIECE($PIECE(GUARINFO,U,2),",")
+14 IF DPTPTR=""
SET MISSING=1
IF MISSING
QUIT
+15 SET GUARPTR="^DPT("_DPTPTR_",.11)"
+16 SET X=$GET(@GUARPTR)
+17 SET MISSING=X=""
IF MISSING
QUIT
+18 SET MISSING=$PIECE(X,U)=""
IF MISSING
QUIT
+19 SET MISSING=$PIECE(X,U,4)=""
IF MISSING
QUIT
+20 SET MISSING=$PIECE(X,U,5)=""
IF MISSING
QUIT
+21 SET MISSING=$PIECE(X,U,6)=""
IF MISSING
QUIT
End DoDot:1
QUIT MISSING
+22 QUIT MISSING
