- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMZ7CD.m
r613 r623 1 IVMZ7CD ;CKN,BAJ,ERC- HL7 Z07 CONSISTENCY CHECKER -- DEMOGRAPHIC SUBROUTINE ; 9/27/20062 ;;2.0;INCOME VERIFICATION MATCH;**105,127**;JUL 8,1996;Build 6 3 4 5 6 7 8 9 10 11 12 13 EN(DFN,DGP,DGSD) 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 301 36 37 38 39 40 41 42 43 302 44 45 46 47 48 49 50 51 303 52 53 54 55 56 57 58 304 59 60 61 62 63 64 65 66 305 67 68 69 70 71 306 ; VALID SSN/PSEUDO SSN REQUIRED, turned off with DG*5.3*77172 73 74 75 76 77 78 79 80 81 82 83 84 85 307 ; PSEUDO SSN REASON REQUIRED, turned off with DG*5.3*77186 87 88 89 90 91 92 93 94 308 95 96 97 98 99 309 100 101 102 103 104 105 106 107 108 109 110 111 112 310 113 114 115 116 117 118 311 119 120 121 122 123 124 312 125 126 127 128 1 IVMZ7CD ;CKN,BAJ - HL7 Z07 CONSISTENCY CHECKER -- DEMOGRAPHIC SUBROUTINE ; 9/27/2006 2 ;;2.0;INCOME VERIFICATION MATCH;**105**;JUL 8,1996;Build 2 3 ; 4 ; Demographic Consistency Checks 5 ; This routine will be called from driver routine and it checks the 6 ; various elements of Person demographic information prior to 7 ; building a Z07 record. Any test which fails consistency check will 8 ; be saved in file 38.6 INCONSISTENT DATA ELEMENT record for Person. 9 ; 10 ;It is all facade 11 Q 12 ; 13 EN(DFN,DGP,DGSD) ;Entry point 14 ; input: DFN - Patient IEN 15 ; DGP - Patient data array 16 ; DGSD - Spouse and Dependent data array 17 ; output: ^TMP($J,DFN,RULE) global 18 ; DFN - Patient IEN 19 ; RULE - Consistency rule # 20 ;initializing variables 21 N RULE,Y,X,FILERR 22 ; 23 ; loop through rules in INCONSISTENT DATA ELEMENTS file. 24 ; execute only the rules where CHECK/DON'T CHECK and INCLUDE IN Z07 25 ; CHECKS fields are turned ON. 26 ; 27 ; ***NOTE loop boundary (301-311) must be changed if rule numbers 28 ; are added *** 29 F RULE=301:1:312 I $D(^DGIN(38.6,RULE)) D 30 . S Y=^DGIN(38.6,RULE,0) 31 . I '$P(Y,"^",5),$P(Y,"^",6) D @RULE 32 I $D(FILERR) M ^TMP($J,DFN)=FILERR 33 Q 34 ; 35 301 ; PERSON LASTNAME REQUIRED 36 S X=$P($G(DGP("NAME",1)),U) I X="" S FILERR(RULE)="" 37 I '$D(DGSD("DEP")) Q 38 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 39 . S X=$P(DGSD("DEP",RIEN,0),U) 40 . S X=$P(X,",") I X="" S FILERR(RULE)="" 41 Q 42 ; 43 302 ; DATE OF BIRTH REQUIRED - Duplicate with #4 44 Q ;This tag needs to be removed after its placement in IVMZ7CR 45 S X=$P($G(DGP("PAT",0)),U,3) I X="" S FILERR(RULE)="" 46 I '$D(DGSD("DEP")) Q 47 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 48 . S X=$P(DGSD("DEP",RIEN,0),U,3) I X="" S FILERR(RULE)="" 49 Q 50 ; 51 303 ; GENDER REQUIRED 52 S X=$P($G(DGP("PAT",0)),U,2) I X="" S FILERR(RULE)="" 53 I '$D(DGSD("DEP")) Q 54 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 55 . S X=$P(DGSD("DEP",RIEN,0),U,2) I X="" S FILERR(RULE)="" 56 Q 57 ; 58 304 ; GENDER INVALID 59 S X=$P($G(DGP("PAT",0)),U,2) I X]"",X'="M",X'="F" S FILERR(RULE)="" 60 I '$D(DGSD("DEP")) Q 61 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 62 . S X=$P(DGSD("DEP",RIEN,0),U,2) 63 . I X]"",X'="M",X'="F" S FILERR(RULE)="" 64 Q 65 ; 66 305 ; VETERAN SSN MISSING - Duplicate with #7 67 Q ;This tag needs to be removed after its placement in IVMZ7CR 68 S X=$P($G(DGP("PAT",0)),U,9) I X="" S FILERR(RULE)="" 69 Q 70 ; 71 306 ; VALID SSN/PSEUDO SSN REQUIRED 72 N Z 73 S X=$P($G(DGP("PAT",0)),U,9) 74 Q:X="" ;quit if no SSN 75 Q:$E(X,$L(X))="P" ;quit if SSN is a Pseudo 76 I $E(X,1,5)="00000" S FILERR(RULE)="" ;First 5 number are zero 77 S $P(Z,$E(X),9)=$E(X) I X=Z S FILERR(RULE)="" ;all numbers are same 78 I $E(X,1,3)="000" S FILERR(RULE)="" ;First 3 digits are zeros 79 I $E(X,4,5)="00" S FILERR(RULE)="" ;4th & 5th are zeros 80 I $E(X,6,9)="0000" S FILERR(RULE)="" ;Last 4 digits are zeros 81 I X=123456789 S FILERR(RULE)="" ;SSN is 123456789 82 I X>728999999 S FILERR(RULE)="" ;SSN is greater than 728999999 83 Q 84 ; 85 307 ; PSEUDO SSN REASON REQUIRED 86 S X=$P($G(DGP("PAT",0)),U,9) 87 I X]"",X["P",$P($G(DGP("PAT","SSN")),U)="" S FILERR(RULE)="" 88 I '$D(DGSD("DEP")) Q 89 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 90 . S X=$P(DGSD("DEP",RIEN,0),U,9) 91 . I X]"",X["P",$P(DGSD("DEP",RIEN,0),U,10)="" S FILERR(RULE)="" 92 Q 93 ; 94 308 ; DATE OF DEATH BEFORE DOB 95 S X=$P($G(DGP("PAT",.35)),U) I X']"" Q 96 I X<$P($G(DGP("PAT",0)),U,3) S FILERR(RULE)="" 97 Q 98 ; 99 309 ; PATIENT RELATIONSHIP INVALID 100 N DEPSEX,RELSEX,DEPREL 101 I '$D(DGSD("DEP")) Q 102 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 103 . S DEPREL=$G(DGSD("DEP",RIEN)) 104 . I DEPREL="" S FILERR(RULE)="" Q 105 . I '$D(^DG(408.11,DEPREL)) S FILERR(RULE)="" Q 106 . S DEPSEX=$P(DGSD("DEP",RIEN,0),U,2) 107 . S RELSEX=$P(^DG(408.11,DEPREL,0),U,3) 108 . I RELSEX="E" Q ;Gender for relation can be either 109 . I DEPSEX'=RELSEX S FILERR(RULE)="" 110 Q 111 ; 112 310 ; DEPENDENT EFF. DATE REQUIRED 113 I '$D(DGSD("DEP")) Q 114 S RIEN=0 F S RIEN=$O(DGSD("DEP",RIEN)) Q:RIEN="" D 115 . S X=$G(DGSD("DEP",RIEN,"EFF")) I 'X S FILERR(RULE)="" 116 Q 117 ; 118 311 ; DATE OF DEATH IS FUTURE DATE - Duplicate with #16 119 Q ;This tag needs to be removed after its placement in IVMZ7CR 120 S X=$P($G(DGP("PAT",.35)),U) 121 I X]"",X>$$NOW^XLFDT() S FILERR(RULE)="" 122 Q 123 ; 124 312 ; PERSON MUST HAVE NATIONAL ICN 125 I $$GETICN^MPIF001(DFN)<0 S FILERR(RULE)="" Q ;No ICN 126 I $$IFLOCAL^MPIF001(DFN)=1 S FILERR(RULE)="" ;Not National ICN 127 Q 128 ;
Note:
See TracChangeset
for help on using the changeset viewer.
