Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAMIS2

RAMIS2.m

Go to the documentation of this file.
  1. RAMIS2 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;9/12/94 11:07
  1. ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. CHK S RADFLAG=0 K ^TMP($J,"RA D-TYPE")
  1. I $P($G(^RA(79,0)),U,4)>1 D
  1. . D SELDIV^RAUTL7
  1. . I $O(^TMP($J,"RA D-TYPE",""))=""!$G(RAQUIT) D
  1. .. W !!?5,"No divisions selected" K RADFLAG
  1. .. Q
  1. . Q
  1. E D ALLDIV
  1. Q
  1. ALLDIV N C,RAD0,RADIVN,Y S RAD0=0
  1. F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
  1. . S (RADIVN,Y)=+$P($G(^RA(79,RAD0,0)),U)
  1. . I $O(RACCESS(DUZ,"DIV",RADIVN,0))'>0 Q
  1. . S C=$P(^DD(79,.01,0),U,2) D Y^DIQ S RADIVN(0)=Y
  1. . S ^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)=""
  1. . Q
  1. Q