- 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 Feb 19, 2025@00:02:53 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
