source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWFR4.m@ 1714

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1RAWFR4 ;HISC/GJC-'Wasted Film Report' (4 of 4) ;10/7/94 14:28
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3DISPLAY(A) ; Outputs the I-Types associated with a division
4 ; The division name is passed in as a parameter.
5 N B,RATAB S B="",RATAB=3
6 W !!,"Division: ",A,!?RATAB,"Imaging Type(s): "
7 F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D Q:RAXIT
8 . I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR^RAWFR3
9 . W:$X>(IOM-30) !?($X+RATAB+$L("Imaging Type(s): "))
10 . W B,?($X+RATAB)
11 . Q
12 Q
13DISPXAM(A) ; Display Examination Statuses which meet certain criteria.
14 ; 'A' is the equivalent of the variable 'RAWFR'. This code is related
15 ; to the 'CRIT^RAUTL1' subroutine. This sets up the RAWFR local array
16 ; according to I-Type.
17 N RA,RAHD,UNDRLN,X,Y,Z
18 S RAHD(0)="The entries printed for this report will be based only"
19 S RAHD(1)="on exams that are in one of the following statuses:"
20 W !!?(IOM-$L(RAHD(0))\2),RAHD(0),!?(IOM-$L(RAHD(1))\2),RAHD(1)
21 S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT
22 . I $D(^RA(72,"AA",X)) K UNDRLN S Y="" D
23 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
24 .. S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN
25 .. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT
26 ... S Z=0 F S Z=$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT
27 .... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3))
28 .... S RA(.3,A)=$P(RA(.3),"^",A)
29 .... I RA(0)]"",(RA(.3)]""),(RA(.3,A)]""),("Yy"[RA(.3,A)) D
30 ..... S RAWFR(Z)=X ; Where 'X' is the I-Type
31 ..... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
32 ...... W @IOF,!?10,X,!?10,UNDRLN
33 ...... Q
34 ..... W !?15,$P(RA(0),"^")
35 ..... Q
36 .... Q
37 ... Q
38 .. Q
39 . Q
40 Q
41ZEROUT ; Zero out global array totals for division/i-type
42 N X,Y,Z S RATOT=0,X="",Z=$S(RASYN=1:"S",1:"NS")
43 F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
44 . Q:'$D(^TMP($J,"RA D-TYPE",X))
45 . S RATOT=RATOT+1,^TMP($J,"RA WFR",Z,X)=0,Y=""
46 . F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D
47 .. Q:'$D(^TMP($J,"RA I-TYPE",Y))
48 .. S ^TMP($J,"RA WFR",Z,X,"I",Y)=0
49 .. S ^TMP($J,"RA WFR",Z,X,"I",Y,"F"," ")=0
50 .. S ^TMP($J,"RA WFR",Z,X,"I",Y,"WF"," ")=0
51 .. Q
52 . Q
53 Q
Note: See TracBrowser for help on using the repository browser.