DGPT401 ;ALB/MTC - 401/402/403 Edits ; 16 NOV 92
;;5.3;Registration;**164,729,1015**;Aug 13, 1993;Build 21
;
;Edits for 401/402/403 transmission
EN ;
N ERROR
S (DGPTEDFL,DGPTERC)=0,DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ),DGPTERC=0
S:$E(DGPTSTR,37,40)="2400" DGPTSTR=$E(DGPTSTR,1,36)_"2359"_$E(DGPTSTR,41,125)
SET ;
S DGPTSDT=$E(DGPTSTR,31,40)
S DGPTSSC=$E(DGPTSTR,41,42),DGPTSCS=$E(DGPTSTR,43),DGPTSFA=$E(DGPTSTR,44),DGPTSAT=$E(DGPTSTR,45),DGPTSSP=$E(DGPTSTR,46),DGPTSO1=$E(DGPTSTR,47,53),DGPTSO2=$E(DGPTSTR,54,60)
S DGPTSO3=$E(DGPTSTR,61,67),DGPTSO4=$E(DGPTSTR,68,74),DGPTSO5=$E(DGPTSTR,75,81),DGPTXX=$E(DGPTSTR,82,90)
S DGPT40PT=$E(DGPTSTR,91)
DATE ;
S DGPTSDT=$E(DGPTSTR,31,40),(X,DGPTSDD)=$$FMDT^DGPT101($E(DGPTSDT,1,6))_"."_$E(DGPTSDT,7,10) S %DT="XT" D ^%DT K %DT I Y<0 S DGPTERC=405 D ERR G:DGPTEDFL EXIT
I (DGPTSDD<DGPTDTS)!(DGPTSDD>DGPTDDS) S DGPTERC=437 D ERR G:DGPTEDFL EXIT
I (DGPTSDD>DGPTDDS) S DGPTERC=440 D ERR G:DGPTEDFL EXIT
D DD^%DT S DGPTSDT=$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 DGPTSDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=450 D ERR G:DGPTEDFL EXIT
I ($P(DGPTSDD,".",2)="0000")!($P(DGPTDTS,".",2)="0000")!($P(DGPTDDS,".",2)="0000") S DGPTERC=$S(+DGPTSDD<+DGPTDTS:437,+DGPTSDD>+DGPTDDS:440,1:0)
SPEC ;
I ((DGPTSSC>63)!(DGPTSSC<48))&((DGPTSSC'=65)&(DGPTSSC'=78)&(DGPTSSC'=97)) S DGPTERC=406 D ERR G:DGPTEDFL EXIT
CHFS ;
S DGPTERC=0 D CHIEF^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
FAST ;
S DGPTERC=0 D FAST^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
ANES ;
S DGPTERC=0 D ANES^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
SRP ;
N I,FLAG
I "12 "'[DGPTSSP S DGPTERC=410 D ERR G:DGPTEDFL EXIT
S FLAG=0 F I=20:1:26 I DGPTSTTY[U_I_U S FLAG=1 Q
G:FLAG OPCD
I "12"[DGPTSSP S DGPTERC=410 F I=10,11,30,40,42 I DGPTSTTY[U_I_U S FLAG=1,DGPTERC=0 Q
I FLAG D ERR G:DGPTEDFL EXIT
OPCD ;
S DGPTERC=0 D FIRST^DGPTAE04 G:DGPTEDFL EXIT
TRANS ; Transplant status
I DGPTDDS'<2911001 G GOOD
S DGPTERC=0 D TRAN^DGPTAE04 I DGPTERC D ERR G:DGPTEDFL EXIT
GOOD ;
W:'$D(ERROR) "."
EXIT ;
K DGPTSDT,DGPTSSC,DGPTSCS,DGPTSFA,DGPTSAT,DGPTSSP,DGPTSO1,DGPTSO2,DGPTSO3,DGPTSO4,DGPTSO5,DGPTXX,DGPTSTR
K DGPTSDD,DGPT40PT
Q
ERR ;
D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
S ERROR=1
Q
;
DGPT401 ;ALB/MTC - 401/402/403 Edits ; 16 NOV 92
+1 ;;5.3;Registration;**164,729,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;Edits for 401/402/403 transmission
EN ;
+1 NEW ERROR
+2 SET (DGPTEDFL,DGPTERC)=0
SET DGPTSTR=^TMP("AEDIT",$JOB,NODE,SEQ)
SET DGPTERC=0
+3 IF $EXTRACT(DGPTSTR,37,40)="2400"
SET DGPTSTR=$EXTRACT(DGPTSTR,1,36)_"2359"_$EXTRACT(DGPTSTR,41,125)
SET ;
+1 SET DGPTSDT=$EXTRACT(DGPTSTR,31,40)
+2 SET DGPTSSC=$EXTRACT(DGPTSTR,41,42)
SET DGPTSCS=$EXTRACT(DGPTSTR,43)
SET DGPTSFA=$EXTRACT(DGPTSTR,44)
SET DGPTSAT=$EXTRACT(DGPTSTR,45)
SET DGPTSSP=$EXTRACT(DGPTSTR,46)
SET DGPTSO1=$EXTRACT(DGPTSTR,47,53)
SET DGPTSO2=$EXTRACT(DGPTSTR,54,60)
+3 SET DGPTSO3=$EXTRACT(DGPTSTR,61,67)
SET DGPTSO4=$EXTRACT(DGPTSTR,68,74)
SET DGPTSO5=$EXTRACT(DGPTSTR,75,81)
SET DGPTXX=$EXTRACT(DGPTSTR,82,90)
+4 SET DGPT40PT=$EXTRACT(DGPTSTR,91)
DATE ;
+1 SET DGPTSDT=$EXTRACT(DGPTSTR,31,40)
SET (X,DGPTSDD)=$$FMDT^DGPT101($EXTRACT(DGPTSDT,1,6))_"."_$EXTRACT(DGPTSDT,7,10)
SET %DT="XT"
DO ^%DT
KILL %DT
IF Y<0
SET DGPTERC=405
DO ERR
IF DGPTEDFL
GOTO EXIT
+2 IF (DGPTSDD<DGPTDTS)!(DGPTSDD>DGPTDDS)
SET DGPTERC=437
DO ERR
IF DGPTEDFL
GOTO EXIT
+3 IF (DGPTSDD>DGPTDDS)
SET DGPTERC=440
DO ERR
IF DGPTEDFL
GOTO EXIT
+4 DO DD^%DT
SET DGPTSDT=$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")
+5 IF DGPTSDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N
SET DGPTERC=450
DO ERR
IF DGPTEDFL
GOTO EXIT
+6 IF ($PIECE(DGPTSDD,".",2)="0000")!($PIECE(DGPTDTS,".",2)="0000")!($PIECE(DGPTDDS,".",2)="0000")
SET DGPTERC=$SELECT(+DGPTSDD<+DGPTDTS:437,+DGPTSDD>+DGPTDDS:440,1:0)
SPEC ;
+1 IF ((DGPTSSC>63)!(DGPTSSC<48))&((DGPTSSC'=65)&(DGPTSSC'=78)&(DGPTSSC'=97))
SET DGPTERC=406
DO ERR
IF DGPTEDFL
GOTO EXIT
CHFS ;
+1 SET DGPTERC=0
DO CHIEF^DGPTAE04
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
FAST ;
+1 SET DGPTERC=0
DO FAST^DGPTAE04
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
ANES ;
+1 SET DGPTERC=0
DO ANES^DGPTAE04
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
SRP ;
+1 NEW I,FLAG
+2 IF "12 "'[DGPTSSP
SET DGPTERC=410
DO ERR
IF DGPTEDFL
GOTO EXIT
+3 SET FLAG=0
FOR I=20:1:26
IF DGPTSTTY[U_I_U
SET FLAG=1
QUIT
+4 IF FLAG
GOTO OPCD
+5 IF "12"[DGPTSSP
SET DGPTERC=410
FOR I=10,11,30,40,42
IF DGPTSTTY[U_I_U
SET FLAG=1
SET DGPTERC=0
QUIT
+6 IF FLAG
DO ERR
IF DGPTEDFL
GOTO EXIT
OPCD ;
+1 SET DGPTERC=0
DO FIRST^DGPTAE04
IF DGPTEDFL
GOTO EXIT
TRANS ; Transplant status
+1 IF DGPTDDS'<2911001
GOTO GOOD
+2 SET DGPTERC=0
DO TRAN^DGPTAE04
IF DGPTERC
DO ERR
IF DGPTEDFL
GOTO EXIT
GOOD ;
+1 IF '$DATA(ERROR)
WRITE "."
EXIT ;
+1 KILL DGPTSDT,DGPTSSC,DGPTSCS,DGPTSFA,DGPTSAT,DGPTSSP,DGPTSO1,DGPTSO2,DGPTSO3,DGPTSO4,DGPTSO5,DGPTXX,DGPTSTR
+2 KILL DGPTSDD,DGPT40PT
+3 QUIT
ERR ;
+1 DO WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
+2 SET ERROR=1
+3 QUIT
+4 ;
