1 | RAPROQ ;HISC/CAH,FPT,GJC AISC/MJK-Exam Profile (quick) ;9/12/94 11:21
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
---|
3 | 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)
|
---|
4 | D Q1 F RAK=0:0 S RAK=$O(RADUP(RAK)) Q:RAK'>0 S Y=^TMP($J,"RAEX",RAK) D SET,^RAPROD
|
---|
5 | Q K RAF1,RADUP,RAK,RAJ,^TMP($J,"RAEX"),X,Y,DIC,N,RAI,RAPAR,RASEL
|
---|
6 | K RACNI,RACN,RADATE,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,RASSN,RAST
|
---|
7 | ;
|
---|
8 | Q1 K RTFL,RTESC,RAF1,RAHEAD,RAPROC Q
|
---|
9 | SET F RAJ=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",RAJ)=$P(Y,"^",RAJ)
|
---|
10 | S Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) Q
|
---|
11 | ;
|
---|
12 | 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)
|
---|
13 | 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
|
---|
14 | I $D(RARTAPL) S Y=RARTAPL D APL1^RTPSET K RARTAPL
|
---|
15 | Q
|
---|