16 lines
993 B
Mathematica
16 lines
993 B
Mathematica
|
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
|