- 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 Jan 18, 2025@03:38:24 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