Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPT70DX

DGPT70DX.m

Go to the documentation of this file.
  1. 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
  1. ;;ADL;Update for CSV Project;;Mar 24, 2003
  1. ;
  1. ; ICDEX APIs - #5747
  1. ; ICDXCODE APIs - #5699
  1. ;
  1. EN ;-- check dxls for entire stay
  1. S DGPTDDXE=$P(DGPTDDXE," ",1) ;DGPTDDXE = dxls for entire stay
  1. S DGPTERC=0
  1. NOE ;quit if code starts with E
  1. ;E = Supplementary Classification of Factors Influencing Health Status
  1. ; and Contact with Health Services.
  1. ;V = Supplementary Classification of External Causes of Inquiry and Poisoning
  1. N SYS,EFFDATE,IMPDATE,DGPTDAT
  1. D EFFDATE^DGPTIC10($G(PTF))
  1. S SYS=$$SYS^ICDEX("DIAG",EFFDATE)
  1. I SYS=1 I $E(DGPTDDXE,1)="E" S DGPTERC=750 Q
  1. I SYS=1 I $E(DGPTDDXE,1)="V" S DGPTERC=0 D DIAGV G:DGPTERC EXIT D SET G:DGPTERC EXIT G GENDR
  1. I SYS=1 Q:"VE"[$E(DGPTDDXE,1)
  1. NUM ;
  1. 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
  1. S DGPTERC=715 G EXIT
  1. SET ;
  1. N EFFDATE,IMPDATE,DGPTDAT
  1. D EFFDATE^DGPTIC10($G(PTF))
  1. S J=+$$CODEN^ICDEX(DGPTDIA1,80) I J<1 S DGPTERC=715 Q
  1. S DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
  1. I DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGPTERC=715 Q
  1. I ($P(DGPTTMP,U,10)=0)&($E(DGPTDDS,1,7)>$P(DGPTTMP,U,12)) S DGPTERC=715 Q
  1. Q
  1. GENDR ;patient's gender
  1. N EFFDATE,IMPDATE,DGPTDAT
  1. D EFFDATE^DGPTIC10($G(PTF))
  1. S DGPTTMP=$$ICDDATA^ICDXCODE("DIAG",J,EFFDATE)
  1. G:$P(DGPTTMP,U,11)']"" DDXE
  1. ;I $P(DGPTTMP,U,11)'=DGPTGEN S DGPTERC=751 G EXIT
  1. DDXE ;
  1. S ICDDX(1)=J
  1. S DGPTDDXE=$P(DGPTDIA1," ",1)
  1. EXIT ;
  1. K J,J1,DGPTDIA1
  1. Q
  1. DIAGV ;Supplementary Classification of External Causes of Inquiry and Poisoning
  1. S DGPTDIA1=$E(DGPTDDXE,1,3)_"."_$E(DGPTDDXE,4,$L(DGPTDDXE))_" "
  1. I +$$CODEN^ICDEX(DGPTDIA1,80)<1 S DGPTERC=715
  1. Q