| 1 | RAWFR4 ;HISC/GJC-'Wasted Film Report' (4 of 4) ;10/7/94 14:28
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | DISPLAY(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
|
|---|
| 13 | DISPXAM(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
|
|---|
| 41 | ZEROUT ; 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
|
|---|
