| [613] | 1 | DGPT50DI ;ALB/MTC/ADL - Edit diagnoses.Check ICD DIAGNOSES, current, gender correct ; 16 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**510**;Aug 13, 1993
|
|---|
| 3 | ;;ADL;Updated for CSV project;;Mar 24, 2003
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;
|
|---|
| 6 | F I=1:1:5 S DGPTDIB=$P(@("DGPTMD"_I)," ",1) S DGPTERC=0 D DIAG(I) I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 7 | D EXIT
|
|---|
| 8 | Q
|
|---|
| 9 | DIAG(I) ;
|
|---|
| 10 | Q:DGPTDIB=""
|
|---|
| 11 | I $E(DGPTDIB,1)="E" S DGPTERC=0 D DIAGE Q
|
|---|
| 12 | I $E(DGPTDIB,1)="V" S DGPTERC=0 D DIAGV Q
|
|---|
| 13 | S DGPTDIB1=$E(DGPTDIB_" ",1,3)_"."_$E(DGPTDIB_" ",4,5)_" "
|
|---|
| 14 | I $D(^ICD9("AB",DGPTDIB1)) S DGPTERC=0 D GEN(I) Q
|
|---|
| 15 | Q
|
|---|
| 16 | ERR ;
|
|---|
| 17 | D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
|
|---|
| 18 | Q
|
|---|
| 19 | EXIT ;
|
|---|
| 20 | K DGPTDIB,DGPTDIB1,DGPTDIB2,I
|
|---|
| 21 | Q
|
|---|
| 22 | DIAGE ;
|
|---|
| 23 | Q:$E(DGPTDIB)'="E"
|
|---|
| 24 | I I=1 S DGPTERC=550 Q
|
|---|
| 25 | S DGPTDIB1=$E(DGPTDIB,1,4)_"."_$E(DGPTDIB,5,$L(DGPTDIB))_" "
|
|---|
| 26 | I '$D(^ICD9("AB",DGPTDIB1)) S DGPTERC=509+I Q
|
|---|
| 27 | S X=$O(^ICD9("AB",DGPTDIB1,0)) I X="" S DGPTERC=509+I Q
|
|---|
| 28 | S DGPTTMP=$$ICDDX^ICDCODE(X,$S($G(DGPTMDTS)'="":DGPTMDTS,1:DT)) ;use date of movement if defined, else today
|
|---|
| 29 | I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=509+I Q
|
|---|
| 30 | I ($P(DGPTTMP,U,10)=0)&($E(DGPTMDTS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=509+I Q
|
|---|
| 31 | I ($P(DGPTTMP,U,11)]"")&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=791+I Q
|
|---|
| 32 | S @("DGPTMD"_I)=$P(DGPTDIB1," ",1)
|
|---|
| 33 | Q
|
|---|
| 34 | DIAGV ; DIAG CODES = "V##.0-2# "
|
|---|
| 35 | Q:$E(DGPTDIB)'="V"
|
|---|
| 36 | S DGPTDIB1=$E(DGPTDIB,1,3)_"."_$E(DGPTDIB,4,$L(DGPTDIB))_" "
|
|---|
| 37 | I '$D(^ICD9("AB",DGPTDIB1)) S DGPTERC=509+I Q
|
|---|
| 38 | S X=$O(^ICD9("AB",DGPTDIB1,0)) I X="" S DGPTERC=509+I Q
|
|---|
| 39 | S DGPTTMP=$$ICDDX^ICDCODE(X,$S($G(DGPTMDTS)'="":DGPTMDTS,1:DT)) ;use date of movement if defined, else today
|
|---|
| 40 | I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=509+I Q
|
|---|
| 41 | I ($P(DGPTTMP,U,10)=0)&($E(DGPTMDTS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=509+I Q
|
|---|
| 42 | I ($P(DGPTTMP,U,11)]"")&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=509+I Q
|
|---|
| 43 | S @("DGPTMD"_I)=$P(DGPTDIB1," ",1)
|
|---|
| 44 | Q
|
|---|
| 45 | GEN(I) ;
|
|---|
| 46 | S DGPTDIB2=$O(^ICD9("AB",DGPTDIB1,0)) I DGPTDIB2="" S DGPTERC=509+I Q
|
|---|
| 47 | S DGPTTMP=$$ICDDX^ICDCODE(DGPTDIB2,$S($G(DGPTMDTS)'="":DGPTMDTS,1:DT)) ;use date of movement if defined, else today
|
|---|
| 48 | I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=509+I Q
|
|---|
| 49 | I $P(DGPTTMP,U,11)]""&(DGPTGEN'=$P(DGPTTMP,U,11)) S DGPTERC=551 Q
|
|---|
| 50 | S @("DGPTMD"_I)=$P(DGPTDIB1," ",1)
|
|---|
| 51 | Q
|
|---|
