| [613] | 1 | DGPT70DX ;ALB/MTC/ADL - DXLS Edit Checks for 701 ; 13 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**510**;Aug 13, 1993
|
|---|
| 3 | ;;ADL;Update for CSV Project;;Mar 24, 2003
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;-- check dxls
|
|---|
| 7 | S DGPTDDXE=$P(DGPTDDXE," ",1)
|
|---|
| 8 | S DGPTERC=0
|
|---|
| 9 | NOE ;
|
|---|
| 10 | I $E(DGPTDDXE,1)="E" S DGPTERC=750 Q
|
|---|
| 11 | I $E(DGPTDDXE,1)="V" S DGPTERC=0 D DIAGV G:DGPTERC EXIT D SET G:DGPTERC EXIT G GENDR
|
|---|
| 12 | Q:"VE"[$E(DGPTDDXE,1)
|
|---|
| 13 | NUM ;
|
|---|
| 14 | S J1=$L(DGPTDDXE) F J=1:1:3 S DGPTDIA1=$E(DGPTDDXE,1,J)_"."_$E(DGPTDDXE,J+1,J1)_" " I $D(^ICD9("AB",DGPTDIA1)) D SET G:'DGPTERC GENDR
|
|---|
| 15 | S DGPTERC=715 G EXIT
|
|---|
| 16 | SET ;
|
|---|
| 17 | S J=$O(^ICD9("AB",DGPTDIA1,0)) I J="" S DGPTERC=715 Q
|
|---|
| 18 | S DGPTTMP=$$ICDDX^ICDCODE(J,$S($G(DGPTDDS)'="":DGPTDDS,1:DT)) ;use date of disp. if defined, else today
|
|---|
| 19 | I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=715 Q
|
|---|
| 20 | I ($P(DGPTTMP,U,10)=0)&($E(DGPTDDS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=715 Q
|
|---|
| 21 | Q
|
|---|
| 22 | GENDR ;
|
|---|
| 23 | S DGPTTMP=$$ICDDX^ICDCODE(J,$S($G(DGPTDDS)'="":DGPTDDS,1:DT)) ;use date of disp. if defined, else today
|
|---|
| 24 | G:$P(DGPTTMP,U,11)']"" DDXE
|
|---|
| 25 | I $P(DGPTTMP,U,11)'=DGPTGEN S DGPTERC=751 G EXIT
|
|---|
| 26 | DDXE ;
|
|---|
| 27 | S ICDDX(1)=J
|
|---|
| 28 | S DGPTDDXE=$P(DGPTDIA1," ",1)
|
|---|
| 29 | EXIT ;
|
|---|
| 30 | K J,J1,DGPTDIA1
|
|---|
| 31 | Q
|
|---|
| 32 | DIAGV ;
|
|---|
| 33 | S DGPTDIA1=$E(DGPTDDXE,1,3)_"."_$E(DGPTDDXE,4,$L(DGPTDDXE))_" "
|
|---|
| 34 | I '$D(^ICD9("AB",DGPTDIA1)) S DGPTERC=715
|
|---|
| 35 | Q
|
|---|
