| 1 | DGPT10S1 ;ALB/MTC - Source of Admission Edit ; 13 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**58**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; SET UP TYPE OF FACILITY REPORTING ADMISSION
|
|---|
| 5 | ; CHECK SOURCE OF ADMISSION FOR CORRECTNESS AND CONSISTENCY WITH STATION TYPE
|
|---|
| 6 | ; DGPTSTTY=TYPE OF STATION REPORTING EPISODE
|
|---|
| 7 | ; DGPTXTTY=TYPE OF STATION TRANSFERRING PATIENT IN
|
|---|
| 8 | EN ;
|
|---|
| 9 | N SUFFIX
|
|---|
| 10 | S DGPTXTTY=""
|
|---|
| 11 | ;I DGPTTF=" " Q
|
|---|
| 12 | S SUFFIX=$P($E(DGPTTF,4,6)," ")
|
|---|
| 13 | ;I SUFFIX="" Q
|
|---|
| 14 | I SUFFIX]"" I $D(^DIC(45.81,"D1",SUFFIX)) S DGPTXTTY=$O(^(SUFFIX,0))
|
|---|
| 15 | LOOP ;
|
|---|
| 16 | D EDIT Q:DGPTERC
|
|---|
| 17 | D CONSIS Q:DGPTERC
|
|---|
| 18 | EXIT ;
|
|---|
| 19 | K DGPTXTT1
|
|---|
| 20 | Q
|
|---|
| 21 | EDIT ;
|
|---|
| 22 | S DGPTS1=$E(DGPTSRA,1),DGPTS2=$E(DGPTSRA,2)
|
|---|
| 23 | I "1234567"'[DGPTS1 S DGPTERC=107 Q
|
|---|
| 24 | I DGPTS1=1&("DEGHJKLMPRST"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 25 | I DGPTS1=2&("ABC"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 26 | I DGPTS1=3&("ABCDE"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 27 | I DGPTS1=4&("ABCDEFGHJKLMNPQRSTUWY"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 28 | I DGPTS1=5&("ABCDEFG"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 29 | I DGPTS1=6&("ABCD"'[DGPTS2) S DGPTERC=107 Q
|
|---|
| 30 | I DGPTS1=7&(DGPTS2'="B") S DGPTERC=107 Q
|
|---|
| 31 | Q
|
|---|
| 32 | CONSIS ;
|
|---|
| 33 | D @DGPTS1 Q
|
|---|
| 34 | 1 ;
|
|---|
| 35 | I DGPTXTTY="" Q
|
|---|
| 36 | I DGPTSRA="1D"&(DGPTXTTY'=40) S DGPTERC=135 Q
|
|---|
| 37 | I DGPTSRA="1E"&(DGPTXTTY'=30) S DGPTERC=135 Q
|
|---|
| 38 | I DGPTSRA="1G"&(DGPTXTTY'=42) S DGPTERC=135 Q
|
|---|
| 39 | I "HJKMP"[DGPTS2&(DGPTXTTY'="") S DGPTERC=135 Q
|
|---|
| 40 | Q
|
|---|
| 41 | 2 ;
|
|---|
| 42 | Q
|
|---|
| 43 | 3 ;
|
|---|
| 44 | I DGPTTF="" S DGPTERC=135 Q
|
|---|
| 45 | Q
|
|---|
| 46 | 4 ;
|
|---|
| 47 | I DGPTXTTY="" Q
|
|---|
| 48 | I DGPTSRA="4A"&("110"'[DGPTXTTY) S DGPTERC=135 Q
|
|---|
| 49 | I DGPTSRA="4C"&(DGPTXTTY'=40) S DGPTERC=135 Q
|
|---|
| 50 | I "ED"[DGPTS2&(DGPTXTTY'=30) S DGPTERC=135 Q
|
|---|
| 51 | I DGPTSRA="4F"&((DGPTXTTY'=25)&(DGPTXTTY'=26)) S DGPTERC=135 Q
|
|---|
| 52 | I DGPTSRA="4H"&(DGPTXTTY'=42) S DGPTERC=135 Q
|
|---|
| 53 | I DGPTSRA="4K"&(DGPTXTTY'=32) S DGPTERC=135 Q
|
|---|
| 54 | I DGPTSRA="4L"&(DGPTXTTY'=41) S DGPTERC=135 Q
|
|---|
| 55 | I DGPTSRA="4M"&((DGPTXTTY'=20)&(DGPTXTTY'=21)&(DGPTXTTY'=22)) S DGPTERC=135 Q
|
|---|
| 56 | I DGPTSRA="4N"&((DGPTXTTY'=23)&(DGPTXTTY'=24)) S DGPTERC=135 Q
|
|---|
| 57 | I DGPTSRA="4R"&(DGPTXTTY'=25) S DGPTERC=135 Q
|
|---|
| 58 | I "GBJPQSTUWY"[DGPTS2&(DGPTXTTY'="") S DGPTERC=135 Q
|
|---|
| 59 | Q
|
|---|
| 60 | 5 ;
|
|---|
| 61 | I DGPTXTTY="" Q
|
|---|
| 62 | I DGPTSRA="5A"&("110"'[DGPTXTTY) S DGPTERC=135 Q
|
|---|
| 63 | I DGPTSRA="5B"&((DGPTXTTY<20)!(DGPTXTTY>26)) S DGPTERC=135 Q
|
|---|
| 64 | I DGPTSRA="5C"&(DGPTXTTY'=30) S DGPTERC=135 Q
|
|---|
| 65 | I "ED"[DGPTS2&(DGPTXTTY'=40) S DGPTERC=135 Q
|
|---|
| 66 | I DGPTSRA="5F"&(DGPTXTTY'=42) S DGPTERC=135 Q
|
|---|
| 67 | ;- commented out for DG*5.3*58 as XX is not a valid station type
|
|---|
| 68 | ;I DGPTSRA="5G"&(DGPTXTTY'="XX") S DGPTERC=135 Q
|
|---|
| 69 | Q
|
|---|
| 70 | 6 ;
|
|---|
| 71 | I DGPTXTTY="" Q
|
|---|
| 72 | I DGPTSRA="6A"&("110"'[DGPTXTTY) S DGPTERC=135 Q
|
|---|
| 73 | I DGPTSRA="6B"&(DGPTXTTY'=40) S DGPTERC=135 Q
|
|---|
| 74 | I DGPTSRA="6C"&(DGPTXTTY'=42) S DGPTERC=135 Q
|
|---|
| 75 | ;- commented out for DG*5.3*58 as XX is not a valid station type
|
|---|
| 76 | ;I DGPTSRA="6D"&(DGPTXTTY'="XX") S DGPTERC=135 Q
|
|---|
| 77 | Q
|
|---|
| 78 | 7 ;
|
|---|
| 79 | I DGPTXTTY="" Q
|
|---|
| 80 | I DGPTSRA="7B"&((DGPTXTTY<20)!(DGPTXTTY>22)) S DGPTERC=135 Q
|
|---|
| 81 | Q
|
|---|
