- 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 ;
