| [613] | 1 | RAMIS2 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;9/12/94 11:07
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | CHK S RADFLAG=0 K ^TMP($J,"RA D-TYPE")
|
|---|
| 4 | I $P($G(^RA(79,0)),U,4)>1 D
|
|---|
| 5 | . D SELDIV^RAUTL7
|
|---|
| 6 | . I $O(^TMP($J,"RA D-TYPE",""))=""!$G(RAQUIT) D
|
|---|
| 7 | .. W !!?5,"No divisions selected" K RADFLAG
|
|---|
| 8 | .. Q
|
|---|
| 9 | . Q
|
|---|
| 10 | E D ALLDIV
|
|---|
| 11 | Q
|
|---|
| 12 | ALLDIV N C,RAD0,RADIVN,Y S RAD0=0
|
|---|
| 13 | F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
|
|---|
| 14 | . S (RADIVN,Y)=+$P($G(^RA(79,RAD0,0)),U)
|
|---|
| 15 | . I $O(RACCESS(DUZ,"DIV",RADIVN,0))'>0 Q
|
|---|
| 16 | . S C=$P(^DD(79,.01,0),U,2) D Y^DIQ S RADIVN(0)=Y
|
|---|
| 17 | . S ^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)=""
|
|---|
| 18 | . Q
|
|---|
| 19 | Q
|
|---|
