source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTAE01.m@ 1306

Last change on this file since 1306 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1DGPTAE01 ;ALB/MTC - Miss. Austin Edit Checks ; 13 NOV 92
2 ;;5.3;Registration;**58,342,466**;Aug 13, 1993
3 ;
4INC ; VERIFY INCOME DATA
5 I DGPTINC'?." "1.6N." " S DGPTERC=120
6 Q
7 ;
8STATE ;
9 Q:DGPTSTE["X"
10 S DGPTSTE=+DGPTSTE I DGPTSTE="" S DGPTERC=117 Q
11 I DGPTSTE'?1.2N S DGPTERC=117 Q
12 Q
13 ;
14ZIP ;
15 I DGPTZIP'?5N&(DGPTZIP'="XXXXX") S DGPTERC=118 Q
16 Q
17 ;
18CNTY ;
19 I DGPTCTY'?1.3N S DGPTERC=117 Q
20 Q
21 ;
22AGO ;
23 I " 12345"'[DGPTEXA S DGPTERC=115 Q
24 I "35"[DGPTEXA&(DGPTPOS2'=7) S DGPTERC=133 Q
25 Q
26IRAD ;
27 I "024578"'[DGPTPOS2&(DGPTEXI'=" ") S DGPTEXI=" " Q
28 I "024578"[DGPTPOS2&("1234 "'[DGPTEXI) S DGPTERC=116 Q
29 I DGPTPOS2="Z"&((DGPTEXI=" ")!("1234"'[DGPTEXI)) S DGPTERC=134 Q
30 Q
31 ;
32DB ; DATE OF BIRTH EDITS
33 ;
34 I $E(DGPTDOB,1,2)="00" S DGPTDOB="01"_$E(DGPTDOB,3,8)
35 I $E(DGPTDOB,3,4)="00" S DGPTDOB=$E(DGPTDOB,1,2)_"01"_$E(DGPTDOB,5,8)
36 S DGPTFMDB=($E(DGPTDOB,5,6)-17)_$E(DGPTDOB,7,8)_$E(DGPTDOB,1,4)
37 S X=DGPTFMDB,%DT="X" D ^%DT I Y<0 S DGPTERC=113 Q
38 D DD^%DT S DGPTORBD=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12) I DGPTORBD'?1.2N1"-"3U1"-"4N S DGPTERC=113 Q
39 I $E(DGPTDOB,5,8)<1857 S DGPTERC=113 Q
40 S X1=+DGPTDTS,X2=DGPTFMDB D ^%DTC I X<0 S DGPTERC=113 Q
41 S DGPTAGE=X\365 I (DGPTAGE<1)!(DGPTAGE>124) S DGPTERC=113 Q
42DBQ ;
43 K X,X1,X2,Y
44 Q
45 ;
46MT ; Means test edits and consistency check
47 ;
48 I DGPTSTTY["^30^" S DGPTMTC=" " Q
49 D EDIT Q:DGPTERC
50 D CONSIS Q:DGPTERC
51 Q
52EDIT ;
53 D NUMACT^DGPTSUF(30) I DGANUM>0 F I=1:1:DGANUM I $E(DGPTFAC,4,6)[DGSUFNAM(I) S:DGPTMTC'="X " DGPTMTC="X " K DGANUM,DGSUFNAM,I Q
54 I "ABCGNXU"'[$E(DGPTMTC) S DGPTERC=119 Q
55 I $E(DGPTMTC,1)="A"&("SN"'[$E(DGPTMTC,2)) S DGPTERC=119 Q
56 I $E(DGPTMTC,2)=" "&("BCGNXU"'[$E(DGPTMTC)) S DGPTERC=119 Q
57 Q
58CONSIS ;
59 I DGPTMTC="X "&(+DGPTTY'<2860701) S DGPTERC="119" Q
60 Q
61 ;
62PSE ;-- check for pseudo ssn
63 S DGPTALF="ABC^DEF^GHI^JKL^MNO^PQR^STU^VWX^YZ^ "
64FI ;
65 I DGPTFI=" "&($E(DGPTSSN,1)=0) G MI
66 I $P(DGPTALF,U,$E(DGPTSSN,1))'[DGPTFI S DGPTERC=130 G PSEQ
67MI ;
68 I DGPTMI=" "&($E(DGPTSSN,2)=0) G LN
69 I $P(DGPTALF,U,$E(DGPTSSN,2))'[DGPTMI S DGPTERC=130 G PSEQ
70LN ;
71 I $P(DGPTALF,U,$E(DGPTSSN,3))'[$E(DGPTLN,1) S DGPTERC=130 G PSEQ
72COMP ;
73 I $E(DGPTDOB,1,4)_$E(DGPTDOB,7,8)'=$E(DGPTSSN,4,9) S DGPTERC=130
74 Q
75PSEQ ;
76 K DGPTALF
77 Q
Note: See TracBrowser for help on using the repository browser.