source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RALIST1.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1RALIST1 ;HISC/GJC-List all patients w/exams associated w/specific Amis ;4/8/96 14:55
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3PRINT ;
4 S RADIVN="",(RACNT,RAIN,RAOUT)=0
5 F S RADIVN=$O(^TMP($J,"RALIST",RADIVN)) Q:RADIVN="" D Q:RAXIT
6 . S RAFLG=($O(^TMP($J,"RALIST",RADIVN,0))'>0) D HD Q:RAXIT
7 . S RACOUNT=0
8 . F S RACOUNT=$O(^TMP($J,"RALIST",RADIVN,RACOUNT)) Q:RACOUNT'>0 D Q:RAXIT
9 .. S TMP=^TMP($J,"RALIST",RADIVN,RACOUNT)
10 .. I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT S RAFLG=0 D HD Q:RAXIT
11 .. W !,$P(TMP,U),?30,$P(TMP,U,2),?49,$P(TMP,U,3),?50,$P(TMP,U,4)
12 .. W:IOM<132 !
13 .. W ?$S(IOM=132:90,1:90#80),$P(TMP,U,5)
14 .. W ?$S(IOM=132:110,1:110#80),$P(TMP,U,6)
15 .. Q
16 . Q:RAXIT
17 . I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT S RAFLG=1 D HD Q:RAXIT
18 . W !!,"Total=",+$G(RACNT(RADIVN)) S RACNT=RACNT+$G(RACNT(RADIVN))
19 . W " Inpatient=",+$G(RAIN(RADIVN)) S RAIN=RAIN+$G(RAIN(RADIVN))
20 . W " Outpatient=",+$G(RAOUT(RADIVN)) S RAOUT=RAOUT+$G(RAOUT(RADIVN))
21 . W !!,"+ counts as multiple exams",!,"- counts as zero exams"
22 . I $O(^TMP($J,"RALIST",RADIVN))]"" S RAXIT=$$EOS^RAUTL5()
23 . Q
24 Q:RAXIT
25 I RADIVNUM D ; more than one division!
26 . Q:$$EOS^RAUTL5() S X=""
27 . S RAFLG=1,RADIVN="ALL" D HD Q:RAXIT
28 . W !!,"Divisions Included: "
29 . F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X']"" D Q:RAXIT
30 .. I $Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD Q:RAXIT
31 .. W:$X>(IOM-30) !?($X+($L("Divisions Included: "))) W X,?($X+3)
32 .. Q
33 . W !!,"Grand Total=",RACNT," Inpatient=",RAIN," Outpatient=",RAOUT
34 . Q
35 Q
36 ;
37HD S PAGE=PAGE+1 W:PAGE>1!($E(IOST,1,2)="C-") @IOF
38 I IOM=132 D
39 . W !,">>>>> AMIS Code Dump by Patient <<<<<"
40 . W ?120,"Page: ",PAGE
41 . W !,"Patient List for AMIS Category ",RAMIS," - ",$E(RAMIS1,1,44)
42 . W !?90,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?102,END
43 . Q
44 E D ; Assume 80 column as default
45 . W !,">>>>> AMIS Code Dump by Patient <<<<<",?64,"Page: ",PAGE
46 . W !,"Patient List for AMIS Category ",RAMIS," - ",$E(RAMIS1,1,40)
47 . W !?49,"For Period: ",BEG," to",!,"Run Date: ",RANOW,?61,END
48 . Q
49 W !,"Division: ",RADIVN
50 W !,"# of Procedures Selected: ",$S(RAINPUT:"All",1:$$PROCNUM())
51 I 'RAFLG D
52 . W !!,"Patient Name",?30,"Pt ID",?50,"Procedure"
53 . W:IOM<132 ! W ?$S(IOM=132:90,1:90#80),"Exam Date"
54 . W ?$S(IOM=132:110,1:110#80),"Ward/Clinic"
55 . W !,"------------",?30,"-----",?50,"---------"
56 . W:IOM<132 ! W ?$S(IOM=132:90,1:90#80),"-----------"
57 . W ?$S(IOM=132:110,1:110#80),"-----------"
58 . Q
59 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
60 Q
61NUMDIV() ; Returns boolean
62 ; '0' if only one division selected
63 ; '1' if more than one division selected
64 N X,Y
65 S X=$O(^TMP($J,"RA D-TYPE","")),Y=0
66 S:$O(^TMP($J,"RA D-TYPE",X))]"" Y=1
67 Q Y
68PROCNUM() ; Return the number of procedures selected.
69 Q:'$D(^TMP($J,"RA P-TYPE")) 0
70 N X,Y S X=0,Y=""
71 F S Y=$O(^TMP($J,"RA P-TYPE",Y)) Q:Y']"" S X=X+1
72 Q X
Note: See TracBrowser for help on using the repository browser.