RANMUSE3.m

RANMUSE3 ;HISC/SWM-Nuclear Medicine Usage reports ;10/20/97  11:09

 ;;5.0;Radiology/Nuclear Medicine;**65,47**;Mar 16, 1998;Build 21

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

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

FOOTDIV ; footnotes division

 W !!,RANUMD(RASEQD),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0)

 D FOOT Q

FOOTIMG ; footnotes img type

 W !!,RANUMI(RASEQI),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0,RA1)

 D FOOT Q

FOOT W !!,"Notes: A case may have more than 1 radiopharm, so total no. unique cases may be less than total no. radiopharms listed."

 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

RANMUSE3  ;HISC/SWM-Nuclear Medicine Usage reports ;10/20/97  11:09

 +1       ;;5.0;Radiology/Nuclear Medicine;**65,47**;Mar 16, 1998;Build 21

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        SET RA0=0

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

FOOTDIV   ; footnotes division

 +1        WRITE !!,RANUMD(RASEQD),"'s Total number of unique cases: ",^TMP($JOB,"RATUNIQ",RA0)

 +2        DO FOOT

           QUIT 

FOOTIMG   ; footnotes img type

 +1        WRITE !!,RANUMI(RASEQI),"'s Total number of unique cases: ",^TMP($JOB,"RATUNIQ",RA0,RA1)

 +2        DO FOOT

           QUIT 

FOOT       WRITE !!,"Notes: A case may have more than 1 radiopharm, so total no. unique cases may be less than total no. radiopharms listed."

 +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