DGPT101 ;ALB/MTC,HIOFO/FT - 101/701 Austin Edit Checks ;2/2/15 10:40am
;;5.3;Registration;**8,164,180,247,415,678,696,884**;Aug 13, 1993;Build 31
;
;no external references
;
EN ;
S (DGPTFEF,DGPTERC)=0
101 ;-- process 101+701 data
N ERROR
;
PARSE ;Set up record string, Call routine to parse record
S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
D SET^DGPT101P
D NOW^%DTC S DGPTTY=(17+$E(X,1))_$E(X,2,3)
701 ;PROCESS 701
S DGPTAL7=$O(^TMP("AEDIT",$J,"N701",SEQ)) I DGPTAL7="" S DGPTFEF=1 Q
D SET^DGPT701 I DGPTFEF Q
SET ; Start error piece, flags
S DGPTEDFL=0,DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
SSN ; Start edits
I DGPTSSN'?9N!((DGPTPS=" ")&("9"[$E(DGPTSSN))) S DGPTERC=102 D ERR G:DGPTEDFL EXIT
I " P"'[DGPTPS S DGPTERC=101 D ERR G:DGPTEDFL EXIT
S DGPTPS=$S(DGPTPS="P":DGPTPS,1:"A")
PSEU ;check for pseudo ssn
I DGPTPS="P" S DGPTERC=0 D PSE^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
DTE ;admission date
S X=DGPTDTS,%DT="XT" D ^%DT I Y<0 S DGPTERC=103 D ERR G:DGPTEDFL EXIT
I Y>0 D DD^%DT S DGPTADT=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)_" "_$S($P(Y,"@",2)]"":$E($P(Y,"@",2),1,5),1:"00:00")
S X1=DGPTNOW,X2=$$FMDT($E(DGPTSTR,15,20)) D ^%DTC I X<0 S DGPTERC=140 D ERR G:DGPTEDFL EXIT
S DGPTDTS=$$FMDT($E(DGPTSTR,15,20))_"."_$E(DGPTSTR,21,24)
LN ;patient's last name
I DGPTLN'?1.U." " S DGPTERC=105 D ERR G:DGPTEDFL EXIT
I DGPTFI'?.U&(DGPTFI'=" ")!((DGPTMI'?1U)&(DGPTMI'=" ")) S DGPTERC=106 D ERR G:DGPTEDFL EXIT
SRA ;source of admission -- may need to add more edits later
D ^DGPT10S1 I DGPTERC D ERR G:DGPTEDFL EXIT
SRP ;source of payment
N I
S DGPTERC=0
I " 1234"'[DGPTSRP S DGPTERC=109 D ERR G:DGPTEDFL EXIT G POW
I "1234"[DGPTSRP S DGPTERC=109 F I=20:1:26 I DGPTSTTY[U_I_U S DGPTERC=0 Q
I DGPTERC D ERR G:DGPTEDFL EXIT
POW ;prisoner of war
I $L(DGPTPOW)'=1!("123456789AB "'[DGPTPOW) S DGPTERC=110 D ERR G:DGPTEDFL EXIT
MAR ;marital status
I "MWDUSN"'[DGPTMRS S DGPTERC=111 D ERR G:DGPTEDFL EXIT
GEN ;gender
I "FM"'[DGPTGEN S DGPTERC=112 D ERR G:DGPTEDFL EXIT
S DGPTGEN1=$S(DGPTGEN="F":1,1:0)
DOB ;date of birth
S DGPTERC=0 D DB^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
POS ;period of service
;I DGPTPOS1'=" " S ERR=___ D ERR G:DGPTEDFL EXIT ;not used. should always be a space. ft 11/5/14
S DGPTERC=0 D ^DGPT10CB I DGPTERC D ERR G:DGPTEDFL EXIT
EXP ;agent orange and ionizing radiation
S DGPTERC=0 D AGO^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
S DGPTERC=0 D IRAD^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
HOME ;state, county and zip code
S DGPTERC=0 D STATE^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
S DGPTERC=0 D CNTY^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
S DGPTERC=0 D ZIP^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
MT ;means test
S DGPTERC=0 D MT^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
ERI ;emergency response indicator
S DGPTERC=0 I ("^K^"'[(U_DGPTERI_U))&(DGPTERI'=" ") S DGPTERC=125 D ERR G:DGPTEDFL EXIT
INCOM ;income
I DGPTDDS<2911001 G GOOD
S DGPTERC=0 D INC^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
;the following checks are added with dg*5.3*884 and will be active when icd10 is turned on. ft 11/4/14
MST ;military sexual trauma
I DGPTFMT=3 S DGPTERC=0 D MST^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
CV ;combat veteran
I DGPTFMT=3 S DGPTERC=0 D CV^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
CVDATE ;combat veteran date
I DGPTFMT=3 S DGPTERC=0 D CVDATE^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
SHAD ;shipboard hazard and defense
I DGPTFMT=3 S DGPTERC=0 D SHAD^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
GOOD ;
W:'$D(ERROR) "."
;
EXIT ;
K DGPTREC,DGPTORBD,DGPTLN,DGPTFI,DGPTMI,DGPTMRS,DGPTSTE,DGPTCTY,DGPTZIP,DGPTINC
K DGPTSRA,DGPTTF,DGPTSRP,DGPTPOS1,DGPTEXA,DGPTEXI,DGPTMTC,DGPTDTD,DGPTDSP,DGPTDTY,DGPTDOP,DGPTDVA,DGPTDPD,DGPTDRF,DGPTDAS,DGPTDCP,DGPTDDXE,DGPTDDXO,DGPTDLR,DGPTDLC,DGPTDSC,DGPTDAGE,DGPTDRG,DGPTSTR
K DGPT70LG,DGPT70SU,DGPT70DR,DGPT70X4,DGPTDXV1,DGPTDXV2,DGPTMST,DGPTCOMVET,DGPTCOMVETDT,DGPTSHAD
Q
ERR ;
D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
S ERROR=1
Q
FMDT(X) ; change to fm date for y2k
N Y
D ^%DT
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPT101 4067 printed Apr 09, 2024@22:03:14 Page 2
DGPT101 ;ALB/MTC,HIOFO/FT - 101/701 Austin Edit Checks ;2/2/15 10:40am
+1 ;;5.3;Registration;**8,164,180,247,415,678,696,884**;Aug 13, 1993;Build 31
+2 ;
+3 ;no external references
+4 ;
EN ;
+1 SET (DGPTFEF,DGPTERC)=0
101 ;-- process 101+701 data
+1 NEW ERROR
+2 ;
PARSE ;Set up record string, Call routine to parse record
+1 SET DGPTSTR=^TMP("AEDIT",$JOB,NODE,SEQ)
+2 DO SET^DGPT101P
+3 DO NOW^%DTC
SET DGPTTY=(17+$EXTRACT(X,1))_$EXTRACT(X,2,3)
701 ;PROCESS 701
+1 SET DGPTAL7=$ORDER(^TMP("AEDIT",$JOB,"N701",SEQ))
IF DGPTAL7=""
SET DGPTFEF=1
QUIT
+2 DO SET^DGPT701
IF DGPTFEF
QUIT
SET ; Start error piece, flags
+1 SET DGPTEDFL=0
SET DGPTSTR=^TMP("AEDIT",$JOB,NODE,SEQ)
SSN ; Start edits
+1 IF DGPTSSN'?9N!((DGPTPS=" ")&("9"[$EXTRACT(DGPTSSN)))
SET DGPTERC=102
DO ERR
if DGPTEDFL
GOTO EXIT
+2 IF " P"'[DGPTPS
SET DGPTERC=101
DO ERR
if DGPTEDFL
GOTO EXIT
+3 SET DGPTPS=$SELECT(DGPTPS="P":DGPTPS,1:"A")
PSEU ;check for pseudo ssn
+1 IF DGPTPS="P"
SET DGPTERC=0
DO PSE^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
DTE ;admission date
+1 SET X=DGPTDTS
SET %DT="XT"
DO ^%DT
IF Y<0
SET DGPTERC=103
DO ERR
if DGPTEDFL
GOTO EXIT
+2 IF Y>0
DO DD^%DT
SET DGPTADT=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)_" "_$SELECT($PIECE(Y,"@",2)]"":$EXTRACT($PIECE(Y,"@",2),1,5),1:"00:00")
+3 SET X1=DGPTNOW
SET X2=$$FMDT($EXTRACT(DGPTSTR,15,20))
DO ^%DTC
IF X<0
SET DGPTERC=140
DO ERR
if DGPTEDFL
GOTO EXIT
+4 SET DGPTDTS=$$FMDT($EXTRACT(DGPTSTR,15,20))_"."_$EXTRACT(DGPTSTR,21,24)
LN ;patient's last name
+1 IF DGPTLN'?1.U." "
SET DGPTERC=105
DO ERR
if DGPTEDFL
GOTO EXIT
+2 IF DGPTFI'?.U&(DGPTFI'=" ")!((DGPTMI'?1U)&(DGPTMI'=" "))
SET DGPTERC=106
DO ERR
if DGPTEDFL
GOTO EXIT
SRA ;source of admission -- may need to add more edits later
+1 DO ^DGPT10S1
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
SRP ;source of payment
+1 NEW I
+2 SET DGPTERC=0
+3 IF " 1234"'[DGPTSRP
SET DGPTERC=109
DO ERR
if DGPTEDFL
GOTO EXIT
GOTO POW
+4 IF "1234"[DGPTSRP
SET DGPTERC=109
FOR I=20:1:26
IF DGPTSTTY[U_I_U
SET DGPTERC=0
QUIT
+5 IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
POW ;prisoner of war
+1 IF $LENGTH(DGPTPOW)'=1!("123456789AB "'[DGPTPOW)
SET DGPTERC=110
DO ERR
if DGPTEDFL
GOTO EXIT
MAR ;marital status
+1 IF "MWDUSN"'[DGPTMRS
SET DGPTERC=111
DO ERR
if DGPTEDFL
GOTO EXIT
GEN ;gender
+1 IF "FM"'[DGPTGEN
SET DGPTERC=112
DO ERR
if DGPTEDFL
GOTO EXIT
+2 SET DGPTGEN1=$SELECT(DGPTGEN="F":1,1:0)
DOB ;date of birth
+1 SET DGPTERC=0
DO DB^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
POS ;period of service
+1 ;I DGPTPOS1'=" " S ERR=___ D ERR G:DGPTEDFL EXIT ;not used. should always be a space. ft 11/5/14
+2 SET DGPTERC=0
DO ^DGPT10CB
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
EXP ;agent orange and ionizing radiation
+1 SET DGPTERC=0
DO AGO^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
+2 SET DGPTERC=0
DO IRAD^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
HOME ;state, county and zip code
+1 SET DGPTERC=0
DO STATE^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
+2 SET DGPTERC=0
DO CNTY^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
+3 SET DGPTERC=0
DO ZIP^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
MT ;means test
+1 SET DGPTERC=0
DO MT^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
ERI ;emergency response indicator
+1 SET DGPTERC=0
IF ("^K^"'[(U_DGPTERI_U))&(DGPTERI'=" ")
SET DGPTERC=125
DO ERR
if DGPTEDFL
GOTO EXIT
INCOM ;income
+1 IF DGPTDDS<2911001
GOTO GOOD
+2 SET DGPTERC=0
DO INC^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
+3 ;the following checks are added with dg*5.3*884 and will be active when icd10 is turned on. ft 11/4/14
MST ;military sexual trauma
+1 IF DGPTFMT=3
SET DGPTERC=0
DO MST^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
CV ;combat veteran
+1 IF DGPTFMT=3
SET DGPTERC=0
DO CV^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
CVDATE ;combat veteran date
+1 IF DGPTFMT=3
SET DGPTERC=0
DO CVDATE^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
SHAD ;shipboard hazard and defense
+1 IF DGPTFMT=3
SET DGPTERC=0
DO SHAD^DGPTAE01
IF DGPTERC
DO ERR
if DGPTEDFL
GOTO EXIT
GOOD ;
+1 if '$DATA(ERROR)
WRITE "."
+2 ;
EXIT ;
+1 KILL DGPTREC,DGPTORBD,DGPTLN,DGPTFI,DGPTMI,DGPTMRS,DGPTSTE,DGPTCTY,DGPTZIP,DGPTINC
+2 KILL DGPTSRA,DGPTTF,DGPTSRP,DGPTPOS1,DGPTEXA,DGPTEXI,DGPTMTC,DGPTDTD,DGPTDSP,DGPTDTY,DGPTDOP,DGPTDVA,DGPTDPD,DGPTDRF,DGPTDAS,DGPTDCP,DGPTDDXE,DGPTDDXO,DGPTDLR,DGPTDLC,DGPTDSC,DGPTDAGE,DGPTDRG,DGPTSTR
+3 KILL DGPT70LG,DGPT70SU,DGPT70DR,DGPT70X4,DGPTDXV1,DGPTDXV2,DGPTMST,DGPTCOMVET,DGPTCOMVETDT,DGPTSHAD
+4 QUIT
ERR ;
+1 DO WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
+2 SET ERROR=1
+3 QUIT
FMDT(X) ; change to fm date for y2k
+1 NEW Y
+2 DO ^%DT
+3 QUIT Y
