| 1 | DGPT50MS ;ALB/MTC - 501 Edits Cont ; 16 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**142,729**;Aug 13, 1993;Build 59
|
|---|
| 3 | ;
|
|---|
| 4 | ; Edits for legionnaire's, suicide, drug and psych indicators
|
|---|
| 5 | ;
|
|---|
| 6 | LEG ;
|
|---|
| 7 | ;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
|
|---|
| 8 | Q
|
|---|
| 9 | SUI ;
|
|---|
| 10 | N I,DGINACT
|
|---|
| 11 | 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
|
|---|
| 12 | Q:'DGPTMSX
|
|---|
| 13 | I '$D(DGSCDT) D DC
|
|---|
| 14 | S DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")
|
|---|
| 15 | I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
|
|---|
| 16 | I "123"'[DGPTMSU S DGPTERC=532 Q
|
|---|
| 17 | Q
|
|---|
| 18 | DRUG ;
|
|---|
| 19 | N I,DGINACT
|
|---|
| 20 | 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
|
|---|
| 21 | G:DGPTMSX DRG1
|
|---|
| 22 | 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
|
|---|
| 23 | DRG1 ;
|
|---|
| 24 | Q:'DGPTMSX
|
|---|
| 25 | I '$D(DGSCDT) D DC
|
|---|
| 26 | S DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")
|
|---|
| 27 | I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
|
|---|
| 28 | I DGPTMDG'?1A3N S DGPTERC=533 Q
|
|---|
| 29 | I $E(DGPTMDG,1)'="A" S DGPTERC=533 Q
|
|---|
| 30 | I ($E(DGPTMDG,2,4))<1!($E(DGPTMDG,2,4)>18) S DGPTERC=533 Q
|
|---|
| 31 | Q
|
|---|
| 32 | AXIV ;
|
|---|
| 33 | N I
|
|---|
| 34 | 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
|
|---|
| 35 | Q:'DGPTMSX
|
|---|
| 36 | I "0123456"'[DGPTMXIV S DGPTERC=534 Q
|
|---|
| 37 | Q
|
|---|
| 38 | AXV1 ;
|
|---|
| 39 | Q:'DGPTMSX
|
|---|
| 40 | I (DGPTMXV1<1)!(DGPTMXV1>90) S DGPTERC=535 Q
|
|---|
| 41 | Q
|
|---|
| 42 | AXV2 ;
|
|---|
| 43 | Q:'DGPTMSX
|
|---|
| 44 | Q:DGPTMXV2=" "
|
|---|
| 45 | I (DGPTMXV2<1)!(DGPTMXV2>90) S DGPTERC=535 Q
|
|---|
| 46 | Q
|
|---|
| 47 | SRVC ;
|
|---|
| 48 | I " 12"'[DGPT50SR S DGPTERC=530
|
|---|
| 49 | Q
|
|---|
| 50 | DC ;find discharge date
|
|---|
| 51 | S DGSCDT=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)
|
|---|
| 52 | Q
|
|---|
