DGPT50MS.m

DGPT50MS ;ALB/MTC - 501 Edits Cont ; 16 NOV 92

 ;;5.3;Registration;**142,729,1015**;Aug 13, 1993;Build 21

 ;

 ; Edits for legionnaire's, suicide, drug and psych indicators

 ;

LEG ;

 ;I ((+DGPTMD1=482.8)!(+DGPTMD2=482.8)!(+DGPTMD3=482.8)!(+DGPTMD3=482.8)!(+DGPTMD4=482.8)!(+DGPTMD5=482.8))&("12"'[DGPTMLG) S DGPTERC=531 Q

 Q

SUI ;

 N I,DGINACT

 S DGPTMSX=0 F I=1:1:5 I ($E(@("DGPTMD"_I),1,3)="E95")&("012345678"[$E(@("DGPTMD"_I),4)) S DGPTMSX=1 Q:DGPTMSX

 Q:'DGPTMSX

 I '$D(DGSCDT) D DC

 S DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")

 I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT

 I "123"'[DGPTMSU S DGPTERC=532 Q

 Q

DRUG ;

 N I,DGINACT

 S DGPTMSX=0 F I=1:1:5 I ($E(@("DGPTMD"_I),1,4)="304.")&("013456"[$E(@("DGPTMD"_I),5))&("0123"[$E(@("DGPTMD"_I),6)) S DGPTMSX=1 Q:DGPTMSX

 G:DGPTMSX DRG1

 S DGPTMSX=0 F I=1:1:5 I ($E(@("DGPTMD"_I),1,4)="305.")&("234579"[$E(@("DGPTMD"_I),5))&("0123"[$E(@("DGPTMD"_I),6)) S DGPTMSX=1 Q:DGPTMSX

DRG1 ;

 Q:'DGPTMSX

 I '$D(DGSCDT) D DC

 S DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")

 I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT

 I DGPTMDG'?1A3N S DGPTERC=533 Q

 I $E(DGPTMDG,1)'="A" S DGPTERC=533 Q

 I ($E(DGPTMDG,2,4))<1!($E(DGPTMDG,2,4)>18) S DGPTERC=533 Q

 Q

AXIV ;

 N I

 S DGPTMSX=0 F I=1:1:5 I ($E(@("DGPTMD"_I),1,3)'<290)&($E(@("DGPTMD"_I),1,3)<320) S DGPTMSX=1 Q:DGPTMSX

 Q:'DGPTMSX

 I "0123456"'[DGPTMXIV S DGPTERC=534 Q

 Q

AXV1 ;

 Q:'DGPTMSX

 I (DGPTMXV1<1)!(DGPTMXV1>90) S DGPTERC=535 Q

 Q

AXV2 ;

 Q:'DGPTMSX

 Q:DGPTMXV2="  "

 I (DGPTMXV2<1)!(DGPTMXV2>90) S DGPTERC=535 Q

 Q

SRVC ;

 I " 12"'[DGPT50SR S DGPTERC=530

 Q

DC ;find discharge date

 S DGSCDT=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)

 Q

DGPT50MS  ;ALB/MTC - 501 Edits Cont ; 16 NOV 92

 +1       ;;5.3;Registration;**142,729,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ; Edits for legionnaire's, suicide, drug and psych indicators

 +4       ;

LEG       ;

 +1       ;I ((+DGPTMD1=482.8)!(+DGPTMD2=482.8)!(+DGPTMD3=482.8)!(+DGPTMD3=482.8)!(+DGPTMD4=482.8)!(+DGPTMD5=482.8))&("12"'[DGPTMLG) S DGPTERC=531 Q

 +2        QUIT 

SUI       ;

 +1        NEW I,DGINACT

 +2        SET DGPTMSX=0

           FOR I=1:1:5

               IF ($EXTRACT(@("DGPTMD"_I),1,3)="E95")&("012345678"[$EXTRACT(@("DGPTMD"_I),4))

                   SET DGPTMSX=1

                   IF DGPTMSX

                       QUIT 

 +3        IF 'DGPTMSX

               QUIT 

 +4        IF '$DATA(DGSCDT)

               DO DC

 +5        SET DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")

 +6        IF DGINACT]""

               IF $DATA(DGSCDT)

                   IF DGSCDT>DGINACT

                       QUIT 

 +7        IF "123"'[DGPTMSU

               SET DGPTERC=532

               QUIT 

 +8        QUIT 

DRUG      ;

 +1        NEW I,DGINACT

 +2        SET DGPTMSX=0

           FOR I=1:1:5

               IF ($EXTRACT(@("DGPTMD"_I),1,4)="304.")&("013456"[$EXTRACT(@("DGPTMD"_I),5))&("0123"[$EXTRACT(@("DGPTMD"_I),6))

                   SET DGPTMSX=1

                   IF DGPTMSX

                       QUIT 

 +3        IF DGPTMSX

               GOTO DRG1

 +4        SET DGPTMSX=0

           FOR I=1:1:5

               IF ($EXTRACT(@("DGPTMD"_I),1,4)="305.")&("234579"[$EXTRACT(@("DGPTMD"_I),5))&("0123"[$EXTRACT(@("DGPTMD"_I),6))

                   SET DGPTMSX=1

                   IF DGPTMSX

                       QUIT 

DRG1      ;

 +1        IF 'DGPTMSX

               QUIT 

 +2        IF '$DATA(DGSCDT)

               DO DC

 +3        SET DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")

 +4        IF DGINACT]""

               IF $DATA(DGSCDT)

                   IF DGSCDT>DGINACT

                       QUIT 

 +5        IF DGPTMDG'?1A3N

               SET DGPTERC=533

               QUIT 

 +6        IF $EXTRACT(DGPTMDG,1)'="A"

               SET DGPTERC=533

               QUIT 

 +7        IF ($EXTRACT(DGPTMDG,2,4))<1!($EXTRACT(DGPTMDG,2,4)>18)

               SET DGPTERC=533

               QUIT 

 +8        QUIT 

AXIV      ;

 +1        NEW I

 +2        SET DGPTMSX=0

           FOR I=1:1:5

               IF ($EXTRACT(@("DGPTMD"_I),1,3)'<290)&($EXTRACT(@("DGPTMD"_I),1,3)<320)

                   SET DGPTMSX=1

                   IF DGPTMSX

                       QUIT 

 +3        IF 'DGPTMSX

               QUIT 

 +4        IF "0123456"'[DGPTMXIV

               SET DGPTERC=534

               QUIT 

 +5        QUIT 

AXV1      ;

 +1        IF 'DGPTMSX

               QUIT 

 +2        IF (DGPTMXV1<1)!(DGPTMXV1>90)

               SET DGPTERC=535

               QUIT 

 +3        QUIT 

AXV2      ;

 +1        IF 'DGPTMSX

               QUIT 

 +2        IF DGPTMXV2="  "

               QUIT 

 +3        IF (DGPTMXV2<1)!(DGPTMXV2>90)

               SET DGPTERC=535

               QUIT 

 +4        QUIT 

SRVC      ;

 +1        IF " 12"'[DGPT50SR

               SET DGPTERC=530

 +2        QUIT 

DC        ;find discharge date

 +1        SET DGSCDT=$SELECT('$DATA(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)

 +2        QUIT