- 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 Feb 19, 2025@00:03:48 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