RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37
;;5.0;Radiology/Nuclear Medicine;**65,47,151**;Mar 16, 1998;Build 1
;;Per VA Directive 6402, this routine should not be modified
;
;Supported IA #10061 reference to DEM^VADPT
;
SET ; There are 2 parts: set local arrays and ^tmp()
;
; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce
; div and img-typ names to a single number, and so to reduce
; the length of the ^tmp() string
; raseqd("division name")=sequence number for alpha sort order
; raseqi("imaging type name")=sequence number for alpha sort order
; ranumd(sequence number for alpha sort order)="division name"
; ranumi(sequence number for alpha sort order)="imaging type name"
;
S RA1=0 F S RA1=$O(^RA(79,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2 RASEQD($P($G(^DIC(4,+RA2,0)),U))=""
S RA1="",RA2=1 F S RA1=$O(RASEQD(RA1)) Q:RA1="" S RASEQD(RA1)=RA2,RANUMD(RA2)=RA1,RA2=RA2+1
;
S RA1=0 F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2]"" RASEQI(RA2)=""
S RA1="",RA2=1 F S RA1=$O(RASEQI(RA1)) Q:RA1="" S RASEQI(RA1)=RA2,RANUMI(RA2)=RA1,RA2=RA2+1
;
; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno)
; S3 = sort field 3, either radiopharm/whoadmin or examdttm
; S4 = sort field 4, either examdttm or radiopharm/whoadmin
;
; Loop thru ^RADPTN("AB" to select recs within requested date range
;
S RA0=RADTBEG-.0001
S1 S RA0=$O(^RADPTN("AB",RA0)) Q:RA0="" Q:RA0>RADTEND S RA1=0
S2 S RA1=$O(^RADPTN("AB",RA0,RA1)) G:RA1="" S1
S RAN0=$G(^RADPTN(RA1,0)) G:RAN0="" S2
S RADFN=$P(RAN0,U) G:RADFN="" S2
S RADTI=9999999.9999-$P(RAN0,U,2) G:RADTI="" S2
S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",$P(RAN0,U,3),0)) G:RACNI="" S2
D EXTRACT
G S2
S P02=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:P02=""
S P03=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:P03=""
S RADIVNAM=$P($G(^DIC(4,+$P(P02,U,3),0)),U)
Q:'$D(^TMP($J,"RA D-TYPE",RADIVNAM)) ; div not selected
S RAIMGNAM=$P($G(^RA(79.2,+$P(P02,U,2),0)),U)
Q:'$D(^TMP($J,"RA I-TYPE",RAIMGNAM)) ; img typ not selected
S RA2=0
F1 S RA2=$O(^RADPTN(RA1,"NUC",RA2)) Q:RA2'=+RA2
S RANUC=^RADPTN(RA1,"NUC",RA2,0)
S RACN=$P(RAN0,U,3)
S RADIOPH=$$EN1^RAPSAPI(+$P(RANUC,U),.01) ; Radiopharm Name
I 'RAINPUT,RATITLE["Usage",'$D(^TMP($J,"RA EITHER",RADIOPH)) G F1 ;radioph not selectd
S RAWHO=$P($G(^VA(200,+$P(RANUC,U,9),0)),U) ; who administered dose
I RATITLE["Admin",RAWHO="" G F1 ;who admin dose is unknown
I 'RAINPUT,RATITLE["Admin",'$D(^TMP($J,"RA EITHER",RAWHO)) G F1 ;who not selectd
S RAXMDTM=$P(RAN0,U,2) ; exam date/time
S RAPRC0=$G(^RAMIS(71,+$P(P03,U,2),0)) ; procedure 0-node
S RAPRCNAM=$P(RAPRC0,U) ; procedure name
S DFN=RADFN D DEM^VADPT
S RAPATNAM=$P(VADM(1),U) ; patient name
S RASSN=$P(VADM(2),U,2) ; ssn
K VADM
S RADOSE=$P(RANUC,U,7) ; dose administered
S RADRAWN=$P(RANUC,U,4) ; activity drawn
I 'RADOSE,'RADRAWN G F1 ; dose admin and drawn both null/zero
; ien of procedure sub-record with matching radiopharm
; if user changes default radiopharm entry, or
; adds a radiopharm that's not defined in file 71 default radiopharm,
; the high and low values would be unknown
S RANUC1=$O(^RAMIS(71,+$P(P03,U,2),"NUC","B",+$P(RANUC,U),0))
; 0-node of procedure sub-record with matching radiopharm
S:RANUC1 RANUC1=^RAMIS(71,+$P(P03,U,2),"NUC",+RANUC1,0)
S RAHIGH=$P(RANUC1,U,5) ; high adult dose
S RALOW=$P(RANUC1,U,6) ; low adult dose
S RASTERSK=""
I RADOSE>0,RALOW>0,RADOSE<RALOW S RASTERSK="*"
I RADOSE>0,RAHIGH>0,RADOSE>RAHIGH S RASTERSK="*"
D S3S4
S ^TMP($J,"RA",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),S3,S4,$E(RAPATNAM,1,15),RACN,RADIOPH)=RASSN_U_RADRAWN_U_RADOSE_U_RAHIGH_U_RALOW_U_RAWHO_U_RASTERSK_U_RAPRCNAM
I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN)) S ^(RASEQI(RAIMGNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM)))+1,^(RASEQD(RADIVNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM)))+1
S RAEITHER=$S(RATITLE["Usage":RADIOPH,1:RAWHO)
I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER)) S ^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1,^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RAEITHER))+1
S ^(RASSN)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN))+1
S ^(RAEITHER)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1
; img typ totals
S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1
S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN
S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE
; "ratradio" is used for either radiopharm or who-admin-dose
S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1
; division totals
S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1
S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN
S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE
S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1
G F1
WRT S RASEQD=""
W1 S RASEQD=$O(^TMP($J,"RA",RASEQD)) Q:RASEQD="" S RASEQI=""
W2 S RASEQI=$O(^TMP($J,"RA",RASEQD,RASEQI)) G:RASEQI="" W1 S S3=""
S:RAPG>0 RAXIT=$$EOS^RAUTL5 Q:$G(RAXIT) D PGHD^RANMUSE3,COLHD^RANMUSE3
W3 S S3=$O(^TMP($J,"RA",RASEQD,RASEQI,S3)) G:S3="" W2 S S4=""
W4 S S4=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4)) G:S4="" W3 S RAPATNAM=""
W5 S RAPATNAM=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM)) G:RAPATNAM="" W4 S RACN=""
W6 S RACN=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN)) G:RACN="" W5 S RADIOPH=""
W7 S RADIOPH=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH)) G:RADIOPH="" W6 S RA1=^(RADIOPH)
S RALONGCN=$S(RASORT:S3,1:S4),RALONGCN=$E(RALONGCN,4,7)_$E(RALONGCN,2,3)_"-"_RACN_"@"_$E($P(RALONGCN,".",2)_"000",1,4)
;
; RA*5*151 - must reset RADFN,RADTI,RACNI before calling SSANVAL^RAHLRU1
S RADFN=$O(^RADPT("ADC",$P(RALONGCN,"@"),0))
S RADTI=$O(^RADPT("ADC",$P(RALONGCN,"@"),RADFN,0))
S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
S RACNDSP=$S((RASSAN'=""):RASSAN_"@"_$P(RALONGCN,"@",2),1:RALONGCN)
S RASSN=$P(RA1,U),RADRAWN=$P(RA1,U,2),RADOSE=$P(RA1,U,3),RAHIGH=$P(RA1,U,4),RALOW=$P(RA1,U,5),RAWHO=$P(RA1,U,6),RASTERSK=$P(RA1,U,7)
S RAPRCNAM=$P(RA1,U,8)
I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD^RANMUSE3,COLHD^RANMUSE3
I $$USESSAN^RAHLRU1() W !,RACNDSP,?22,$E(RAPATNAM,1,15),?38,RASSN,?50,$E(RADIOPH,1,14),?56,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?105,$E(RAPRCNAM,1,15),?121,$E(RAWHO,1,10),?131,RASTERSK
I '$$USESSAN^RAHLRU1() W !,RALONGCN,?16,$E(RAPATNAM,1,15),?32,RASSN,?44,$E(RADIOPH,1,15),?59,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?100,$E(RAPRCNAM,1,15),?116,$E(RAWHO,1,15),?131,RASTERSK
G W7
S3S4 ; set subscripts 3 and 4
I RATITLE["Usage" D Q
. I RASORT S S4=$E(RADIOPH,1,15),S3=RAXMDTM
. I 'RASORT S S3=$E(RADIOPH,1,15),S4=RAXMDTM
. Q
I RATITLE["Admin" D Q
. I RASORT S S4=$E(RAWHO,1,15),S3=RAXMDTM
. I 'RASORT S S3=$E(RAWHO,1,15),S4=RAXMDTM
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANMUSE2 7279 printed Nov 22, 2024@17:47:28 Page 2
RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37
+1 ;;5.0;Radiology/Nuclear Medicine;**65,47,151**;Mar 16, 1998;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 ;Supported IA #10061 reference to DEM^VADPT
+5 ;
SET ; There are 2 parts: set local arrays and ^tmp()
+1 ;
+2 ; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce
+3 ; div and img-typ names to a single number, and so to reduce
+4 ; the length of the ^tmp() string
+5 ; raseqd("division name")=sequence number for alpha sort order
+6 ; raseqi("imaging type name")=sequence number for alpha sort order
+7 ; ranumd(sequence number for alpha sort order)="division name"
+8 ; ranumi(sequence number for alpha sort order)="imaging type name"
+9 ;
+10 SET RA1=0
FOR
SET RA1=$ORDER(^RA(79,RA1))
if 'RA1
QUIT
SET RA2=$PIECE($GET(^(RA1,0)),U)
if RA2
SET RASEQD($PIECE($GET(^DIC(4,+RA2,0)),U))=""
+11 SET RA1=""
SET RA2=1
FOR
SET RA1=$ORDER(RASEQD(RA1))
if RA1=""
QUIT
SET RASEQD(RA1)=RA2
SET RANUMD(RA2)=RA1
SET RA2=RA2+1
+12 ;
+13 SET RA1=0
FOR
SET RA1=$ORDER(^RA(79.2,RA1))
if 'RA1
QUIT
SET RA2=$PIECE($GET(^(RA1,0)),U)
if RA2]""
SET RASEQI(RA2)=""
+14 SET RA1=""
SET RA2=1
FOR
SET RA1=$ORDER(RASEQI(RA1))
if RA1=""
QUIT
SET RASEQI(RA1)=RA2
SET RANUMI(RA2)=RA1
SET RA2=RA2+1
+15 ;
+16 ; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno)
+17 ; S3 = sort field 3, either radiopharm/whoadmin or examdttm
+18 ; S4 = sort field 4, either examdttm or radiopharm/whoadmin
+19 ;
+20 ; Loop thru ^RADPTN("AB" to select recs within requested date range
+21 ;
+22 SET RA0=RADTBEG-.0001
S1 SET RA0=$ORDER(^RADPTN("AB",RA0))
if RA0=""
QUIT
if RA0>RADTEND
QUIT
SET RA1=0
S2 SET RA1=$ORDER(^RADPTN("AB",RA0,RA1))
if RA1=""
GOTO S1
+1 SET RAN0=$GET(^RADPTN(RA1,0))
if RAN0=""
GOTO S2
+2 SET RADFN=$PIECE(RAN0,U)
if RADFN=""
GOTO S2
+3 SET RADTI=9999999.9999-$PIECE(RAN0,U,2)
if RADTI=""
GOTO S2
+4 SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",$PIECE(RAN0,U,3),0))
if RACNI=""
GOTO S2
+5 DO EXTRACT
+6 GOTO S2
+1 SET P02=$GET(^RADPT(RADFN,"DT",RADTI,0))
if P02=""
QUIT
+2 SET P03=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if P03=""
QUIT
+3 SET RADIVNAM=$PIECE($GET(^DIC(4,+$PIECE(P02,U,3),0)),U)
+4 ; div not selected
if '$DATA(^TMP($JOB,"RA D-TYPE",RADIVNAM))
QUIT
+5 SET RAIMGNAM=$PIECE($GET(^RA(79.2,+$PIECE(P02,U,2),0)),U)
+6 ; img typ not selected
if '$DATA(^TMP($JOB,"RA I-TYPE",RAIMGNAM))
QUIT
+7 SET RA2=0
F1 SET RA2=$ORDER(^RADPTN(RA1,"NUC",RA2))
if RA2'=+RA2
QUIT
+1 SET RANUC=^RADPTN(RA1,"NUC",RA2,0)
+2 SET RACN=$PIECE(RAN0,U,3)
+3 ; Radiopharm Name
SET RADIOPH=$$EN1^RAPSAPI(+$PIECE(RANUC,U),.01)
+4 ;radioph not selectd
IF 'RAINPUT
IF RATITLE["Usage"
IF '$DATA(^TMP($JOB,"RA EITHER",RADIOPH))
GOTO F1
+5 ; who administered dose
SET RAWHO=$PIECE($GET(^VA(200,+$PIECE(RANUC,U,9),0)),U)
+6 ;who admin dose is unknown
IF RATITLE["Admin"
IF RAWHO=""
GOTO F1
+7 ;who not selectd
IF 'RAINPUT
IF RATITLE["Admin"
IF '$DATA(^TMP($JOB,"RA EITHER",RAWHO))
GOTO F1
+8 ; exam date/time
SET RAXMDTM=$PIECE(RAN0,U,2)
+9 ; procedure 0-node
SET RAPRC0=$GET(^RAMIS(71,+$PIECE(P03,U,2),0))
+10 ; procedure name
SET RAPRCNAM=$PIECE(RAPRC0,U)
+11 SET DFN=RADFN
DO DEM^VADPT
+12 ; patient name
SET RAPATNAM=$PIECE(VADM(1),U)
+13 ; ssn
SET RASSN=$PIECE(VADM(2),U,2)
+14 KILL VADM
+15 ; dose administered
SET RADOSE=$PIECE(RANUC,U,7)
+16 ; activity drawn
SET RADRAWN=$PIECE(RANUC,U,4)
+17 ; dose admin and drawn both null/zero
IF 'RADOSE
IF 'RADRAWN
GOTO F1
+18 ; ien of procedure sub-record with matching radiopharm
+19 ; if user changes default radiopharm entry, or
+20 ; adds a radiopharm that's not defined in file 71 default radiopharm,
+21 ; the high and low values would be unknown
+22 SET RANUC1=$ORDER(^RAMIS(71,+$PIECE(P03,U,2),"NUC","B",+$PIECE(RANUC,U),0))
+23 ; 0-node of procedure sub-record with matching radiopharm
+24 if RANUC1
SET RANUC1=^RAMIS(71,+$PIECE(P03,U,2),"NUC",+RANUC1,0)
+25 ; high adult dose
SET RAHIGH=$PIECE(RANUC1,U,5)
+26 ; low adult dose
SET RALOW=$PIECE(RANUC1,U,6)
+27 SET RASTERSK=""
+28 IF RADOSE>0
IF RALOW>0
IF RADOSE<RALOW
SET RASTERSK="*"
+29 IF RADOSE>0
IF RAHIGH>0
IF RADOSE>RAHIGH
SET RASTERSK="*"
+30 DO S3S4
+31 SET ^TMP($JOB,"RA",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),S3,S4,$EXTRACT(RAPATNAM,1,15),RACN,RADIOPH)=RASSN_U_RADRAWN_U_RADOSE_U_RAHIGH_U_RALOW_U_RAWHO_U_RASTERSK_U_RAPRCNAM
+32 IF '$DATA(^TMP($JOB,"RASUM",$SELECT(RASORT:S3,1:S4),RACN,RASSN))
SET ^(RASEQI(RAIMGNAM))=$GET(^TMP($JOB,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM)))+1
SET ^(RASEQD(RADIVNAM))=$GET(^TMP($JOB,"RATUNIQ",RASEQD(RADIVNAM)))+1
+33 SET RAEITHER=$SELECT(RATITLE["Usage":RADIOPH,1:RAWHO)
+34 IF '$DATA(^TMP($JOB,"RASUM",$SELECT(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))
SET ^(RAEITHER)=$GET(^TMP($JOB,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1
SET ^(RAEITHER)=$GET(^TMP($JOB,"RATUNIQ",RASEQD(RADIVNAM),RAEITHER))+1
+35 SET ^(RASSN)=$GET(^TMP($JOB,"RASUM",$SELECT(RASORT:S3,1:S4),RACN,RASSN))+1
+36 SET ^(RAEITHER)=$GET(^TMP($JOB,"RASUM",$SELECT(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1
+37 ; img typ totals
+38 if RASTERSK="*"
SET ^(RAEITHER)=$GET(^TMP($JOB,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1
+39 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN
+40 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE
+41 ; "ratradio" is used for either radiopharm or who-admin-dose
+42 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1
+43 ; division totals
+44 if RASTERSK="*"
SET ^(RAEITHER)=$GET(^TMP($JOB,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1
+45 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN
+46 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE
+47 SET ^(RAEITHER)=$GET(^TMP($JOB,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1
+48 GOTO F1
WRT SET RASEQD=""
W1 SET RASEQD=$ORDER(^TMP($JOB,"RA",RASEQD))
if RASEQD=""
QUIT
SET RASEQI=""
W2 SET RASEQI=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI))
if RASEQI=""
GOTO W1
SET S3=""
+1 if RAPG>0
SET RAXIT=$$EOS^RAUTL5
if $GET(RAXIT)
QUIT
DO PGHD^RANMUSE3
DO COLHD^RANMUSE3
W3 SET S3=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI,S3))
if S3=""
GOTO W2
SET S4=""
W4 SET S4=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI,S3,S4))
if S4=""
GOTO W3
SET RAPATNAM=""
W5 SET RAPATNAM=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM))
if RAPATNAM=""
GOTO W4
SET RACN=""
W6 SET RACN=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN))
if RACN=""
GOTO W5
SET RADIOPH=""
W7 SET RADIOPH=$ORDER(^TMP($JOB,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH))
if RADIOPH=""
GOTO W6
SET RA1=^(RADIOPH)
+1 SET RALONGCN=$SELECT(RASORT:S3,1:S4)
SET RALONGCN=$EXTRACT(RALONGCN,4,7)_$EXTRACT(RALONGCN,2,3)_"-"_RACN_"@"_$EXTRACT($PIECE(RALONGCN,".",2)_"000",1,4)
+2 ;
+3 ; RA*5*151 - must reset RADFN,RADTI,RACNI before calling SSANVAL^RAHLRU1
+4 SET RADFN=$ORDER(^RADPT("ADC",$PIECE(RALONGCN,"@"),0))
+5 SET RADTI=$ORDER(^RADPT("ADC",$PIECE(RALONGCN,"@"),RADFN,0))
+6 SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
+7 NEW RASSAN,RACNDSP
SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+8 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN_"@"_$PIECE(RALONGCN,"@",2),1:RALONGCN)
+9 SET RASSN=$PIECE(RA1,U)
SET RADRAWN=$PIECE(RA1,U,2)
SET RADOSE=$PIECE(RA1,U,3)
SET RAHIGH=$PIECE(RA1,U,4)
SET RALOW=$PIECE(RA1,U,5)
SET RAWHO=$PIECE(RA1,U,6)
SET RASTERSK=$PIECE(RA1,U,7)
+10 SET RAPRCNAM=$PIECE(RA1,U,8)
+11 IF ($Y+4)>IOSL!(RAPG=0)
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
DO PGHD^RANMUSE3
DO COLHD^RANMUSE3
+12 IF $$USESSAN^RAHLRU1()
WRITE !,RACNDSP,?22,$EXTRACT(RAPATNAM,1,15),?38,RASSN,?50,$EXTRACT(RADIOPH,1,14),?56,$JUSTIFY(RADRAWN,10,4),?69,$JUSTIFY(RADOSE,10,4),?79,$JUSTIFY(RALOW,10,4),?89,$JUSTIFY(RAHIGH,10,4),?105,$EXTRACT(RAPRCNAM,1,15),?121,$EXTRACT(RAWHO,1,10),
?131,RASTERSK
+13 IF '$$USESSAN^RAHLRU1()
WRITE !,RALONGCN,?16,$EXTRACT(RAPATNAM,1,15),?32,RASSN,?44,$EXTRACT(RADIOPH,1,15),?59,$JUSTIFY(RADRAWN,10,4),?69,$JUSTIFY(RADOSE,10,4),?79,$JUSTIFY(RALOW,10,4),?89,$JUSTIFY(RAHIGH,10,4),?100,$EXTRACT(RAPRCNAM,1,15),?116,$EXTRACT(RAWHO,1,15)
,?131,RASTERSK
+14 GOTO W7
S3S4 ; set subscripts 3 and 4
+1 IF RATITLE["Usage"
Begin DoDot:1
+2 IF RASORT
SET S4=$EXTRACT(RADIOPH,1,15)
SET S3=RAXMDTM
+3 IF 'RASORT
SET S3=$EXTRACT(RADIOPH,1,15)
SET S4=RAXMDTM
+4 QUIT
End DoDot:1
QUIT
+5 IF RATITLE["Admin"
Begin DoDot:1
+6 IF RASORT
SET S4=$EXTRACT(RAWHO,1,15)
SET S3=RAXMDTM
+7 IF 'RASORT
SET S3=$EXTRACT(RAWHO,1,15)
SET S4=RAXMDTM
+8 QUIT
End DoDot:1
QUIT
+9 QUIT
