DGPT70DX ;ALB/MTC/ADL,HIOFO/FT - DXLS Edit Checks for 701 ;3/3/15 12:46pm
;;5.3;Registration;**510,850,884**;Aug 13, 1993;Build 31
;;ADL;Update for CSV Project;;Mar 24, 2003
;
; ICDEX APIs - #5747
; ICDXCODE APIs - #5699
;
EN ;-- check dxls for entire stay
S DGPTDDXE=$P(DGPTDDXE," ",1) ;DGPTDDXE = dxls for entire stay
S DGPTERC=0
NOE ;quit if code starts with E
;E = Supplementary Classification of Factors Influencing Health Status
; and Contact with Health Services.
;V = Supplementary Classification of External Causes of Inquiry and Poisoning
N SYS,EFFDATE,IMPDATE,DGPTDAT
D EFFDATE^DGPTIC10($G(PTF))
S SYS=$$SYS^ICDEX("DIAG",EFFDATE)
I SYS=1 I $E(DGPTDDXE,1)="E" S DGPTERC=750 Q
I SYS=1 I $E(DGPTDDXE,1)="V" S DGPTERC=0 D DIAGV G:DGPTERC EXIT D SET G:DGPTERC EXIT G GENDR
I SYS=1 Q:"VE"[$E(DGPTDDXE,1)
NUM ;
S J1=$L(DGPTDDXE) F J=1:1:3 S DGPTDIA1=$E(DGPTDDXE,1,J)_"."_$E(DGPTDDXE,J+1,J1)_" " I +$$CODEN^ICDEX(DGPTDIA1,80)>0 D SET G:'DGPTERC GENDR
S DGPTERC=715 G EXIT
SET ;
N EFFDATE,IMPDATE,DGPTDAT
D EFFDATE^DGPTIC10($G(PTF))
S J=+$$CODEN^ICDEX(DGPTDIA1,80) I J<1 S DGPTERC=715 Q
S DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=715 Q
I ($P(DGPTTMP,U,10)=0)&($E(DGPTDDS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=715 Q
Q
GENDR ;patient's gender
N EFFDATE,IMPDATE,DGPTDAT
D EFFDATE^DGPTIC10($G(PTF))
S DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
G:$P(DGPTTMP,U,11)']"" DDXE
;I $P(DGPTTMP,U,11)'=DGPTGEN S DGPTERC=751 G EXIT
DDXE ;
S ICDDX(1)=J
S DGPTDDXE=$P(DGPTDIA1," ",1)
EXIT ;
K J,J1,DGPTDIA1
Q
DIAGV ;Supplementary Classification of External Causes of Inquiry and Poisoning
S DGPTDIA1=$E(DGPTDDXE,1,3)_"."_$E(DGPTDDXE,4,$L(DGPTDDXE))_" "
I +$$CODEN^ICDEX(DGPTDIA1,80)<1 S DGPTERC=715
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPT70DX 1820 printed Sep 23, 2025@20:27:21 Page 2
DGPT70DX ;ALB/MTC/ADL,HIOFO/FT - DXLS Edit Checks for 701 ;3/3/15 12:46pm
+1 ;;5.3;Registration;**510,850,884**;Aug 13, 1993;Build 31
+2 ;;ADL;Update for CSV Project;;Mar 24, 2003
+3 ;
+4 ; ICDEX APIs - #5747
+5 ; ICDXCODE APIs - #5699
+6 ;
EN ;-- check dxls for entire stay
+1 ;DGPTDDXE = dxls for entire stay
SET DGPTDDXE=$PIECE(DGPTDDXE," ",1)
+2 SET DGPTERC=0
NOE ;quit if code starts with E
+1 ;E = Supplementary Classification of Factors Influencing Health Status
+2 ; and Contact with Health Services.
+3 ;V = Supplementary Classification of External Causes of Inquiry and Poisoning
+4 NEW SYS,EFFDATE,IMPDATE,DGPTDAT
+5 DO EFFDATE^DGPTIC10($GET(PTF))
+6 SET SYS=$$SYS^ICDEX("DIAG",EFFDATE)
+7 IF SYS=1
IF $EXTRACT(DGPTDDXE,1)="E"
SET DGPTERC=750
QUIT
+8 IF SYS=1
IF $EXTRACT(DGPTDDXE,1)="V"
SET DGPTERC=0
DO DIAGV
if DGPTERC
GOTO EXIT
DO SET
if DGPTERC
GOTO EXIT
GOTO GENDR
+9 IF SYS=1
if "VE"[$EXTRACT(DGPTDDXE,1)
QUIT
NUM ;
+1 SET J1=$LENGTH(DGPTDDXE)
FOR J=1:1:3
SET DGPTDIA1=$EXTRACT(DGPTDDXE,1,J)_"."_$EXTRACT(DGPTDDXE,J+1,J1)_" "
IF +$$CODEN^ICDEX(DGPTDIA1,80)>0
DO SET
if 'DGPTERC
GOTO GENDR
+2 SET DGPTERC=715
GOTO EXIT
SET ;
+1 NEW EFFDATE,IMPDATE,DGPTDAT
+2 DO EFFDATE^DGPTIC10($GET(PTF))
+3 SET J=+$$CODEN^ICDEX(DGPTDIA1,80)
IF J<1
SET DGPTERC=715
QUIT
+4 SET DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
+5 IF DGPTTMP=-1!('$PIECE(DGPTTMP,U,10))
SET DGPTERC=715
QUIT
+6 IF ($PIECE(DGPTTMP,U,10)=0)&($EXTRACT(DGPTDDS,1,7)>$PIECE(DGPTTMP,U,12))
SET DGPTERC=715
QUIT
+7 QUIT
GENDR ;patient's gender
+1 NEW EFFDATE,IMPDATE,DGPTDAT
+2 DO EFFDATE^DGPTIC10($GET(PTF))
+3 SET DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
+4 if $PIECE(DGPTTMP,U,11)']""
GOTO DDXE
+5 ;I $P(DGPTTMP,U,11)'=DGPTGEN S DGPTERC=751 G EXIT
DDXE ;
+1 SET ICDDX(1)=J
+2 SET DGPTDDXE=$PIECE(DGPTDIA1," ",1)
EXIT ;
+1 KILL J,J1,DGPTDIA1
+2 QUIT
DIAGV ;Supplementary Classification of External Causes of Inquiry and Poisoning
+1 SET DGPTDIA1=$EXTRACT(DGPTDDXE,1,3)_"."_$EXTRACT(DGPTDDXE,4,$LENGTH(DGPTDDXE))_" "
+2 IF +$$CODEN^ICDEX(DGPTDIA1,80)<1
SET DGPTERC=715
+3 QUIT
