RAMIS2 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;9/12/94 11:07
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
CHK S RADFLAG=0 K ^TMP($J,"RA D-TYPE")
I $P($G(^RA(79,0)),U,4)>1 D
. D SELDIV^RAUTL7
. I $O(^TMP($J,"RA D-TYPE",""))=""!$G(RAQUIT) D
.. W !!?5,"No divisions selected" K RADFLAG
.. Q
. Q
E D ALLDIV
Q
ALLDIV N C,RAD0,RADIVN,Y S RAD0=0
F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
. S (RADIVN,Y)=+$P($G(^RA(79,RAD0,0)),U)
. I $O(RACCESS(DUZ,"DIV",RADIVN,0))'>0 Q
. S C=$P(^DD(79,.01,0),U,2) D Y^DIQ S RADIVN(0)=Y
. S ^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)=""
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMIS2 602 printed Oct 16, 2024@18:37:59 Page 2
RAMIS2 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;9/12/94 11:07
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
CHK SET RADFLAG=0
KILL ^TMP($JOB,"RA D-TYPE")
+1 IF $PIECE($GET(^RA(79,0)),U,4)>1
Begin DoDot:1
+2 DO SELDIV^RAUTL7
+3 IF $ORDER(^TMP($JOB,"RA D-TYPE",""))=""!$GET(RAQUIT)
Begin DoDot:2
+4 WRITE !!?5,"No divisions selected"
KILL RADFLAG
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 IF '$TEST
DO ALLDIV
+8 QUIT
ALLDIV NEW C,RAD0,RADIVN,Y
SET RAD0=0
+1 FOR
SET RAD0=$ORDER(^RA(79,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+2 SET (RADIVN,Y)=+$PIECE($GET(^RA(79,RAD0,0)),U)
+3 IF $ORDER(RACCESS(DUZ,"DIV",RADIVN,0))'>0
QUIT
+4 SET C=$PIECE(^DD(79,.01,0),U,2)
DO Y^DIQ
SET RADIVN(0)=Y
+5 SET ^TMP($JOB,"RA D-TYPE",RADIVN(0),RADIVN)=""
+6 QUIT
End DoDot:1
+7 QUIT
