DGPT501 ;ALB/MTC - Set up process 501 transmission ; 8/27/03 10:05am
 ;;5.3;Registration;**64,164,529,729**;Aug 13, 1993;Build 59
 ;
EN ;
 N ERROR
 S DGPTEDFL=0
PARSE ; Set up record string, parse record
 S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
 D SET^DGPT501P
DATE ;
 S DGPTMDT=$E(DGPTSTR,31,40),(X,DGPTMDTS)=$$FMDT^DGPT101($E(DGPTMDT,1,6))_"."_$E(DGPTMDT,7,10) S %DT="XT" D ^%DT K %DT I Y<0 S DGPTERC=505 D ERR G:DGPTEDFL EXIT G ELAPS
 D DD^%DT S DGPTMDT=$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")
 I DGPTMDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=505 D ERR G:DGPTEDFL EXIT G TSPEC
 I DGPTMDTS<DGPTDTS S DGPTERC=537 D ERR G:DGPTEDFL EXIT
 I DGPTMDTS>DGPTDDS S DGPTERC=540 D ERR G:DGPTEDFL EXIT
ELAPS ;
 S DGPTERC=0 S X1=DGPTMDTS D 501^DGPTAE03 I DGPTERC D ERR G:DGPTEDFL EXIT
TSPEC ;
 N DGPTMSC1
 I DGPTMSC'?2AN S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LEAV
 S DGPTSP1=$E(DGPTMSC,1),DGPTSP2=$E(DGPTMSC,2),DGPTERC=0
 D CHECK^DGPTAE02 I DGPTERC S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LEAV
 ;-- Active treating specialty edit check
 I $E(DGPTMSC,1)=0!($E(DGPTMSC,1)=" ") S DGPTMSC=$E(DGPTMSC,2)
 ; DGPTMSC  := ptf code (alpha-numeric) value (file:42.4,field:7)
 ; DGPTMSC1 := dinum value (ien, file:42.4,field:001)
 S DGPTMSC1=+$O(^DIC(42.4,"C",DGPTMSC,0))
 ;-- If not active treat spec, set flag to print error msg during
 ;-- PTF close-out error display at WRER^DGPTAEE
 I '$$ACTIVE^DGACT(42.4,DGPTMSC1,DGPTMDTS) S DGPTERC=506,DGPTSER(DGPTMDTS_501)=1 D ERR G:DGPTEDFL EXIT
LEAV ;
 I DGPTMPD'?1.3N S DGPTERC=508 D ERR G:DGPTEDFL EXIT
SPINL ;
 D SP^DGPTAE03 I DGPTERC D ERR G:DGPTEDFL EXIT
LOCCDR ;
 I DGPTMLR'?6N S DGPTERC=575 D ERR G:DGPTEDFL EXIT G LOCTRS
 ;
LOCTRS ;
 I DGPTMLC'?2AN&(DGPTMLC'="  ") S DGPTERC=576 D ERR G:DGPTEDFL EXIT G DIAG
 I DGPTMLC="  "&(DGPTMLR="000000") G DIAG
 S DGPTSP1=$E(DGPTMLC,1),DGPTSP2=$E(DGPTMLC,2),DGPTERC=0
 D CHECK^DGPTAE02 I DGPTERC S DGPTERC=576 D ERR G:DGPTEDFL EXIT
DIAG ;
 D ^DGPT50DI G:DGPTEDFL EXIT
BSTAT ;
 I "12345 "'[DGPTMBS S DGPTERC=515 D ERR G:DGPTEDFL EXIT
FY92 ;
 I DGPTDDS<2911001 G GOOD
LEG ; Legionnaires disease
 S DGPTERC=0 D LEG^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
SUI ; Suicide indicator
 S DGPTERC=0 D SUI^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
DRUG ; Drug indicator
 S DGPTERC=0 D DRUG^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
AXES ;Axis 4 and 5
 I '$P($G(^DIC(42.4,+DGPTMSC1,0)),U,4) S (DGPTMXIV,DGPTMXV1,DGPTMXV2)=" " G SERVC
 S DGPTERC=0 D AXIV^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
 S DGPTERC=0 D AXV1^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
 S DGPTERC=0 D AXV2^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
SERVC ; Service connected indicator
 S DGPTERC=0 D SRVC^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
GOOD ;
 W:'$D(ERROR) "."
EXIT ;
 K DGPTMD1,DGPTMD2,DGPTMD3,DGPTMD4,DGPTMD5,DGPTMDT,DGPTMDTS,DGPTMLC,DGPTMLD,DGPTMLR,DGPTMPD,DGPTMSC,DGPTMSI,DGPTMSR,DGPTMXX,DGPTSTR,DGPTS,DGPTSP1,DGPTSP2
 K DGPTMLG,DGPTMSU,DGPTMDG,DGPTMXIV,DGPTMXV1,DGPTMXV2,DGPT50SR,DGPTMBS
 Q
ERR ;
 D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
 S ERROR=1
 Q