RAMIS2.m

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

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