RALIST1 ;HISC/GJC-List all patients w/exams associated w/specific Amis ;4/8/96 14:55
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PRINT ;
S RADIVN="",(RACNT,RAIN,RAOUT)=0
F S RADIVN=$O(^TMP($J,"RALIST",RADIVN)) Q:RADIVN="" D Q:RAXIT
. S RAFLG=($O(^TMP($J,"RALIST",RADIVN,0))'>0) D HD Q:RAXIT
. S RACOUNT=0
. F S RACOUNT=$O(^TMP($J,"RALIST",RADIVN,RACOUNT)) Q:RACOUNT'>0 D Q:RAXIT
.. S TMP=^TMP($J,"RALIST",RADIVN,RACOUNT)
.. I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT S RAFLG=0 D HD Q:RAXIT
.. W !,$P(TMP,U),?30,$P(TMP,U,2),?49,$P(TMP,U,3),?50,$P(TMP,U,4)
.. W:IOM<132 !
.. W ?$S(IOM=132:90,1:90#80),$P(TMP,U,5)
.. W ?$S(IOM=132:110,1:110#80),$P(TMP,U,6)
.. Q
. Q:RAXIT
. I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT S RAFLG=1 D HD Q:RAXIT
. W !!,"Total=",+$G(RACNT(RADIVN)) S RACNT=RACNT+$G(RACNT(RADIVN))
. W " Inpatient=",+$G(RAIN(RADIVN)) S RAIN=RAIN+$G(RAIN(RADIVN))
. W " Outpatient=",+$G(RAOUT(RADIVN)) S RAOUT=RAOUT+$G(RAOUT(RADIVN))
. W !!,"+ counts as multiple exams",!,"- counts as zero exams"
. I $O(^TMP($J,"RALIST",RADIVN))]"" S RAXIT=$$EOS^RAUTL5()
. Q
Q:RAXIT
I RADIVNUM D ; more than one division!
. Q:$$EOS^RAUTL5() S X=""
. S RAFLG=1,RADIVN="ALL" D HD Q:RAXIT
. W !!,"Divisions Included: "
. F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X']"" D Q:RAXIT
.. I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD Q:RAXIT
.. W:$X>(IOM-30) !?($X+($L("Divisions Included: "))) W X,?($X+3)
.. Q
. W !!,"Grand Total=",RACNT," Inpatient=",RAIN," Outpatient=",RAOUT
. Q
Q
;
HD S PAGE=PAGE+1 W:PAGE>1!($E(IOST,1,2)="C-") @IOF
I IOM=132 D
. W !,">>>>> AMIS Code Dump by Patient <<<<<"
. W ?120,"Page: ",PAGE
. W !,"Patient List for AMIS Category ",RAMIS," - ",$E(RAMIS1,1,44)
. W !?90,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?102,END
. Q
E D ; Assume 80 column as default
. W !,">>>>> AMIS Code Dump by Patient <<<<<",?64,"Page: ",PAGE
. W !,"Patient List for AMIS Category ",RAMIS," - ",$E(RAMIS1,1,40)
. W !?49,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?61,END
. Q
W !,"Division: ",RADIVN
W !,"# of Procedures Selected: ",$S(RAINPUT:"All",1:$$PROCNUM())
I 'RAFLG D
. W !!,"Patient Name",?30,"Pt ID",?50,"Procedure"
. W:IOM<132 ! W ?$S(IOM=132:90,1:90#80),"Exam Date"
. W ?$S(IOM=132:110,1:110#80),"Ward/Clinic"
. W !,"------------",?30,"-----",?50,"---------"
. W:IOM<132 ! W ?$S(IOM=132:90,1:90#80),"-----------"
. W ?$S(IOM=132:110,1:110#80),"-----------"
. Q
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
NUMDIV() ; Returns boolean
; '0' if only one division selected
; '1' if more than one division selected
N X,Y
S X=$O(^TMP($J,"RA D-TYPE","")),Y=0
S:$O(^TMP($J,"RA D-TYPE",X))]"" Y=1
Q Y
PROCNUM() ; Return the number of procedures selected.
Q:'$D(^TMP($J,"RA P-TYPE")) 0
N X,Y S X=0,Y=""
F S Y=$O(^TMP($J,"RA P-TYPE",Y)) Q:Y']"" S X=X+1
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRALIST1 2930 printed Apr 09, 2024@21:35:59 Page 2
RALIST1 ;HISC/GJC-List all patients w/exams associated w/specific Amis ;4/8/96 14:55
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PRINT ;
+1 SET RADIVN=""
SET (RACNT,RAIN,RAOUT)=0
+2 FOR
SET RADIVN=$ORDER(^TMP($JOB,"RALIST",RADIVN))
if RADIVN=""
QUIT
Begin DoDot:1
+3 SET RAFLG=($ORDER(^TMP($JOB,"RALIST",RADIVN,0))'>0)
DO HD
if RAXIT
QUIT
+4 SET RACOUNT=0
+5 FOR
SET RACOUNT=$ORDER(^TMP($JOB,"RALIST",RADIVN,RACOUNT))
if RACOUNT'>0
QUIT
Begin DoDot:2
+6 SET TMP=^TMP($JOB,"RALIST",RADIVN,RACOUNT)
+7 IF $Y>(IOSL-5)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
SET RAFLG=0
DO HD
if RAXIT
QUIT
+8 WRITE !,$PIECE(TMP,U),?30,$PIECE(TMP,U,2),?49,$PIECE(TMP,U,3),?50,$PIECE(TMP,U,4)
+9 if IOM<132
WRITE !
+10 WRITE ?$SELECT(IOM=132:90,1:90#80),$PIECE(TMP,U,5)
+11 WRITE ?$SELECT(IOM=132:110,1:110#80),$PIECE(TMP,U,6)
+12 QUIT
End DoDot:2
if RAXIT
QUIT
+13 if RAXIT
QUIT
+14 IF $Y>(IOSL-5)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
SET RAFLG=1
DO HD
if RAXIT
QUIT
+15 WRITE !!,"Total=",+$GET(RACNT(RADIVN))
SET RACNT=RACNT+$GET(RACNT(RADIVN))
+16 WRITE " Inpatient=",+$GET(RAIN(RADIVN))
SET RAIN=RAIN+$GET(RAIN(RADIVN))
+17 WRITE " Outpatient=",+$GET(RAOUT(RADIVN))
SET RAOUT=RAOUT+$GET(RAOUT(RADIVN))
+18 WRITE !!,"+ counts as multiple exams",!,"- counts as zero exams"
+19 IF $ORDER(^TMP($JOB,"RALIST",RADIVN))]""
SET RAXIT=$$EOS^RAUTL5()
+20 QUIT
End DoDot:1
if RAXIT
QUIT
+21 if RAXIT
QUIT
+22 ; more than one division!
IF RADIVNUM
Begin DoDot:1
+23 if $$EOS^RAUTL5()
QUIT
SET X=""
+24 SET RAFLG=1
SET RADIVN="ALL"
DO HD
if RAXIT
QUIT
+25 WRITE !!,"Divisions Included: "
+26 FOR
SET X=$ORDER(^TMP($JOB,"RA D-TYPE",X))
if X']""
QUIT
Begin DoDot:2
+27 IF $Y>(IOSL-5)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD
if RAXIT
QUIT
+28 if $X>(IOM-30)
WRITE !?($X+($LENGTH("Divisions Included: ")))
WRITE X,?($X+3)
+29 QUIT
End DoDot:2
if RAXIT
QUIT
+30 WRITE !!,"Grand Total=",RACNT," Inpatient=",RAIN," Outpatient=",RAOUT
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
HD SET PAGE=PAGE+1
if PAGE>1!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+1 IF IOM=132
Begin DoDot:1
+2 WRITE !,">>>>> AMIS Code Dump by Patient <<<<<"
+3 WRITE ?120,"Page: ",PAGE
+4 WRITE !,"Patient List for AMIS Category ",RAMIS," - ",$EXTRACT(RAMIS1,1,44)
+5 WRITE !?90,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?102,END
+6 QUIT
End DoDot:1
+7 ; Assume 80 column as default
IF '$TEST
Begin DoDot:1
+8 WRITE !,">>>>> AMIS Code Dump by Patient <<<<<",?64,"Page: ",PAGE
+9 WRITE !,"Patient List for AMIS Category ",RAMIS," - ",$EXTRACT(RAMIS1,1,40)
+10 WRITE !?49,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?61,END
+11 QUIT
End DoDot:1
+12 WRITE !,"Division: ",RADIVN
+13 WRITE !,"# of Procedures Selected: ",$SELECT(RAINPUT:"All",1:$$PROCNUM())
+14 IF 'RAFLG
Begin DoDot:1
+15 WRITE !!,"Patient Name",?30,"Pt ID",?50,"Procedure"
+16 if IOM<132
WRITE !
WRITE ?$SELECT(IOM=132:90,1:90#80),"Exam Date"
+17 WRITE ?$SELECT(IOM=132:110,1:110#80),"Ward/Clinic"
+18 WRITE !,"------------",?30,"-----",?50,"---------"
+19 if IOM<132
WRITE !
WRITE ?$SELECT(IOM=132:90,1:90#80),"-----------"
+20 WRITE ?$SELECT(IOM=132:110,1:110#80),"-----------"
+21 QUIT
End DoDot:1
+22 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+23 QUIT
NUMDIV() ; Returns boolean
+1 ; '0' if only one division selected
+2 ; '1' if more than one division selected
+3 NEW X,Y
+4 SET X=$ORDER(^TMP($JOB,"RA D-TYPE",""))
SET Y=0
+5 if $ORDER(^TMP($JOB,"RA D-TYPE",X))]""
SET Y=1
+6 QUIT Y
PROCNUM() ; Return the number of procedures selected.
+1 if '$DATA(^TMP($JOB,"RA P-TYPE"))
QUIT 0
+2 NEW X,Y
SET X=0
SET Y=""
+3 FOR
SET Y=$ORDER(^TMP($JOB,"RA P-TYPE",Y))
if Y']""
QUIT
SET X=X+1
+4 QUIT X
