| 1 | DGPT10CB ;ALB/MTC - Edit checks for Cat of Ben ; 12 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**234,466**;Aug 13, 1993
|
|---|
| 3 | ;;
|
|---|
| 4 | SET ;
|
|---|
| 5 | I ((DGPTPOS2'?1U)&(DGPTPOS2'?1N)) S DGPTERC=114 Q
|
|---|
| 6 | I "89MNPQRSTUX"[DGPTPOS2 Q
|
|---|
| 7 | S DGPTBYR=$E(DGPTDOB,5,8)
|
|---|
| 8 | I "6ABCDEFGHJKL"[DGPTPOS2 D ONE Q
|
|---|
| 9 | I DGPTPOS2="Z" D MT Q:DGPTERC D POW Q:DGPTERC
|
|---|
| 10 | I "V0123457WYZ"'[DGPTPOS2 S DGPTERC=114 Q
|
|---|
| 11 | D @DGPTPOS2 Q
|
|---|
| 12 | 3 ;
|
|---|
| 13 | I ((DGPTBYR<1870)!(DGPTBYR>1936)) S DGPTERC=132 Q
|
|---|
| 14 | Q
|
|---|
| 15 | 1 ;
|
|---|
| 16 | I ((DGPTBYR<1870)!(DGPTBYR>1904)) S DGPTERC=132 Q
|
|---|
| 17 | I ((+DGPTDTS)<2170406) S DGPTERC=131 Q
|
|---|
| 18 | Q
|
|---|
| 19 | 2 ;
|
|---|
| 20 | I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
|
|---|
| 21 | I ((+DGPTDTS)<2411207) S DGPTERC=131 Q
|
|---|
| 22 | Q
|
|---|
| 23 | 4 ;
|
|---|
| 24 | I ((DGPTBYR<1870)!(DGPTBYR>1936)) S DGPTERC=132 Q
|
|---|
| 25 | Q
|
|---|
| 26 | 0 ;
|
|---|
| 27 | I ((DGPTBYR<1880)!(DGPTBYR>1941)) S DGPTERC=132 Q
|
|---|
| 28 | I ((+DGPTDTS)<2500627) S DGPTERC=131 Q
|
|---|
| 29 | Q
|
|---|
| 30 | 5 ;
|
|---|
| 31 | I ((DGPTBYR<1885)!(DGPTBYR>1950)) S DGPTERC=132 Q
|
|---|
| 32 | I ((+DGPTDTS)<2550201) S DGPTERC=131 Q
|
|---|
| 33 | Q
|
|---|
| 34 | 7 ;
|
|---|
| 35 | I ((DGPTBYR<1894)!(DGPTBYR>1961)) S DGPTERC=132 Q
|
|---|
| 36 | I ((+DGPTDTS)<2640805) S DGPTERC=131 Q
|
|---|
| 37 | Q
|
|---|
| 38 | V ;
|
|---|
| 39 | N LIEN,MIEN S (LIEN,MIEN)=""
|
|---|
| 40 | S LIEN=$P($G(VAEL(1)),U)
|
|---|
| 41 | I $G(LIEN)'="" S MIEN=$P($G(^DIC(8,LIEN,0)),U,9)
|
|---|
| 42 | I MIEN'=19 S DGPTERC=114
|
|---|
| 43 | Q
|
|---|
| 44 | W ;
|
|---|
| 45 | I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
|
|---|
| 46 | I ((+DGPTDTS)<2411207) S DGPTERC=131 Q
|
|---|
| 47 | Q
|
|---|
| 48 | Y ;
|
|---|
| 49 | I ((+DGPTDTS)<2860930) S DGPTERC=131 Q
|
|---|
| 50 | Q
|
|---|
| 51 | Z ;
|
|---|
| 52 | I ((DGPTBYR<1871)!(DGPTBYR>1932)) S DGPTERC=132 Q
|
|---|
| 53 | I ((+DGPTDTS)<2880119) S DGPTERC=131 Q
|
|---|
| 54 | Q
|
|---|
| 55 | ONE ;
|
|---|
| 56 | I DGPTAGE<14 S DGPTERC=132 Q
|
|---|
| 57 | Q
|
|---|
| 58 | MT ;
|
|---|
| 59 | Q:DGPTPOS2'="Z"
|
|---|
| 60 | I "ABCGUX"'[$E(DGPTMTC,1) S DGPTERC=119 Q
|
|---|
| 61 | I $E(DGPTMTC,1)="A"&("SN"'[$E(DGPTMTC,2)) S DGPTERC=119 Q
|
|---|
| 62 | I "BCGUX"[$E(DGPTMTC,1)&($E(DGPTMTC,2)'=" ") S DGPTERC=119 Q
|
|---|
| 63 | Q
|
|---|
| 64 | POW ;
|
|---|
| 65 | Q:DGPTPOS2'="Z"
|
|---|
| 66 | I "1234"'[DGPTPOW S DGPTERC=110 Q
|
|---|
| 67 | Q
|
|---|
