DGPT10CB ;ALB/MTC - Edit checks for Cat of Ben ; 12 NOV 92
 ;;5.3;Registration;**234,466**;Aug 13, 1993
 ;;
SET ;
 I ((DGPTPOS2'?1U)&(DGPTPOS2'?1N)) S DGPTERC=114 Q
 I "89MNPQRSTUX"[DGPTPOS2 Q
 S DGPTBYR=$E(DGPTDOB,5,8)
 I "6ABCDEFGHJKL"[DGPTPOS2 D ONE Q
 I DGPTPOS2="Z" D MT Q:DGPTERC  D POW Q:DGPTERC
 I "V0123457WYZ"'[DGPTPOS2 S DGPTERC=114 Q
 D @DGPTPOS2 Q
3 ;
 I ((DGPTBYR<1870)!(DGPTBYR>1936)) S DGPTERC=132 Q
 Q
1 ;
 I ((DGPTBYR<1870)!(DGPTBYR>1904)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2170406) S DGPTERC=131 Q
 Q
2 ;
 I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2411207) S DGPTERC=131 Q
 Q
4 ;
 I ((DGPTBYR<1870)!(DGPTBYR>1936)) S DGPTERC=132 Q
 Q
0 ;
 I ((DGPTBYR<1880)!(DGPTBYR>1941)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2500627) S DGPTERC=131 Q
 Q
5 ;
 I ((DGPTBYR<1885)!(DGPTBYR>1950)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2550201) S DGPTERC=131 Q
 Q
7 ;
 I ((DGPTBYR<1894)!(DGPTBYR>1961)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2640805) S DGPTERC=131 Q
 Q
V ;
 N LIEN,MIEN S (LIEN,MIEN)=""
 S LIEN=$P($G(VAEL(1)),U)
 I $G(LIEN)'="" S MIEN=$P($G(^DIC(8,LIEN,0)),U,9)
 I MIEN'=19 S DGPTERC=114
 Q
W ;
 I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2411207) S DGPTERC=131 Q
 Q
Y ;
 I ((+DGPTDTS)<2860930) S DGPTERC=131 Q
 Q
Z ;
 I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
 I ((+DGPTDTS)<2880119) S DGPTERC=131 Q
 Q
ONE ;
 I DGPTAGE<14 S DGPTERC=132 Q
 Q
MT ;
 Q:DGPTPOS2'="Z"
 I "ABCGUX"'[$E(DGPTMTC,1) S DGPTERC=119 Q
 I $E(DGPTMTC,1)="A"&("SN"'[$E(DGPTMTC,2)) S DGPTERC=119 Q
 I "BCGUX"[$E(DGPTMTC,1)&($E(DGPTMTC,2)'=" ") S DGPTERC=119 Q
 Q
POW ;
 Q:DGPTPOS2'="Z"
 I "1234"'[DGPTPOW S DGPTERC=110 Q
 Q