- DGPTAE04 ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92
- ;;5.3;Registration;**510,744,1015**;Aug 13, 1993;Build 21
- ;;ADL;Updated for CSV Project;;Mar 24, 2003
- ;
- TRAN ;-- verify transplant status
- I " 12"'[DGPT40PT S DGPTERC=417
- Q
- ;
- CHIEF ;
- N FLAG,I
- Q:"VMN"[DGPTSCS
- I "1234567"'[DGPTSCS S DGPTERC=407 Q
- S FLAG=1 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S FLAG=0 Q
- S:FLAG DGPTERC=407
- Q
- FAST ;
- N FLAG,I
- Q:DGPTSFA=" "
- S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSFA=" " Q
- I FLAG Q
- I "12345678"'[DGPTSFA S DGPTERC=408 Q
- Q
- ANES ;
- N FLAG,I
- Q:DGPTSAT=" "
- S FLAG=0 F I=20:1:26 I DGPTSTTY["^"_I_"^" S FLAG=1,DGPTSAT=" " Q
- I FLAG Q
- I "0123456789RX"'[DGPTSAT S DGPTERC=409 Q
- S DGPTERC=409 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
- Q
- ;
- FIRST ;-- Edit surgeries - present in ICD0 OPERATIONS, current, gender ok
- ;
- I (+DGPTSO1=1371)!(+DGPTSO1=39610)!(+DGPTSO1=39611)!(+DGPTSO1=39612) S DGPTERC=450 D ERR G:DGPTEDFL EXIT
- LOOP ;
- F DGPTL3=1:1:5 S DGPTERC=0 D CHKOPC I DGPTERC D ERR G:DGPTEDFL EXIT
- Q
- CHKOPC ;
- S DGPTOC=(@("DGPTSO"_DGPTL3)),DGPTOC=$P(DGPTOC," ",1) Q:DGPTOC=""
- S DGPTERC=410+DGPTL3
- S DGPTOC=$E(DGPTOC_" ",1,2)_"."_$E(DGPTOC,3,7)
- I $D(^ICD0("AB",DGPTOC)) S DGPTERC=0 D GEN Q
- Q
- GEN ;
- S DGPTOPP=$O(^ICD0("AB",DGPTOC,0)) I DGPTOPP="" S DGPTERC=451 Q
- S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT)) ;use date of surgery from rec if it exists, else today
- ; DG*744 - check against discharge date
- ;I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 Q
- I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 N DGPTDAT S DGPTDAT=+$G(^DGPT(PTF,70)) I DGPTDAT S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,DGPTDAT) I $P(DGPTTMP,U,10)=1 S DGPTERC=0
- I DGPTERC=451 Q
- I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=451 Q
- CURR ;
- S DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$S($G(DGPTSDD)'="":DGPTSDD,1:DT)) ;use date of surgery from rec if it exists, else today
- I ($P(DGPTTMP,U,10)=0)&($P(DGPTSDD,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=474+DGPTL3 Q
- SAVE ;
- S @("DGPTSO"_DGPTL3)=DGPTOC
- ARRAY ;
- S DGPTOPAR(DGPTSDD)=$S($D(DGPTOPAR(DGPTSDD)):DGPTOPAR(DGPTSDD)_U_DGPTOPP,1:DGPTOPP_U)
- Q
- EXIT ;
- K DGPTL3,DGPTOC,DGPTOC1,DGPTOPP
- Q
- ERR ;
- D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
- Q
- DGPTAE04 ;ALB/MTC/ADL - 401 Edit Checks Cont ; 13 NOV 92
- +1 ;;5.3;Registration;**510,744,1015**;Aug 13, 1993;Build 21
- +2 ;;ADL;Updated for CSV Project;;Mar 24, 2003
- +3 ;
- TRAN ;-- verify transplant status
- +1 IF " 12"'[DGPT40PT
- SET DGPTERC=417
- +2 QUIT
- +3 ;
- CHIEF ;
- +1 NEW FLAG,I
- +2 IF "VMN"[DGPTSCS
- QUIT
- +3 IF "1234567"'[DGPTSCS
- SET DGPTERC=407
- QUIT
- +4 SET FLAG=1
- FOR I=10,11,30,40,42
- IF DGPTSTTY["^"_I_"^"
- SET FLAG=0
- QUIT
- +5 IF FLAG
- SET DGPTERC=407
- +6 QUIT
- FAST ;
- +1 NEW FLAG,I
- +2 IF DGPTSFA=" "
- QUIT
- +3 SET FLAG=0
- FOR I=20:1:26
- IF DGPTSTTY["^"_I_"^"
- SET FLAG=1
- SET DGPTSFA=" "
- QUIT
- +4 IF FLAG
- QUIT
- +5 IF "12345678"'[DGPTSFA
- SET DGPTERC=408
- QUIT
- +6 QUIT
- ANES ;
- +1 NEW FLAG,I
- +2 IF DGPTSAT=" "
- QUIT
- +3 SET FLAG=0
- FOR I=20:1:26
- IF DGPTSTTY["^"_I_"^"
- SET FLAG=1
- SET DGPTSAT=" "
- QUIT
- +4 IF FLAG
- QUIT
- +5 IF "0123456789RX"'[DGPTSAT
- SET DGPTERC=409
- QUIT
- +6 SET DGPTERC=409
- FOR I=10,11,30,40,42
- IF DGPTSTTY["^"_I_"^"
- SET DGPTERC=0
- QUIT
- +7 QUIT
- +8 ;
- FIRST ;-- Edit surgeries - present in ICD0 OPERATIONS, current, gender ok
- +1 ;
- +2 IF (+DGPTSO1=1371)!(+DGPTSO1=39610)!(+DGPTSO1=39611)!(+DGPTSO1=39612)
- SET DGPTERC=450
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- LOOP ;
- +1 FOR DGPTL3=1:1:5
- SET DGPTERC=0
- DO CHKOPC
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +2 QUIT
- CHKOPC ;
- +1 SET DGPTOC=(@("DGPTSO"_DGPTL3))
- SET DGPTOC=$PIECE(DGPTOC," ",1)
- IF DGPTOC=""
- QUIT
- +2 SET DGPTERC=410+DGPTL3
- +3 SET DGPTOC=$EXTRACT(DGPTOC_" ",1,2)_"."_$EXTRACT(DGPTOC,3,7)
- +4 IF $DATA(^ICD0("AB",DGPTOC))
- SET DGPTERC=0
- DO GEN
- QUIT
- +5 QUIT
- GEN ;
- +1 SET DGPTOPP=$ORDER(^ICD0("AB",DGPTOC,0))
- IF DGPTOPP=""
- SET DGPTERC=451
- QUIT
- +2 ;use date of surgery from rec if it exists, else today
- SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$SELECT($GET(DGPTSDD)'="":DGPTSDD,1:DT))
- +3 ; DG*744 - check against discharge date
- +4 ;I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=451 Q
- +5 IF DGPTTMP=-1!('$PIECE(DGPTTMP,U,10))
- SET DGPTERC=451
- NEW DGPTDAT
- SET DGPTDAT=+$GET(^DGPT(PTF,70))
- IF DGPTDAT
- SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,DGPTDAT)
- IF $PIECE(DGPTTMP,U,10)=1
- SET DGPTERC=0
- +6 IF DGPTERC=451
- QUIT
- +7 IF $PIECE(DGPTTMP,U,11)]""&(DGPTGEN'=$PIECE(DGPTTMP,U,11))
- SET DGPTERC=451
- QUIT
- CURR ;
- +1 ;use date of surgery from rec if it exists, else today
- SET DGPTTMP=$$ICDOP^ICDCODE(DGPTOPP,$SELECT($GET(DGPTSDD)'="":DGPTSDD,1:DT))
- +2 IF ($PIECE(DGPTTMP,U,10)=0)&($PIECE(DGPTSDD,1,7)>$PIECE(DGPTTMP,U,12))
- SET DGPTERC=474+DGPTL3
- QUIT
- SAVE ;
- +1 SET @("DGPTSO"_DGPTL3)=DGPTOC
- ARRAY ;
- +1 SET DGPTOPAR(DGPTSDD)=$SELECT($DATA(DGPTOPAR(DGPTSDD)):DGPTOPAR(DGPTSDD)_U_DGPTOPP,1:DGPTOPP_U)
- +2 QUIT
- EXIT ;
- +1 KILL DGPTL3,DGPTOC,DGPTOC1,DGPTOPP
- +2 QUIT
- ERR ;
- +1 DO WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
- +2 QUIT
