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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPROQ 1008 printed Dec 13, 2024@02:38:53 Page 2
RAPROQ ;HISC/CAH,FPT,GJC AISC/MJK-Exam Profile (quick) ;9/12/94 11:21
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PAT SET DIC(0)="AEMQ"
DO ^RADPA
if Y<0
GOTO Q
SET RADFN=+Y
DO RT
if $DATA(RTESC)
GOTO Q
SET RAHEAD="**** Registered Exams Quick Profile ****"
SET RAF1=1
DO ^RAPTLU
if X="^"
GOTO Q
if '$DATA(RADUP)
GOTO PAT
+1 DO Q1
FOR RAK=0:0
SET RAK=$ORDER(RADUP(RAK))
if RAK'>0
QUIT
SET Y=^TMP($JOB,"RAEX",RAK)
DO SET
DO ^RAPROD
Q KILL RAF1,RADUP,RAK,RAJ,^TMP($JOB,"RAEX"),X,Y,DIC,N,RAI,RAPAR,RASEL
+1 KILL RACNI,RACN,RADATE,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,RASSN,RAST
+2 ;
Q1 KILL RTFL,RTESC,RAF1,RAHEAD,RAPROC
QUIT
SET FOR RAJ=1:1:11
SET @$PIECE("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",RAJ)=$PIECE(Y,"^",RAJ)
+1 SET Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
QUIT
+2 ;
RT if '$DATA(^DIC(195.4,1,"RAD"))
QUIT
SET Y=+^("RAD")
if $DATA(RTAPL)
SET RARTAPL=+RTAPL
if $SELECT('$DATA(RTAPL):1,1:Y'=+RTAPL)
DO APL1^RTPSET
+1 IF $DATA(RTAPL)
SET RTE=RADFN_";DPT("
SET RTDC("S")="I $P(^(0),U,4)="_+RTAPL
DO ^RTUTL2
SET RTFL=""
KILL RT1,RTC,RTDC,RTE,RTAPL,RTSYS
+2 IF $DATA(RARTAPL)
SET Y=RARTAPL
DO APL1^RTPSET
KILL RARTAPL
+3 QUIT
