DGPT101 ;ALB/MTC - 101/701 Austin Edit Checks ; 12 NOV 92
;;5.3;Registration;**8,164,180,247,415,678,696,1015**;Aug 13, 1993;Build 21
;
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 ;
I DGPTPS="P" S DGPTERC=0 D PSE^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
DTE ;
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 ;
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 ;-- may need to add more edits later
D ^DGPT10S1 I DGPTERC D ERR G:DGPTEDFL EXIT
SRP ;
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 ;
I $L(DGPTPOW)'=1!("123456789AB "'[DGPTPOW) S DGPTERC=110 D ERR G:DGPTEDFL EXIT
MAR ;
I "MWDUSN"'[DGPTMRS S DGPTERC=111 D ERR G:DGPTEDFL EXIT
GEN ;
I "FM"'[DGPTGEN S DGPTERC=112 D ERR G:DGPTEDFL EXIT
S DGPTGEN1=$S(DGPTGEN="F":1,1:0)
DOB ;
S DGPTERC=0 D DB^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
POS ;
S DGPTERC=0 D ^DGPT10CB I DGPTERC D ERR G:DGPTEDFL EXIT
EXP ;
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 ;
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 ;
S DGPTERC=0 D MT^DGPTAE01 I DGPTERC D ERR G:DGPTEDFL EXIT
ERI ;
S DGPTERC=0 I ("^K^"'[(U_DGPTERI_U))&(DGPTERI'=" ") S DGPTERC=125 D ERR G:DGPTEDFL EXIT
INCOM ;
I DGPTDDS<2911001 G GOOD
S DGPTERC=0 D INC^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
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
DGPT101 ;ALB/MTC - 101/701 Austin Edit Checks ; 12 NOV 92
+1 ;;5.3;Registration;**8,164,180,247,415,678,696,1015**;Aug 13, 1993;Build 21
+2 ;
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 ;
+1 IF DGPTPS="P"
SET DGPTERC=0
DO PSE^DGPTAE01
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
DTE ;
+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 ;
+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 ;-- may need to add more edits later
+1 DO ^DGPT10S1
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
SRP ;
+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 ;
+1 IF $LENGTH(DGPTPOW)'=1!("123456789AB "'[DGPTPOW)
SET DGPTERC=110
DO ERR
IF DGPTEDFL
GOTO EXIT
MAR ;
+1 IF "MWDUSN"'[DGPTMRS
SET DGPTERC=111
DO ERR
IF DGPTEDFL
GOTO EXIT
GEN ;
+1 IF "FM"'[DGPTGEN
SET DGPTERC=112
DO ERR
IF DGPTEDFL
GOTO EXIT
+2 SET DGPTGEN1=$SELECT(DGPTGEN="F":1,1:0)
DOB ;
+1 SET DGPTERC=0
DO DB^DGPTAE01
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
POS ;
+1 SET DGPTERC=0
DO ^DGPT10CB
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
EXP ;
+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 ;
+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 ;
+1 SET DGPTERC=0
DO MT^DGPTAE01
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
ERI ;
+1 SET DGPTERC=0
IF ("^K^"'[(U_DGPTERI_U))&(DGPTERI'=" ")
SET DGPTERC=125
DO ERR
IF DGPTEDFL
GOTO EXIT
INCOM ;
+1 IF DGPTDDS<2911001
GOTO GOOD
+2 SET DGPTERC=0
DO INC^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
+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
