DGPTAE01 ;ALB/MTC,HIOFO/FT - Miss. Austin Edit Checks ;11/13/14 2:22pm
;;5.3;Registration;**58,342,466,664,867,884**;Aug 13, 1993;Build 31
;
;no external references
;
INC ; VERIFY INCOME DATA
I DGPTINC'?." "1.6N." " S DGPTERC=120
Q
;
STATE ;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 ;zip code
Q:$$FOR^DGADDUTL(DGPTCTRY)>0
I DGPTZIP'?5N&(DGPTZIP'="XXXXX") S DGPTERC=118 Q
Q
;
CNTY ;county
Q:$$FOR^DGADDUTL(DGPTCTRY)>0
I DGPTCTY'?1.3N S DGPTERC=117 Q
Q
;
AGO ;agent orange
I " 12345"'[DGPTEXA S DGPTERC=115 Q
I "35"[DGPTEXA&(DGPTPOS2'=7) S DGPTERC=133 Q
Q
IRAD ;ionizing radiation
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>124 S DGPTERC=113 Q ;BL;NEWBORN CLAIMS DG*5.3*867;Removed check for age less than 1 year
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 ;check for invalid means test indicator
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 ;patient's first initial
I DGPTFI=" "&($E(DGPTSSN,1)=0) G MI
I $P(DGPTALF,U,$E(DGPTSSN,1))'[DGPTFI S DGPTERC=130 G PSEQ
MI ;patient's middle initial
I DGPTMI=" "&($E(DGPTSSN,2)=0) G LN
I $P(DGPTALF,U,$E(DGPTSSN,2))'[DGPTMI S DGPTERC=130 G PSEQ
LN ;patient's last name
I $P(DGPTALF,U,$E(DGPTSSN,3))'[$E(DGPTLN,1) S DGPTERC=130 G PSEQ
COMP ;check pseudo ssn, name and dob for consistency
I $E(DGPTDOB,1,4)_$E(DGPTDOB,7,8)'=$E(DGPTSSN,4,9) S DGPTERC=130
Q
PSEQ ;
K DGPTALF
Q
MST ;military sexual trauma
I "YNDU "'[DGPTMST S ERR=152
Q
CV ;combat veteran
I "12 "'[DGPTCOMVET S ERR=155
Q
CVDATE ;combat veteran date
N X,Y
Q:DGPTCOMVETDT?6" "
S X=DGPTCOMVETDT,%DT="X" D ^%DT I Y<0 S DGPTERC=154
Q
SHAD ;shipboard hazard and defense
I "10 "'[DGPTSHAD S ERR=156
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTAE01 2977 printed Apr 09, 2024@21:52 Page 2
DGPTAE01 ;ALB/MTC,HIOFO/FT - Miss. Austin Edit Checks ;11/13/14 2:22pm
+1 ;;5.3;Registration;**58,342,466,664,867,884**;Aug 13, 1993;Build 31
+2 ;
+3 ;no external references
+4 ;
INC ; VERIFY INCOME DATA
+1 IF DGPTINC'?." "1.6N." "
SET DGPTERC=120
+2 QUIT
+3 ;
STATE ;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 ;zip code
+1 if $$FOR^DGADDUTL(DGPTCTRY)>0
QUIT
+2 IF DGPTZIP'?5N&(DGPTZIP'="XXXXX")
SET DGPTERC=118
QUIT
+3 QUIT
+4 ;
CNTY ;county
+1 if $$FOR^DGADDUTL(DGPTCTRY)>0
QUIT
+2 IF DGPTCTY'?1.3N
SET DGPTERC=117
QUIT
+3 QUIT
+4 ;
AGO ;agent orange
+1 IF " 12345"'[DGPTEXA
SET DGPTERC=115
QUIT
+2 IF "35"[DGPTEXA&(DGPTPOS2'=7)
SET DGPTERC=133
QUIT
+3 QUIT
IRAD ;ionizing radiation
+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 ;BL;NEWBORN CLAIMS DG*5.3*867;Removed check for age less than 1 year
SET DGPTAGE=X\365
IF 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 ;check for invalid means test indicator
+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 ;patient's first initial
+1 IF DGPTFI=" "&($EXTRACT(DGPTSSN,1)=0)
GOTO MI
+2 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,1))'[DGPTFI
SET DGPTERC=130
GOTO PSEQ
MI ;patient's middle initial
+1 IF DGPTMI=" "&($EXTRACT(DGPTSSN,2)=0)
GOTO LN
+2 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,2))'[DGPTMI
SET DGPTERC=130
GOTO PSEQ
LN ;patient's last name
+1 IF $PIECE(DGPTALF,U,$EXTRACT(DGPTSSN,3))'[$EXTRACT(DGPTLN,1)
SET DGPTERC=130
GOTO PSEQ
COMP ;check pseudo ssn, name and dob for consistency
+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
MST ;military sexual trauma
+1 IF "YNDU "'[DGPTMST
SET ERR=152
+2 QUIT
CV ;combat veteran
+1 IF "12 "'[DGPTCOMVET
SET ERR=155
+2 QUIT
CVDATE ;combat veteran date
+1 NEW X,Y
+2 if DGPTCOMVETDT?6" "
QUIT
+3 SET X=DGPTCOMVETDT
SET %DT="X"
DO ^%DT
IF Y<0
SET DGPTERC=154
+4 QUIT
SHAD ;shipboard hazard and defense
+1 IF "10 "'[DGPTSHAD
SET ERR=156
+2 QUIT
