DGPT70DI ;ALB/MTC/ADL - Diagnosis edits for 700's - E codes, V codes, gender and ICD9 Diag. ; 16 NOV 92
 ;;5.3;Registration;**510**;Aug 13, 1993
 ;;ADL;Update for CSV Project;;Mar. 24, 2003
 ;
EN ;
 F DGPTL3=1:1:9 S DGPTDIA=$P((@("DGPTGD"_DGPTL3))," ",1) S DGPTERC=0 D DIAG I DGPTERC D ERR G:DGPTEDFL EXIT
 Q
 ;
DIAG ;
 Q:DGPTDIA=""
 I $E(DGPTDIA,1)="E" S DGPTERC=0 D DIAGE Q
 I $E(DGPTDIA,1)="V" S DGPTERC=0 D DIAGV Q
 S DGPTERC=719+DGPTL3
 F DGPTL4=1:1:$L(DGPTDIA) S DGPTDIA1=$E(DGPTDIA,1,DGPTL4)_"."_$E(DGPTDIA,DGPTL4+1,$L(DGPTDIA))_" " I $D(^ICD9("AB",DGPTDIA1)) S DGPTERC=0 D GEN Q
 Q
ERR ;
 D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
 Q
EXIT ;
 K DGPTDIA,DGPTDIA1,DGPTDIA2,DGPTL3,DGPTL4
 Q
DIAGE ;
 Q:$E(DGPTDIA)'="E"
 S DGPTDIA1=$E(DGPTDIA,1,4)_"."_$E(DGPTDIA,5,$L(DGPTDIA))_" "
 I '$D(^ICD9("AB",DGPTDIA1)) S DGPTERC=719+DGPTL3 Q
 S DGPTDIA2=$O(^ICD9("AB",DGPTDIA1,0)) I DGPTDIA2="" S DGPTERC=719+DGPTL3 Q
 S DGPTTMP=$$ICDDX^ICDCODE(DGPTDIA2,$S($G(DGPTDDS)'="":DGPTDDS,1:DT))  ;use date of disp. if defined, else today
 I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=719+DGPTL3 Q
 I ($P(DGPTTMP,U,10)=0)&($E(DGPTDDS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=719+DGPTL3 Q
 I ($P(DGPTTMP,U,11)]"")&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=719+DGPTL3 Q
 S @("DGPTGD"_DGPTL3)=$P(DGPTDIA1," ",1)
 S DGPTDIAR(DGPTDDS)=$S($D(DGPTDIAR(DGPTDDS)):DGPTDIAR(DGPTDDS)_U_DGPTDIA2,1:DGPTDIA2)
 Q
DIAGV ;
 Q:$E(DGPTDIA)'="V"
 S DGPTDIA1=$E(DGPTDIA,1,3)_"."_$E(DGPTDIA,4,$L(DGPTDIA))_" "
 I '$D(^ICD9("AB",DGPTDIA1)) S DGPTERC=719+DGPTL3 Q
 S DGPTDIA2=$O(^ICD9("AB",DGPTDIA1,0)) I DGPTDIA2="" S DGPTERC=719+DGPTL3 Q
 S DGPTTMP=$$ICDDX^ICDCODE(DGPTDIA2,$S($G(DGPTDDS)'="":DGPTDDS,1:DT))  ;use date of disp. if defined, else today
 I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=719+DGPTL3 Q
 I ($P(DGPTTMP,U,10)=0)&($E(DGPTDDS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=719+DGPTL3 Q
 I ($P(DGPTTMP,U,11)]"")&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=719+DGPTL3 Q
 S @("DGPTGD"_DGPTL3)=$P(DGPTDIA1," ",1)
 S DGPTDIAR(DGPTDDS)=$S($D(DGPTDIAR(DGPTDDS)):DGPTDIAR(DGPTDDS)_U_DGPTDIA2,1:DGPTDIA2)
 Q
GEN ;
 S DGPTDIA2=$O(^ICD9("AB",DGPTDIA1,0)) I DGPTDIA2="" S DGPTERC=719+DGPTL3 Q
 S DGPTTMP=$$ICDDX^ICDCODE(DGPTDIA2,$S($G(DGPTDDS)'="":DGPTDDS,1:DT))  ;use date of disp. if defined, else today
 I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=719+DGPTL3 Q
 I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=751 Q
 S @("DGPTGD"_DGPTL3)=$P(DGPTDIA1," ",1)
ARRAY ;
 S DGPTDIAR(DGPTDDS)=$S($D(DGPTDIAR(DGPTDDS)):DGPTDIAR(DGPTDDS)_U_DGPTDIA2,1:DGPTDIA2)
 Q