DGPTAE02 ;ALB/MTC - 701 Edit Checks ;11/01/2005
;;5.3;Registration;**8,22,39,114,176,251,247,270,446,418,482,466,683,729,1015**;Aug 13, 1993;Build 21
;10/06/1999 ACS - Added Place of Disposition codes M,Y,Z to the
;validity checks
;5/15/2000 ACS - Added Treating Specialty 37 as a valid code
;5/16/2000 MM - Added Treating Specialties 38 & 39 as valid codes
;5/26/2000 JRP - Place of Disposition code M valid for station
; types 10, 11, 30, and 40
;09/27/2006 JRC - Added Treating Specialties 13, 30, 48, 49, 78,
; 82 and 97
;
CHECK ;
I (DGPTSP1'?1AN)!(DGPTSP2'?1AN) S DGPTERC=1 Q
I DGPTSP1="0"&((DGPTSP2'?1AN)!(DGPTSP2="0")) S DGPTERC=1 G EXIT
; No zero or double zeroes allowed
I DGPTSP1=5 G EXIT
; All codes 50-59 allowable
; New code 95:p-418
; New code 96;p-446
EXIT ;
K DGPTSP1,DGPTSP2
Q
;
DISPTY ;
N I
S DGPTERC=0
Q:"1"[DGPTDTY
I DGPTDTY=2 S DGPTERC=707 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
I DGPTERC Q
;
;-- if dis type = To Non-Bed Care then VA aus and Out pat = no
;I DGPTDTY=2,((DGPTDVA'=2)!(DGPTDOP'=3)) S DGPTERC=707 Q
;
I DGPTDTY=3&(DGPTSTTY'["^42^") S DGPTERC=707 Q
;-- if dis type = Transfer then Out pat cannot be yes
I DGPTDTY=5,DGPTDOP=1 S DGPTERC=707
;-- if dis type = Transfer then Out pat cannot be yes, rec sta'=""
I DGPTDTY=5,DGPTDOP'=1,'DGPTDRF S DGPTERC=711 Q
;-- if dis type irr, death w/aotopsy then va asp, op care, pod = ""
I "467"[DGPTDTY,(DGPTDOP!DGPTDVA!DGPTDPD) S DGPTERC=707 Q
Q
OP ;
Q:"13"'[DGPTDOP
S DGPTERC=708 F I=10,11,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
Q
POD ;
N I
Q:"X012347BCDFGHJKL "[DGPTDPD
; if POD NHCU then Out=no VA aus=yes
I DGPTDPD=5,((DGPTDOP'=3)!(DGPTDVA'=1)) S DGPTERC=710 Q
; if POD NHCU then Out=no VA aus=yes, rec station'=""
I DGPTDPD=5,DGPTDOP=3,DGPTDVA=1,'DGPTDRF S DGPTERC=711 Q
I "PR"[DGPTDPD,((DGPTSTTY'["^10^")!(DGPTSTTY'["^11^")) S DGPTERC=710 Q
I DGPTDPD="M" S DGPTERC=710 F I=10,11,30,40 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
I DGPTDPD="T" S DGPTERC=710 F I=10,11,40 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
I "UYZ"[DGPTDPD S DGPTERC=710 F I=10,11,20:1:27,30,40:1:42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
Q
LEAVE ;
S DGPTLVDY=0
S DGPTL3=0 F S DGPTL3=$O(^TMP("AEDIT",$J,"N501",DGPTL3)) Q:DGPTL3="" S DGPTLVDY=DGPTLVDY+$E(^TMP("AEDIT",$J,"N501",DGPTL3),49,51)+$E(^TMP("AEDIT",$J,"N501",DGPTL3),52,54)
I (DGPTLVDY+DGPTDAS)>DGPTELP S DGPTERC=745
K DGPTL3,DGPTLVDY
Q
;
CANDP ;
I "12345678"'[DGPTDCP S DGPTERC=714 Q
;-- if no POS then no edit
Q:DGPTPOS2=9
;-- if WWI then no edit
Q:DGPTPOS2=1
;-- if POW then no edit
I $L(DGPTPOW)=1,("23456789AB"[DGPTPOW) Q
D CONSIS Q:DGPTERC
D STATYP Q:DGPTERC
D CPMT Q:DGPTERC
Q
CONSIS ;
I ("01234578X"[DGPTPOS2)&("1234567"'[DGPTDCP) S DGPTERC=736 Q
I ("ABCD"[DGPTPOS2) Q
I DGPTPOS2="Z"&("1234567"'[DGPTDCP) S DGPTERC=736 Q
Q:"012345678ABCDXZ"[DGPTPOS2
S:DGPTDCP'=8 DGPTERC=736
Q
STATYP ;
Q:(DGPTSTTY["^30^")!(DGPTSTTY="^")!(DGPTSTTY="")
;Note: There is not sufficient information contained in the
;station type to adequately perform the error check of Means Test
;indicator vs admissions date. This issue should be revisited in 5.4.
;For now, error code 143 (previously set as 744) will not be checked
;in order to be sure that an error is not erroneously generated.
Q
MT ;
I DGPTMTC="X "&((+DGPTDTS)'<2860701) S DGPTERC=143 Q
Q:DGPTMTC="X "
I DGPTDTS<2860701 S DGPTERC=143 Q
Q
;
CPMT ;-- mt and c&p checks
I DGPTMTC="N ",DGPTDCP'=8 S DGPTERC=753 Q
I DGPTMTC="AN","24567"'[DGPTDCP S DGPTERC=753 Q
I ((DGPTMTC="B ")!(DGPTMTC="C ")!(DGPTMTC="G ")),"2467"'[DGPTDCP S DGPTERC=753 Q
I DGPTMTC="AS","1234567"'[DGPTDCP S DGPTERC=753 Q
Q
LEG ;
;I DGPTDDXE=482.8&("12"'[DGPT70LG) S DGPTERC=731 Q
Q
SUI ;
N DGINACT
I ($E(DGPTDDXE,1,3)="E95")&("12345678"[$E(DGPTDDXE,4))&("12"'[DGPT70SU) D
. I '$D(DGSCDT) D DC
. S DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")
. I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
. S DGPTERC=732 Q
Q
DRUG ;
S DGPTMSX=0
I ($E(DGPTDDXE,1,4)="304.")&("013456"[$E(DGPTDDXE,5))&("0123"[$E(DGPTDDXE,6)) S DGPTMSX=1
I ($E(DGPTDDXE,1,4)="305.")&("234579"[$E(DGPTDDXE,5))&("0123"[$E(DGPTDDXE,6)) S DGPTMSX=1
Q:'DGPTMSX
N DGINACT
I $E(DGPT70DR,1)'="A"!($E(DGPT70DR,2,4)<1)!(+$E(DGPT70DR>16)) D
. I '$D(DGSCDT) D DC
. S DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")
. I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
. S DGPTERC=733
S DGPTMSX=0 Q
AXIV ;
I $E(DGPTDDXE,1,3)>295,$E(DGPTDDXE,1,3)<320,"0123456"'[DGPT70X4 S DGPTERC=734
Q
AXV1 ;
I (DGPTDXV1<0)!(DGPTDXV1>90) S DGPTERC=735 Q
Q
AXV2 ;
Q:DGPTDXV2=" "
I (DGPTDXV2<0)!(DGPTDXV2>90) S DGPTERC=735 Q
Q
DC ;find discharge date
S DGSCDT=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)
Q
DGPTAE02 ;ALB/MTC - 701 Edit Checks ;11/01/2005
+1 ;;5.3;Registration;**8,22,39,114,176,251,247,270,446,418,482,466,683,729,1015**;Aug 13, 1993;Build 21
+2 ;10/06/1999 ACS - Added Place of Disposition codes M,Y,Z to the
+3 ;validity checks
+4 ;5/15/2000 ACS - Added Treating Specialty 37 as a valid code
+5 ;5/16/2000 MM - Added Treating Specialties 38 & 39 as valid codes
+6 ;5/26/2000 JRP - Place of Disposition code M valid for station
+7 ; types 10, 11, 30, and 40
+8 ;09/27/2006 JRC - Added Treating Specialties 13, 30, 48, 49, 78,
+9 ; 82 and 97
+10 ;
CHECK ;
+1 IF (DGPTSP1'?1AN)!(DGPTSP2'?1AN)
SET DGPTERC=1
QUIT
+2 IF DGPTSP1="0"&((DGPTSP2'?1AN)!(DGPTSP2="0"))
SET DGPTERC=1
GOTO EXIT
+3 ; No zero or double zeroes allowed
+4 IF DGPTSP1=5
GOTO EXIT
+5 ; All codes 50-59 allowable
+6 ; New code 95:p-418
+7 ; New code 96;p-446
EXIT ;
+1 KILL DGPTSP1,DGPTSP2
+2 QUIT
+3 ;
DISPTY ;
+1 NEW I
+2 SET DGPTERC=0
+3 IF "1"[DGPTDTY
QUIT
+4 IF DGPTDTY=2
SET DGPTERC=707
FOR I=10,11,30,40,42
IF DGPTSTTY["^"_I_"^"
SET DGPTERC=0
QUIT
+5 IF DGPTERC
QUIT
+6 ;
+7 ;-- if dis type = To Non-Bed Care then VA aus and Out pat = no
+8 ;I DGPTDTY=2,((DGPTDVA'=2)!(DGPTDOP'=3)) S DGPTERC=707 Q
+9 ;
+10 IF DGPTDTY=3&(DGPTSTTY'["^42^")
SET DGPTERC=707
QUIT
+11 ;-- if dis type = Transfer then Out pat cannot be yes
+12 IF DGPTDTY=5
IF DGPTDOP=1
SET DGPTERC=707
+13 ;-- if dis type = Transfer then Out pat cannot be yes, rec sta'=""
+14 IF DGPTDTY=5
IF DGPTDOP'=1
IF 'DGPTDRF
SET DGPTERC=711
QUIT
+15 ;-- if dis type irr, death w/aotopsy then va asp, op care, pod = ""
+16 IF "467"[DGPTDTY
IF (DGPTDOP!DGPTDVA!DGPTDPD)
SET DGPTERC=707
QUIT
+17 QUIT
OP ;
+1 IF "13"'[DGPTDOP
QUIT
+2 SET DGPTERC=708
FOR I=10,11,40,42
IF DGPTSTTY["^"_I_"^"
SET DGPTERC=0
QUIT
+3 QUIT
POD ;
+1 NEW I
+2 IF "X012347BCDFGHJKL "[DGPTDPD
QUIT
+3 ; if POD NHCU then Out=no VA aus=yes
+4 IF DGPTDPD=5
IF ((DGPTDOP'=3)!(DGPTDVA'=1))
SET DGPTERC=710
QUIT
+5 ; if POD NHCU then Out=no VA aus=yes, rec station'=""
+6 IF DGPTDPD=5
IF DGPTDOP=3
IF DGPTDVA=1
IF 'DGPTDRF
SET DGPTERC=711
QUIT
+7 IF "PR"[DGPTDPD
IF ((DGPTSTTY'["^10^")!(DGPTSTTY'["^11^"))
SET DGPTERC=710
QUIT
+8 IF DGPTDPD="M"
SET DGPTERC=710
FOR I=10,11,30,40
IF DGPTSTTY["^"_I_"^"
SET DGPTERC=0
QUIT
+9 IF DGPTDPD="T"
SET DGPTERC=710
FOR I=10,11,40
IF DGPTSTTY["^"_I_"^"
SET DGPTERC=0
QUIT
+10 IF "UYZ"[DGPTDPD
SET DGPTERC=710
FOR I=10,11,20:1:27,30,40:1:42
IF DGPTSTTY["^"_I_"^"
SET DGPTERC=0
QUIT
+11 QUIT
LEAVE ;
+1 SET DGPTLVDY=0
+2 SET DGPTL3=0
FOR
SET DGPTL3=$ORDER(^TMP("AEDIT",$JOB,"N501",DGPTL3))
IF DGPTL3=""
QUIT
SET DGPTLVDY=DGPTLVDY+$EXTRACT(^TMP("AEDIT",$JOB,"N501",DGPTL3),49,51)+$EXTRACT(^TMP("AEDIT",$JOB,"N501",DGPTL3),52,54)
+3 IF (DGPTLVDY+DGPTDAS)>DGPTELP
SET DGPTERC=745
+4 KILL DGPTL3,DGPTLVDY
+5 QUIT
+6 ;
CANDP ;
+1 IF "12345678"'[DGPTDCP
SET DGPTERC=714
QUIT
+2 ;-- if no POS then no edit
+3 IF DGPTPOS2=9
QUIT
+4 ;-- if WWI then no edit
+5 IF DGPTPOS2=1
QUIT
+6 ;-- if POW then no edit
+7 IF $LENGTH(DGPTPOW)=1
IF ("23456789AB"[DGPTPOW)
QUIT
+8 DO CONSIS
IF DGPTERC
QUIT
+9 DO STATYP
IF DGPTERC
QUIT
+10 DO CPMT
IF DGPTERC
QUIT
+11 QUIT
CONSIS ;
+1 IF ("01234578X"[DGPTPOS2)&("1234567"'[DGPTDCP)
SET DGPTERC=736
QUIT
+2 IF ("ABCD"[DGPTPOS2)
QUIT
+3 IF DGPTPOS2="Z"&("1234567"'[DGPTDCP)
SET DGPTERC=736
QUIT
+4 IF "012345678ABCDXZ"[DGPTPOS2
QUIT
+5 IF DGPTDCP'=8
SET DGPTERC=736
+6 QUIT
STATYP ;
+1 IF (DGPTSTTY["^30^")!(DGPTSTTY="^")!(DGPTSTTY="")
QUIT
+2 ;Note: There is not sufficient information contained in the
+3 ;station type to adequately perform the error check of Means Test
+4 ;indicator vs admissions date. This issue should be revisited in 5.4.
+5 ;For now, error code 143 (previously set as 744) will not be checked
+6 ;in order to be sure that an error is not erroneously generated.
+7 QUIT
MT ;
+1 IF DGPTMTC="X "&((+DGPTDTS)'<2860701)
SET DGPTERC=143
QUIT
+2 IF DGPTMTC="X "
QUIT
+3 IF DGPTDTS<2860701
SET DGPTERC=143
QUIT
+4 QUIT
+5 ;
CPMT ;-- mt and c&p checks
+1 IF DGPTMTC="N "
IF DGPTDCP'=8
SET DGPTERC=753
QUIT
+2 IF DGPTMTC="AN"
IF "24567"'[DGPTDCP
SET DGPTERC=753
QUIT
+3 IF ((DGPTMTC="B ")!(DGPTMTC="C ")!(DGPTMTC="G "))
IF "2467"'[DGPTDCP
SET DGPTERC=753
QUIT
+4 IF DGPTMTC="AS"
IF "1234567"'[DGPTDCP
SET DGPTERC=753
QUIT
+5 QUIT
LEG ;
+1 ;I DGPTDDXE=482.8&("12"'[DGPT70LG) S DGPTERC=731 Q
+2 QUIT
SUI ;
+1 NEW DGINACT
+2 IF ($EXTRACT(DGPTDDXE,1,3)="E95")&("12345678"[$EXTRACT(DGPTDDXE,4))&("12"'[DGPT70SU)
Begin DoDot:1
+3 IF '$DATA(DGSCDT)
DO DC
+4 SET DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")
+5 IF DGINACT]""
IF $DATA(DGSCDT)
IF DGSCDT>DGINACT
QUIT
+6 SET DGPTERC=732
QUIT
End DoDot:1
+7 QUIT
DRUG ;
+1 SET DGPTMSX=0
+2 IF ($EXTRACT(DGPTDDXE,1,4)="304.")&("013456"[$EXTRACT(DGPTDDXE,5))&("0123"[$EXTRACT(DGPTDDXE,6))
SET DGPTMSX=1
+3 IF ($EXTRACT(DGPTDDXE,1,4)="305.")&("234579"[$EXTRACT(DGPTDDXE,5))&("0123"[$EXTRACT(DGPTDDXE,6))
SET DGPTMSX=1
+4 IF 'DGPTMSX
QUIT
+5 NEW DGINACT
+6 IF $EXTRACT(DGPT70DR,1)'="A"!($EXTRACT(DGPT70DR,2,4)<1)!(+$EXTRACT(DGPT70DR>16))
Begin DoDot:1
+7 IF '$DATA(DGSCDT)
DO DC
+8 SET DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")
+9 IF DGINACT]""
IF $DATA(DGSCDT)
IF DGSCDT>DGINACT
QUIT
+10 SET DGPTERC=733
End DoDot:1
+11 SET DGPTMSX=0
QUIT
AXIV ;
+1 IF $EXTRACT(DGPTDDXE,1,3)>295
IF $EXTRACT(DGPTDDXE,1,3)<320
IF "0123456"'[DGPT70X4
SET DGPTERC=734
+2 QUIT
AXV1 ;
+1 IF (DGPTDXV1<0)!(DGPTDXV1>90)
SET DGPTERC=735
QUIT
+2 QUIT
AXV2 ;
+1 IF DGPTDXV2=" "
QUIT
+2 IF (DGPTDXV2<0)!(DGPTDXV2>90)
SET DGPTERC=735
QUIT
+3 QUIT
DC ;find discharge date
+1 SET DGSCDT=$SELECT('$DATA(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)
+2 QUIT
