RAPROQ ;HISC/CAH,FPT,GJC AISC/MJK-Exam Profile (quick) ;9/12/94  11:21
 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PAT S DIC(0)="AEMQ" D ^RADPA G Q:Y<0 S RADFN=+Y D RT G Q:$D(RTESC) S RAHEAD="**** Registered Exams Quick Profile ****" S RAF1=1 D ^RAPTLU G Q:X="^" G PAT:'$D(RADUP)
 D Q1 F RAK=0:0 S RAK=$O(RADUP(RAK)) Q:RAK'>0  S Y=^TMP($J,"RAEX",RAK) D SET,^RAPROD
Q K RAF1,RADUP,RAK,RAJ,^TMP($J,"RAEX"),X,Y,DIC,N,RAI,RAPAR,RASEL
 K RACNI,RACN,RADATE,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,RASSN,RAST
 ;
Q1 K RTFL,RTESC,RAF1,RAHEAD,RAPROC Q
SET F RAJ=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",RAJ)=$P(Y,"^",RAJ)
 S Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) Q
 ;
RT Q:'$D(^DIC(195.4,1,"RAD"))  S Y=+^("RAD") S:$D(RTAPL) RARTAPL=+RTAPL D APL1^RTPSET:$S('$D(RTAPL):1,1:Y'=+RTAPL)
 I $D(RTAPL) S RTE=RADFN_";DPT(",RTDC("S")="I $P(^(0),U,4)="_+RTAPL D ^RTUTL2 S RTFL="" K RT1,RTC,RTDC,RTE,RTAPL,RTSYS
 I $D(RARTAPL) S Y=RARTAPL D APL1^RTPSET K RARTAPL
 Q