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