| 1 | IVMZ7CE ;TDM,BAJ - HL7 Z07 CONSISTENCY CHECKER -- SERVICE SUBROUTINE ; 01/23/07
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**105**;JUL 8,1996;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; Eligibility Consistency Checks
|
|---|
| 5 | ; This routine checks the various elements of service information
|
|---|
| 6 | ; prior to building a Z07 record. Any tests which fail consistency
|
|---|
| 7 | ; check will be saved to the ^DGIN(38.6 record for the patient.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Must be called from entry point
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | EN(DFN,DGP) ; entry point. Patient DFN is sent from calling routine.
|
|---|
| 13 | ; initialize working variables
|
|---|
| 14 | N RULE,Y,X,FILERR
|
|---|
| 15 | ;
|
|---|
| 16 | ; loop through rules in INCONSISTENT DATA ELEMENTS file.
|
|---|
| 17 | ; execute only the rules where CHECK/DON'T CHECK and INCLUDE IN Z07
|
|---|
| 18 | ; CHECKS fields are turned ON.
|
|---|
| 19 | ;
|
|---|
| 20 | ; ***NOTE loop boundary (401-413) must be changed if rule numbers
|
|---|
| 21 | ; are added ***
|
|---|
| 22 | F RULE=401:1:413 I $D(^DGIN(38.6,RULE)) D
|
|---|
| 23 | . S Y=^DGIN(38.6,RULE,0)
|
|---|
| 24 | . I '$P(Y,U,5),$P(Y,U,6) D @RULE
|
|---|
| 25 | I $D(FILERR) M ^TMP($J,DFN)=FILERR
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | 401 ; RATED INCOMPETENT INVALID
|
|---|
| 29 | S X=$P(DGP("PAT",.29),U,12) I (X'="")&(X'=0)&(X'=1) S FILERR(RULE)=""
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | 402 ; ELIGIBLE FOR MEDICAID INVALID
|
|---|
| 33 | S X=$P(DGP("PAT",.38),U) I (X'="")&(X'=0)&(X'=1) S FILERR(RULE)=""
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | 403 ; DT MEDICAID LAST ASKED INVALID
|
|---|
| 37 | I $P(DGP("PAT",.38),U)=1,$P(DGP("PAT",.38),U,2)<1 S FILERR(RULE)=""
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | 404 ; INELIGIBLE REASON INVALID
|
|---|
| 41 | ; Note: RULE #15 in IVMZ7CR is a duplicate of this rule
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | 405 ; NON VETERAN ELIG CODE INVALID
|
|---|
| 45 | ; Note: RULE #60 in IVMZ7CR is a duplicate of this rule
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | 406 ; CLAIM FOLDER NUMBER INVALID
|
|---|
| 49 | S X=$P(DGP("PAT",.31),U,3)
|
|---|
| 50 | I X'="",$P(DGP("PAT",0),U,9)'=X,(($L(X)>8)!($L(X)<7)) S FILERR(RULE)=""
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | 407 ; ELIGIBILITY STATUS INVALID
|
|---|
| 54 | S X=$P(DGP("PAT",.361),U) I (X'="")&(X'="P")&(X'="R")&(X'="V") S FILERR(RULE)=""
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | 408 ; DECLINE TO GIVE INCOME INVALID
|
|---|
| 58 | ; This CC removed per customer 05/08/2006 -- BAJ
|
|---|
| 59 | ; I $D(DGP("MEANS",0)),$P(DGP("MEANS",0),U,4)<1,$P(DGP("MEANS",0),U,14)'=1 S FILERR(RULE)=""
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | 409 ; AGREE TO PAY DEDUCT INVALID
|
|---|
| 63 | ; 2 PENDING ADJUDICATION MEANS TEST
|
|---|
| 64 | ; 6 MT COPAY REQUIRED MEANS TEST
|
|---|
| 65 | ;16 GMT COPAY REQUIRED MEANS TEST
|
|---|
| 66 | I $D(DGP("MEANS",0)),$P(DGP("MEANS",0),U,11)="" D
|
|---|
| 67 | . S X=$P(DGP("MEANS",0),U,3)
|
|---|
| 68 | . I (X=2)!(X=6) S FILERR(RULE)="" Q
|
|---|
| 69 | . I X=16,'$P(DGP("MEANS",0),U,20) S FILERR(RULE)=""
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | 410 ; Note: RULE #404 above is a duplicate of this rule
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | 411 ; ENROLLMENT APP DATE INVALID
|
|---|
| 76 | I $D(DGP("ENR",0)) S X=$P(DGP("ENR","0"),U) I ($E(X,1,3)<1)!($E(X,4,5)<1)!($E(X,6,7)<1) S FILERR(RULE)=""
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | 412 ; POS/ELIG CODE INVALID
|
|---|
| 80 | ; Note: RULE #24 in IVMZ7CR is a duplicate of this rule
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | 413 ; POS INVALID
|
|---|
| 84 | ; Note: RULE #13 in IVMZ7CR is a duplicate of this rule
|
|---|
| 85 | Q
|
|---|
