DGPTAE01 ;ALB/MTC - Miss. Austin Edit Checks ; 13 NOV 92
;;5.3;PIMS;**58,342,466,1015,1016**;JUN 30, 2012;Build 20
;
INC ; VERIFY INCOME DATA
I DGPTINC'?." "1.6N." " S DGPTERC=120
Q
;
STATE ;
Q:$$FOR^DGADDUTL(DGPTCTRY)>0
Q:DGPTSTE["X"
S DGPTSTE=+DGPTSTE I DGPTSTE="" S DGPTERC=117 Q
I DGPTSTE'?1.2N S DGPTERC=117 Q
Q
;
ZIP ;
Q:$$FOR^DGADDUTL(DGPTCTRY)>0
I DGPTZIP'?5N&(DGPTZIP'="XXXXX") S DGPTERC=118 Q
Q
;
CNTY ;
Q:$$FOR^DGADDUTL(DGPTCTRY)>0
I DGPTCTY'?1.3N S DGPTERC=117 Q
Q
;
AGO ;
I " 12345"'[DGPTEXA S DGPTERC=115 Q
I "35"[DGPTEXA&(DGPTPOS2'=7) S DGPTERC=133 Q
Q
IRAD ;
I "024578"'[DGPTPOS2&(DGPTEXI'=" ") S DGPTEXI=" " Q
I "024578"[DGPTPOS2&("1234 "'[DGPTEXI) S DGPTERC=116 Q
I DGPTPOS2="Z"&((DGPTEXI=" ")!("1234"'[DGPTEXI)) S DGPTERC=134 Q
Q
;
DB ; DATE OF BIRTH EDITS
;
I $E(DGPTDOB,1,2)="00" S DGPTDOB="01"_$E(DGPTDOB,3,8)
I $E(DGPTDOB,3,4)="00" S DGPTDOB=$E(DGPTDOB,1,2)_"01"_$E(DGPTDOB,5,8)
S DGPTFMDB=($E(DGPTDOB,5,6)-17)_$E(DGPTDOB,7,8)_$E(DGPTDOB,1,4)
S X=DGPTFMDB,%DT="X" D ^%DT I Y<0 S DGPTERC=113 Q
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
I $E(DGPTDOB,5,8)<1857 S DGPTERC=113 Q
S X1=+DGPTDTS,X2=DGPTFMDB D ^%DTC I X<0 S DGPTERC=113 Q
S DGPTAGE=X\365 I (DGPTAGE<1)!(DGPTAGE>124) S DGPTERC=113 Q
DBQ ;
K X,X1,X2,Y
Q
;
MT ; Means test edits and consistency check
;
I DGPTSTTY["^30^" S DGPTMTC=" " Q
D EDIT Q:DGPTERC
D CONSIS Q:DGPTERC
Q
EDIT ;
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
I "ABCGNXU"'[$E(DGPTMTC) S DGPTERC=119 Q
I $E(DGPTMTC,1)="A"&("SN"'[$E(DGPTMTC,2)) S DGPTERC=119 Q
I $E(DGPTMTC,2)=" "&("BCGNXU"'[$E(DGPTMTC)) S DGPTERC=119 Q
Q
CONSIS ;
I DGPTMTC="X "&(+DGPTTY'<2860701) S DGPTERC="119" Q
Q
;
PSE ;-- check for pseudo ssn
S DGPTALF="ABC^DEF^GHI^JKL^MNO^PQR^STU^VWX^YZ^ "
FI ;
I DGPTFI=" "&($E(DGPTSSN,1)=0) G MI
I $P(DGPTALF,U,$E(DGPTSSN,1))'[DGPTFI S DGPTERC=130 G PSEQ
MI ;
I DGPTMI=" "&($E(DGPTSSN,2)=0) G LN
I $P(DGPTALF,U,$E(DGPTSSN,2))'[DGPTMI S DGPTERC=130 G PSEQ
LN ;
I $P(DGPTALF,U,$E(DGPTSSN,3))'[$E(DGPTLN,1) S DGPTERC=130 G PSEQ
COMP ;
I $E(DGPTDOB,1,4)_$E(DGPTDOB,7,8)'=$E(DGPTSSN,4,9) S DGPTERC=130
Q
PSEQ ;
K DGPTALF
Q
DGPTAE01 ;ALB/MTC - Miss. Austin Edit Checks ; 13 NOV 92
+1 ;;5.3;PIMS;**58,342,466,1015,1016**;JUN 30, 2012;Build 20
+2 ;
INC ; VERIFY INCOME DATA
+1 IF DGPTINC'?." "1.6N." "
SET DGPTERC=120
+2 QUIT
+3 ;
STATE ;
+1 IF $$FOR^DGADDUTL(DGPTCTRY)>0
QUIT
+2 IF DGPTSTE["X"
QUIT
+3 SET DGPTSTE=+DGPTSTE
IF DGPTSTE=""
SET DGPTERC=117
QUIT
+4 IF DGPTSTE'?1.2N
SET DGPTERC=117
QUIT
+5 QUIT
+6 ;
ZIP ;
+1 IF $$FOR^DGADDUTL(DGPTCTRY)>0
QUIT
+2 IF DGPTZIP'?5N&(DGPTZIP'="XXXXX")
SET DGPTERC=118
QUIT
+3 QUIT
+4 ;
CNTY ;
+1 IF $$FOR^DGADDUTL(DGPTCTRY)>0
QUIT
+2 IF DGPTCTY'?1.3N
SET DGPTERC=117
QUIT
+3 QUIT
+4 ;
AGO ;
+1 IF " 12345"'[DGPTEXA
SET DGPTERC=115
QUIT
+2 IF "35"[DGPTEXA&(DGPTPOS2'=7)
SET DGPTERC=133
QUIT
+3 QUIT
IRAD ;
+1 IF "024578"'[DGPTPOS2&(DGPTEXI'=" ")
SET DGPTEXI=" "
QUIT
+2 IF "024578"[DGPTPOS2&("1234 "'[DGPTEXI)
SET DGPTERC=116
QUIT
+3 IF DGPTPOS2="Z"&((DGPTEXI=" ")!("1234"'[DGPTEXI))
SET DGPTERC=134
QUIT
+4 QUIT
+5 ;
DB ; DATE OF BIRTH EDITS
+1 ;
+2 IF $EXTRACT(DGPTDOB,1,2)="00"
SET DGPTDOB="01"_$EXTRACT(DGPTDOB,3,8)
+3 IF $EXTRACT(DGPTDOB,3,4)="00"
SET DGPTDOB=$EXTRACT(DGPTDOB,1,2)_"01"_$EXTRACT(DGPTDOB,5,8)
+4 SET DGPTFMDB=($EXTRACT(DGPTDOB,5,6)-17)_$EXTRACT(DGPTDOB,7,8)_$EXTRACT(DGPTDOB,1,4)
+5 SET X=DGPTFMDB
SET %DT="X"
DO ^%DT
IF Y<0
SET DGPTERC=113
QUIT
+6 DO DD^%DT
SET DGPTORBD=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)
IF DGPTORBD'?1.2N1"-"3U1"-"4N
SET DGPTERC=113
QUIT
+7 IF $EXTRACT(DGPTDOB,5,8)<1857
SET DGPTERC=113
QUIT
+8 SET X1=+DGPTDTS
SET X2=DGPTFMDB
DO ^%DTC
IF X<0
SET DGPTERC=113
QUIT
+9 SET DGPTAGE=X\365
IF (DGPTAGE<1)!(DGPTAGE>124)
SET DGPTERC=113
QUIT
DBQ ;
+1 KILL X,X1,X2,Y
+2 QUIT
+3 ;
MT ; Means test edits and consistency check
+1 ;
+2 IF DGPTSTTY["^30^"
SET DGPTMTC=" "
QUIT
+3 DO EDIT
IF DGPTERC
QUIT
+4 DO CONSIS
IF DGPTERC
QUIT
+5 QUIT
EDIT ;
+1 DO NUMACT^DGPTSUF(30)
IF DGANUM>0
FOR I=1:1:DGANUM
IF $EXTRACT(DGPTFAC,4,6)[DGSUFNAM(I)
IF DGPTMTC'="X "
SET DGPTMTC="X "
KILL DGANUM,DGSUFNAM,I
QUIT
+2 IF "ABCGNXU"'[$EXTRACT(DGPTMTC)
SET DGPTERC=119
QUIT
+3 IF $EXTRACT(DGPTMTC,1)="A"&("SN"'[$EXTRACT(DGPTMTC,2))
SET DGPTERC=119
QUIT
+4 IF $EXTRACT(DGPTMTC,2)=" "&("BCGNXU"'[$EXTRACT(DGPTMTC))
SET DGPTERC=119
QUIT
+5 QUIT
CONSIS ;
+1 IF DGPTMTC="X "&(+DGPTTY'<2860701)
SET DGPTERC="119"
QUIT
+2 QUIT
+3 ;
PSE ;-- check for pseudo ssn
+1 SET DGPTALF="ABC^DEF^GHI^JKL^MNO^PQR^STU^VWX^YZ^ "
FI ;
+1 IF DGPTFI=" "&($EXTRACT(DGPTSSN,1)=0)
GOTO MI
+2 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,1))'[DGPTFI
SET DGPTERC=130
GOTO PSEQ
MI ;
+1 IF DGPTMI=" "&($EXTRACT(DGPTSSN,2)=0)
GOTO LN
+2 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,2))'[DGPTMI
SET DGPTERC=130
GOTO PSEQ
LN ;
+1 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,3))'[$EXTRACT(DGPTLN,1)
SET DGPTERC=130
GOTO PSEQ
COMP ;
+1 IF $EXTRACT(DGPTDOB,1,4)_$EXTRACT(DGPTDOB,7,8)'=$EXTRACT(DGPTSSN,4,9)
SET DGPTERC=130
+2 QUIT
PSEQ ;
+1 KILL DGPTALF
+2 QUIT
