- DGPTAE04 ;ALB/MTC/ADL,HIOFO/FT - 401 Edit Checks Cont ;6/11/15 11:10am
- ;;5.3;Registration;**510,744,870,850,884**;Aug 13, 1993;Build 31
- ;;ADL;Updated for CSV Project;;Mar 24, 2003
- ;
- ; ICDEX APIs - #5747
- ; ICDXCODE APIs - #5699
- ;
- TRAN ;-- verify transplant status
- Q:DGPTFMT=3 ;transplant status is not used with ICD-10
- I " 12"'[DGPT40PT S DGPTERC=417
- Q
- ;
- CHIEF ;chief surgeon
- 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 ;first assistant
- 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 ;anesthesia technique
- 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
- ;
- ; -- 850 - aas - hard coded ICD codes
- ; -- 39.610, 39.611, 39.612 inactive 10/1/79
- I (DGPTSO1="1371 ")!(DGPTSO1="39610 ")!(DGPTSO1="39611 ")!(DGPTSO1="39612 ") S DGPTERC=450 D ERR G:DGPTEDFL EXIT
- LOOP ;check surgery procedure codes
- I DGPTFMT=2 F DGPTL3=1:1:5 S DGPTERC=0 D CHKOPC I DGPTERC D ERR G:DGPTEDFL EXIT
- I DGPTFMT=3 F DGPTL3=1:1:25 S DGPTERC=0 D CHKOPC I DGPTERC D ERR G:DGPTEDFL EXIT
- Q
- CHKOPC ;
- N SYS,EFFDATE,IMPDATE,DGPTDAT
- D EFFDATE^DGPTIC10($G(PTF))
- S SYS=$$SYS^ICDEX("PROC",EFFDATE)
- S DGPTOC=@("DGPTSO"_DGPTL3),DGPTOC=$P(DGPTOC," ",1) Q:DGPTOC=""
- S DGPTERC=$S(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3)
- I SYS=2 S DGPTOC=$E(DGPTOC_" ",1,2)_"."_$E(DGPTOC,3,7)
- S DGPTOPP=+$$CODEN^ICDEX(DGPTOC,80.1) I $P(DGPTOPP,U,1)'=-1 S DGPTERC=0 D GEN Q
- Q
- GEN ;check patient's gender - 884 no longer flags a gender error
- N EFFDATE,IMPDATE,DGPTDAT
- D EFFDATE^DGPTIC10($G(PTF))
- ; DG*5.3*850
- S DGPTOPP=+$$CODEN^ICDEX(DGPTOC,80.1) I $P(DGPTOPP,U,1)=-1 S DGPTERC=$S(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3) Q
- S DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE)
- ; DG*744 - check against discharge date
- I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=$S(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3) N DGPTDAT S DGPTDAT=+$G(^DGPT(PTF,70)) I DGPTDAT S DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE) 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 ;current procedure. check procedure status, inactive date and surgery date
- S DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE)
- I ($P(DGPTTMP,U,10)=0)&($P(DGPTSDD,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=$S(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTAE04 3057 printed Feb 19, 2025@00:17:35 Page 2
- DGPTAE04 ;ALB/MTC/ADL,HIOFO/FT - 401 Edit Checks Cont ;6/11/15 11:10am
- +1 ;;5.3;Registration;**510,744,870,850,884**;Aug 13, 1993;Build 31
- +2 ;;ADL;Updated for CSV Project;;Mar 24, 2003
- +3 ;
- +4 ; ICDEX APIs - #5747
- +5 ; ICDXCODE APIs - #5699
- +6 ;
- TRAN ;-- verify transplant status
- +1 ;transplant status is not used with ICD-10
- if DGPTFMT=3
- QUIT
- +2 IF " 12"'[DGPT40PT
- SET DGPTERC=417
- +3 QUIT
- +4 ;
- CHIEF ;chief surgeon
- +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 ;first assistant
- +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 ;anesthesia technique
- +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 ; -- 850 - aas - hard coded ICD codes
- +3 ; -- 39.610, 39.611, 39.612 inactive 10/1/79
- +4 IF (DGPTSO1="1371 ")!(DGPTSO1="39610 ")!(DGPTSO1="39611 ")!(DGPTSO1="39612 ")
- SET DGPTERC=450
- DO ERR
- if DGPTEDFL
- GOTO EXIT
- LOOP ;check surgery procedure codes
- +1 IF DGPTFMT=2
- FOR DGPTL3=1:1:5
- SET DGPTERC=0
- DO CHKOPC
- IF DGPTERC
- DO ERR
- if DGPTEDFL
- GOTO EXIT
- +2 IF DGPTFMT=3
- FOR DGPTL3=1:1:25
- SET DGPTERC=0
- DO CHKOPC
- IF DGPTERC
- DO ERR
- if DGPTEDFL
- GOTO EXIT
- +3 QUIT
- CHKOPC ;
- +1 NEW SYS,EFFDATE,IMPDATE,DGPTDAT
- +2 DO EFFDATE^DGPTIC10($GET(PTF))
- +3 SET SYS=$$SYS^ICDEX("PROC",EFFDATE)
- +4 SET DGPTOC=@("DGPTSO"_DGPTL3)
- SET DGPTOC=$PIECE(DGPTOC," ",1)
- if DGPTOC=""
- QUIT
- +5 SET DGPTERC=$SELECT(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3)
- +6 IF SYS=2
- SET DGPTOC=$EXTRACT(DGPTOC_" ",1,2)_"."_$EXTRACT(DGPTOC,3,7)
- +7 SET DGPTOPP=+$$CODEN^ICDEX(DGPTOC,80.1)
- IF $PIECE(DGPTOPP,U,1)'=-1
- SET DGPTERC=0
- DO GEN
- QUIT
- +8 QUIT
- GEN ;check patient's gender - 884 no longer flags a gender error
- +1 NEW EFFDATE,IMPDATE,DGPTDAT
- +2 DO EFFDATE^DGPTIC10($GET(PTF))
- +3 ; DG*5.3*850
- +4 SET DGPTOPP=+$$CODEN^ICDEX(DGPTOC,80.1)
- IF $PIECE(DGPTOPP,U,1)=-1
- SET DGPTERC=$SELECT(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3)
- QUIT
- +5 SET DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE)
- +6 ; DG*744 - check against discharge date
- +7 IF DGPTTMP=-1!('$PIECE(DGPTTMP,U,10))
- SET DGPTERC=$SELECT(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+DGPTL3)
- NEW DGPTDAT
- SET DGPTDAT=+$GET(^DGPT(PTF,70))
- IF DGPTDAT
- SET DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE)
- IF $PIECE(DGPTTMP,U,10)=1
- SET DGPTERC=0
- +8 ;I DGPTERC=451 Q
- +9 ;I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=451 Q
- CURR ;current procedure. check procedure status, inactive date and surgery date
- +1 SET DGPTTMP=$$ICDDATA^ICDXCODE("PROC",DGPTOPP,EFFDATE)
- +2 IF ($PIECE(DGPTTMP,U,10)=0)&($PIECE(DGPTSDD,1,7)>$PIECE(DGPTTMP,U,12))
- SET DGPTERC=$SELECT(DGPTL3<6:410+DGPTL3,DGPTL3<23:412+DGPTL3,1:423+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