- 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 Jan 18, 2025@03:51:54 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