RANMUSE3 ;HISC/SWM-Nuclear Medicine Usage reports ; Aug 20, 2020@07:23:45
;;5.0;Radiology/Nuclear Medicine;**65,47,173**;Mar 16, 1998;Build 1
PGHD ; Page Header
I RAPG!($E(IOST,1,2)="C-") W:$Y>0 @IOF
S RAPG=RAPG+1
W !?35,">>> "_RATITLE_" Report <<<",?90,"Run Date: ",RATDY
W ?121,"Page: ",RAPG
W !?50,$S($G(RAHDTYP)="D":"(Division",$G(RAHDTYP)="I":"(Imaging",1:"") W:$G(RAHDTYP)]"" " Summary)"
W ?85,"For: ",RADTBEG("X")," - ",RADTEND("X")
W !,"Division: ",RANUMD(RASEQD) W:$G(RAHDTYP)'="D" ?45,"Imaging Type: ",RANUMI(RASEQI)
Q
COLHD ; Column Header for detailed report
I $$USESSAN^RAHLRU1() W !!,"Long-Case@Time",?22,"Patient Name",?38,"SSN",?50,"Radiopharm",?65,"Act.Drawn",?75,"Dose Adm'd",?88,"Low",?98,"High",?105,"Procedure",?121,"Who Adm'd"
I '$$USESSAN^RAHLRU1() W !!,"Long-Case@Time",?16,"Patient Name",?35,"SSN",?44,"Radiopharm",?59,"Act.Drawn",?69,"Dose Adm'd",?83,"Low",?93,"High",?100,"Procedure",?116,"Who Adm'd"
W !,RALN
Q
COLHDS ; Column Header for summary report
W !!,$S(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose"),?35,"Total Drawn",?50,"Total Adm'd",?64,"No. cases",?79,"(%)",?90,"No. outside range"
W !,RALN
Q
SUM S RAXIT=$$EOS^RAUTL5 Q:RAXIT
S RA0=0,RA2="" ;p173 RA2 previously used and has value.
SM0 S RA0=$O(^TMP($J,"RATUNIQ",RA0)) Q:'RA0 S RA1=0
SM2 S RA1=$O(^TMP($J,"RATUNIQ",RA0,RA1)) I RA1'=+RA1 D DIVSUM Q:RAXIT G SM0
; if RA1 is alpha, then node is for division summary
; if RA1 is numeric, then node is for imaging summary
S RASEQD=RA0,RASEQI=RA1
S RAHDTYP="I" D PGHD,COLHDS
SM3 S RA2=$O(^TMP($J,"RATUNIQ",RA0,RA1,RA2)) I RA2="" D FOOTIMG S RAXIT=$$EOS^RAUTL5 Q:RAXIT G SM2
W !,$E(RA2,1,30)
W ?30,$J($G(^TMP($J,"RATDRAWN",RA0,RA1,RA2)),15,4)
W ?45,$J($G(^TMP($J,"RATDOSE",RA0,RA1,RA2)),15,4)
W ?64,$J($G(^TMP($J,"RATUNIQ",RA0,RA1,RA2)),7)
W ?78,$J(100*$S(+$G(^TMP($J,"RATUNIQ",RA0,RA1))=0:0,1:$G(^TMP($J,"RATUNIQ",RA0,RA1,RA2))/^TMP($J,"RATUNIQ",RA0,RA1)),5,2)
W ?90,$J($G(^TMP($J,"RATOUTSD",RA0,RA1,RA2)),7)
I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD,COLHDS
G SM3
DIVSUM ;
; skip div summary page if div has only 1 img typ
Q:$O(^TMP($J,"RATUNIQ",RA0,0))=$O(^TMP($J,"RATUNIQ",RA0,"A"),-1)
S RAHDTYP="D",RA2="A"
D PGHD,COLHDS
DV1 S RA2=$O(^TMP($J,"RATUNIQ",RA0,RA2))
I RA2="" D FOOTDIV S RAXIT=$$EOS^RAUTL5 Q
W !,$E(RA2,1,30)
W ?30,$J($G(^TMP($J,"RATDRAWN",RA0,RA2)),15,4)
W ?45,$J($G(^TMP($J,"RATDOSE",RA0,RA2)),15,4)
W ?64,$J($G(^TMP($J,"RATUNIQ",RA0,RA2)),7)
W ?78,$J(100*$S(+$G(^TMP($J,"RATUNIQ",RA0))=0:0,1:$G(^TMP($J,"RATUNIQ",RA0,RA2))/^TMP($J,"RATUNIQ",RA0)),5,2)
W ?90,$J($G(^TMP($J,"RATOUTSD",RA0,RA2)),7)
I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD,COLHDS
G DV1
W !!,RANUMD(RASEQD),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0)
D FOOT Q
W !!,RANUMI(RASEQI),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0,RA1)
D FOOT Q
W !," * denotes administered dosage outside of normal range."
Q:RAINPUT
W !!,$S(RATITLE["Usage":"Radiopharm",1:"Dose administerers")," selected for this report :" W !?6
S RA2=0 F S RA2=$O(^TMP($J,"RA EITHER",RA2)) Q:RA2="" W:$X+$L(RA2)>(IOM+2) !?6 W RA2 W:$O(^(RA2))]"" ", "
Q
ZERO ; zero out total for imaging type(s) and associated division(s) w/o data
S RA0=""
Z1 S RA0=$O(^TMP($J,"RA D-TYPE",RA0)) Q:RA0']"" S RA1=""
Z2 S RA1=$O(RACCESS(DUZ,"DIV-IMG",RA0,RA1)) G:RA1']"" Z1
G:'$D(^TMP($J,"RA I-TYPE",RA1)) Z2
S:'$D(^TMP($J,"RATUNIQ",RASEQD(RA0),RASEQI(RA1))) ^TMP($J,"RATUNIQ",RASEQD(RA0),RASEQI(RA1))=0
S:'($D(^TMP($J,"RATUNIQ",RASEQD(RA0)))#2) ^TMP($J,"RATUNIQ",RASEQD(RA0))=0
G Z2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANMUSE3 3838 printed Dec 13, 2024@02:37:32 Page 2
RANMUSE3 ;HISC/SWM-Nuclear Medicine Usage reports ; Aug 20, 2020@07:23:45
+1 ;;5.0;Radiology/Nuclear Medicine;**65,47,173**;Mar 16, 1998;Build 1
PGHD ; Page Header
+1 IF RAPG!($EXTRACT(IOST,1,2)="C-")
if $Y>0
WRITE @IOF
+2 SET RAPG=RAPG+1
+3 WRITE !?35,">>> "_RATITLE_" Report <<<",?90,"Run Date: ",RATDY
+4 WRITE ?121,"Page: ",RAPG
+5 WRITE !?50,$SELECT($GET(RAHDTYP)="D":"(Division",$GET(RAHDTYP)="I":"(Imaging",1:"")
if $GET(RAHDTYP)]""
WRITE " Summary)"
+6 WRITE ?85,"For: ",RADTBEG("X")," - ",RADTEND("X")
+7 WRITE !,"Division: ",RANUMD(RASEQD)
if $GET(RAHDTYP)'="D"
WRITE ?45,"Imaging Type: ",RANUMI(RASEQI)
+8 QUIT
COLHD ; Column Header for detailed report
+1 IF $$USESSAN^RAHLRU1()
WRITE !!,"Long-Case@Time",?22,"Patient Name",?38,"SSN",?50,"Radiopharm",?65,"Act.Drawn",?75,"Dose Adm'd",?88,"Low",?98,"High",?105,"Procedure",?121,"Who Adm'd"
+2 IF '$$USESSAN^RAHLRU1()
WRITE !!,"Long-Case@Time",?16,"Patient Name",?35,"SSN",?44,"Radiopharm",?59,"Act.Drawn",?69,"Dose Adm'd",?83,"Low",?93,"High",?100,"Procedure",?116,"Who Adm'd"
+3 WRITE !,RALN
+4 QUIT
COLHDS ; Column Header for summary report
+1 WRITE !!,$SELECT(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose"),?35,"Total Drawn",?50,"Total Adm'd",?64,"No. cases",?79,"(%)",?90,"No. outside range"
+2 WRITE !,RALN
+3 QUIT
SUM SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
+1 ;p173 RA2 previously used and has value.
SET RA0=0
SET RA2=""
SM0 SET RA0=$ORDER(^TMP($JOB,"RATUNIQ",RA0))
if 'RA0
QUIT
SET RA1=0
SM2 SET RA1=$ORDER(^TMP($JOB,"RATUNIQ",RA0,RA1))
IF RA1'=+RA1
DO DIVSUM
if RAXIT
QUIT
GOTO SM0
+1 ; if RA1 is alpha, then node is for division summary
+2 ; if RA1 is numeric, then node is for imaging summary
+3 SET RASEQD=RA0
SET RASEQI=RA1
+4 SET RAHDTYP="I"
DO PGHD
DO COLHDS
SM3 SET RA2=$ORDER(^TMP($JOB,"RATUNIQ",RA0,RA1,RA2))
IF RA2=""
DO FOOTIMG
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
GOTO SM2
+1 WRITE !,$EXTRACT(RA2,1,30)
+2 WRITE ?30,$JUSTIFY($GET(^TMP($JOB,"RATDRAWN",RA0,RA1,RA2)),15,4)
+3 WRITE ?45,$JUSTIFY($GET(^TMP($JOB,"RATDOSE",RA0,RA1,RA2)),15,4)
+4 WRITE ?64,$JUSTIFY($GET(^TMP($JOB,"RATUNIQ",RA0,RA1,RA2)),7)
+5 WRITE ?78,$JUSTIFY(100*$SELECT(+$GET(^TMP($JOB,"RATUNIQ",RA0,RA1))=0:0,1:$GET(^TMP($JOB,"RATUNIQ",RA0,RA1,RA2))/^TMP($JOB,"RATUNIQ",RA0,RA1)),5,2)
+6 WRITE ?90,$JUSTIFY($GET(^TMP($JOB,"RATOUTSD",RA0,RA1,RA2)),7)
+7 IF ($Y+4)>IOSL!(RAPG=0)
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
DO PGHD
DO COLHDS
+8 GOTO SM3
DIVSUM ;
+1 ; skip div summary page if div has only 1 img typ
+2 if $ORDER(^TMP($JOB,"RATUNIQ",RA0,0))=$ORDER(^TMP($JOB,"RATUNIQ",RA0,"A"),-1)
QUIT
+3 SET RAHDTYP="D"
SET RA2="A"
+4 DO PGHD
DO COLHDS
DV1 SET RA2=$ORDER(^TMP($JOB,"RATUNIQ",RA0,RA2))
+1 IF RA2=""
DO FOOTDIV
SET RAXIT=$$EOS^RAUTL5
QUIT
+2 WRITE !,$EXTRACT(RA2,1,30)
+3 WRITE ?30,$JUSTIFY($GET(^TMP($JOB,"RATDRAWN",RA0,RA2)),15,4)
+4 WRITE ?45,$JUSTIFY($GET(^TMP($JOB,"RATDOSE",RA0,RA2)),15,4)
+5 WRITE ?64,$JUSTIFY($GET(^TMP($JOB,"RATUNIQ",RA0,RA2)),7)
+6 WRITE ?78,$JUSTIFY(100*$SELECT(+$GET(^TMP($JOB,"RATUNIQ",RA0))=0:0,1:$GET(^TMP($JOB,"RATUNIQ",RA0,RA2))/^TMP($JOB,"RATUNIQ",RA0)),5,2)
+7 WRITE ?90,$JUSTIFY($GET(^TMP($JOB,"RATOUTSD",RA0,RA2)),7)
+8 IF ($Y+4)>IOSL!(RAPG=0)
SET RAXIT=$$EOS^RAUTL5
if RAXIT
QUIT
DO PGHD
DO COLHDS
+9 GOTO DV1
+1 WRITE !!,RANUMD(RASEQD),"'s Total number of unique cases: ",^TMP($JOB,"RATUNIQ",RA0)
+2 DO FOOT
QUIT
+1 WRITE !!,RANUMI(RASEQI),"'s Total number of unique cases: ",^TMP($JOB,"RATUNIQ",RA0,RA1)
+2 DO FOOT
QUIT
+1 WRITE !," * denotes administered dosage outside of normal range."
+2 if RAINPUT
QUIT
+3 WRITE !!,$SELECT(RATITLE["Usage":"Radiopharm",1:"Dose administerers")," selected for this report :"
WRITE !?6
+4 SET RA2=0
FOR
SET RA2=$ORDER(^TMP($JOB,"RA EITHER",RA2))
if RA2=""
QUIT
if $X+$LENGTH(RA2)>(IOM+2)
WRITE !?6
WRITE RA2
if $ORDER(^(RA2))]""
WRITE ", "
+5 QUIT
ZERO ; zero out total for imaging type(s) and associated division(s) w/o data
+1 SET RA0=""
Z1 SET RA0=$ORDER(^TMP($JOB,"RA D-TYPE",RA0))
if RA0']""
QUIT
SET RA1=""
Z2 SET RA1=$ORDER(RACCESS(DUZ,"DIV-IMG",RA0,RA1))
if RA1']""
GOTO Z1
+1 if '$DATA(^TMP($JOB,"RA I-TYPE",RA1))
GOTO Z2
+2 if '$DATA(^TMP($JOB,"RATUNIQ",RASEQD(RA0),RASEQI(RA1)))
SET ^TMP($JOB,"RATUNIQ",RASEQD(RA0),RASEQI(RA1))=0
+3 if '($DATA(^TMP($JOB,"RATUNIQ",RASEQD(RA0)))#2)
SET ^TMP($JOB,"RATUNIQ",RASEQD(RA0))=0
+4 GOTO Z2
