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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1DGPTAE02 ;ALB/MTC - 701 Edit Checks ;11/01/2005
2 ;;5.3;Registration;**8,22,39,114,176,251,247,270,446,418,482,466,683,729**;Aug 13, 1993;Build 59
3 ;10/06/1999 ACS - Added Place of Disposition codes M,Y,Z to the
4 ;validity checks
5 ;5/15/2000 ACS - Added Treating Specialty 37 as a valid code
6 ;5/16/2000 MM - Added Treating Specialties 38 & 39 as valid codes
7 ;5/26/2000 JRP - Place of Disposition code M valid for station
8 ; types 10, 11, 30, and 40
9 ;09/27/2006 JRC - Added Treating Specialties 13, 30, 48, 49, 78,
10 ; 82 and 97
11 ;
12CHECK ;
13 I (DGPTSP1'?1AN)!(DGPTSP2'?1AN) S DGPTERC=1 Q
14 I DGPTSP1="0"&((DGPTSP2'?1AN)!(DGPTSP2="0")) S DGPTERC=1 G EXIT
15 ; No zero or double zeroes allowed
16 I DGPTSP1=5 G EXIT
17 ; All codes 50-59 allowable
18 ; New code 95:p-418
19 ; New code 96;p-446
20EXIT ;
21 K DGPTSP1,DGPTSP2
22 Q
23 ;
24DISPTY ;
25 N I
26 S DGPTERC=0
27 Q:"1"[DGPTDTY
28 I DGPTDTY=2 S DGPTERC=707 F I=10,11,30,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
29 I DGPTERC Q
30 ;
31 ;-- if dis type = To Non-Bed Care then VA aus and Out pat = no
32 ;I DGPTDTY=2,((DGPTDVA'=2)!(DGPTDOP'=3)) S DGPTERC=707 Q
33 ;
34 I DGPTDTY=3&(DGPTSTTY'["^42^") S DGPTERC=707 Q
35 ;-- if dis type = Transfer then Out pat cannot be yes
36 I DGPTDTY=5,DGPTDOP=1 S DGPTERC=707
37 ;-- if dis type = Transfer then Out pat cannot be yes, rec sta'=""
38 I DGPTDTY=5,DGPTDOP'=1,'DGPTDRF S DGPTERC=711 Q
39 ;-- if dis type irr, death w/aotopsy then va asp, op care, pod = ""
40 I "467"[DGPTDTY,(DGPTDOP!DGPTDVA!DGPTDPD) S DGPTERC=707 Q
41 Q
42OP ;
43 Q:"13"'[DGPTDOP
44 S DGPTERC=708 F I=10,11,40,42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
45 Q
46POD ;
47 N I
48 Q:"X012347BCDFGHJKL "[DGPTDPD
49 ; if POD NHCU then Out=no VA aus=yes
50 I DGPTDPD=5,((DGPTDOP'=3)!(DGPTDVA'=1)) S DGPTERC=710 Q
51 ; if POD NHCU then Out=no VA aus=yes, rec station'=""
52 I DGPTDPD=5,DGPTDOP=3,DGPTDVA=1,'DGPTDRF S DGPTERC=711 Q
53 I "PR"[DGPTDPD,((DGPTSTTY'["^10^")!(DGPTSTTY'["^11^")) S DGPTERC=710 Q
54 I DGPTDPD="M" S DGPTERC=710 F I=10,11,30,40 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
55 I DGPTDPD="T" S DGPTERC=710 F I=10,11,40 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
56 I "UYZ"[DGPTDPD S DGPTERC=710 F I=10,11,20:1:27,30,40:1:42 I DGPTSTTY["^"_I_"^" S DGPTERC=0 Q
57 Q
58LEAVE ;
59 S DGPTLVDY=0
60 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)
61 I (DGPTLVDY+DGPTDAS)>DGPTELP S DGPTERC=745
62 K DGPTL3,DGPTLVDY
63 Q
64 ;
65CANDP ;
66 I "12345678"'[DGPTDCP S DGPTERC=714 Q
67 ;-- if no POS then no edit
68 Q:DGPTPOS2=9
69 ;-- if WWI then no edit
70 Q:DGPTPOS2=1
71 ;-- if POW then no edit
72 I $L(DGPTPOW)=1,("23456789AB"[DGPTPOW) Q
73 D CONSIS Q:DGPTERC
74 D STATYP Q:DGPTERC
75 D CPMT Q:DGPTERC
76 Q
77CONSIS ;
78 I ("01234578X"[DGPTPOS2)&("1234567"'[DGPTDCP) S DGPTERC=736 Q
79 I ("ABCD"[DGPTPOS2) Q
80 I DGPTPOS2="Z"&("1234567"'[DGPTDCP) S DGPTERC=736 Q
81 Q:"012345678ABCDXZ"[DGPTPOS2
82 S:DGPTDCP'=8 DGPTERC=736
83 Q
84STATYP ;
85 Q:(DGPTSTTY["^30^")!(DGPTSTTY="^")!(DGPTSTTY="")
86 ;Note: There is not sufficient information contained in the
87 ;station type to adequately perform the error check of Means Test
88 ;indicator vs admissions date. This issue should be revisited in 5.4.
89 ;For now, error code 143 (previously set as 744) will not be checked
90 ;in order to be sure that an error is not erroneously generated.
91 Q
92MT ;
93 I DGPTMTC="X "&((+DGPTDTS)'<2860701) S DGPTERC=143 Q
94 Q:DGPTMTC="X "
95 I DGPTDTS<2860701 S DGPTERC=143 Q
96 Q
97 ;
98CPMT ;-- mt and c&p checks
99 I DGPTMTC="N ",DGPTDCP'=8 S DGPTERC=753 Q
100 I DGPTMTC="AN","24567"'[DGPTDCP S DGPTERC=753 Q
101 I ((DGPTMTC="B ")!(DGPTMTC="C ")!(DGPTMTC="G ")),"2467"'[DGPTDCP S DGPTERC=753 Q
102 I DGPTMTC="AS","1234567"'[DGPTDCP S DGPTERC=753 Q
103 Q
104LEG ;
105 ;I DGPTDDXE=482.8&("12"'[DGPT70LG) S DGPTERC=731 Q
106 Q
107SUI ;
108 N DGINACT
109 I ($E(DGPTDDXE,1,3)="E95")&("12345678"[$E(DGPTDDXE,4))&("12"'[DGPT70SU) D
110 . I '$D(DGSCDT) D DC
111 . S DGINACT=$$GET1^DIQ(45.88,"2,",.03,"I")
112 . I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
113 . S DGPTERC=732 Q
114 Q
115DRUG ;
116 S DGPTMSX=0
117 I ($E(DGPTDDXE,1,4)="304.")&("013456"[$E(DGPTDDXE,5))&("0123"[$E(DGPTDDXE,6)) S DGPTMSX=1
118 I ($E(DGPTDDXE,1,4)="305.")&("234579"[$E(DGPTDDXE,5))&("0123"[$E(DGPTDDXE,6)) S DGPTMSX=1
119 Q:'DGPTMSX
120 N DGINACT
121 I $E(DGPT70DR,1)'="A"!($E(DGPT70DR,2,4)<1)!(+$E(DGPT70DR>16)) D
122 . I '$D(DGSCDT) D DC
123 . S DGINACT=$$GET1^DIQ(45.88,"4,",.03,"I")
124 . I DGINACT]"",$D(DGSCDT) Q:DGSCDT>DGINACT
125 . S DGPTERC=733
126 S DGPTMSX=0 Q
127AXIV ;
128 I $E(DGPTDDXE,1,3)>295,$E(DGPTDDXE,1,3)<320,"0123456"'[DGPT70X4 S DGPTERC=734
129 Q
130AXV1 ;
131 I (DGPTDXV1<0)!(DGPTDXV1>90) S DGPTERC=735 Q
132 Q
133AXV2 ;
134 Q:DGPTDXV2=" "
135 I (DGPTDXV2<0)!(DGPTDXV2>90) S DGPTERC=735 Q
136 Q
137DC ;find discharge date
138 S DGSCDT=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT)
139 Q
Note: See TracBrowser for help on using the repository browser.