source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPT50MS.m@ 1672

Last change on this file since 1672 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1DGPT50MS ;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 ;
6LEG ;
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
9SUI ;
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
18DRUG ;
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
23DRG1 ;
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
32AXIV ;
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
38AXV1 ;
39 Q:'DGPTMSX
40 I (DGPTMXV1<1)!(DGPTMXV1>90) S DGPTERC=535 Q
41 Q
42AXV2 ;
43 Q:'DGPTMSX
44 Q:DGPTMXV2=" "
45 I (DGPTMXV2<1)!(DGPTMXV2>90) S DGPTERC=535 Q
46 Q
47SRVC ;
48 I " 12"'[DGPT50SR S DGPTERC=530
49 Q
50DC ;find discharge date
51 S DGSCDT=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)
52 Q
Note: See TracBrowser for help on using the repository browser.