54 lines
2.1 KiB
Mathematica
54 lines
2.1 KiB
Mathematica
RAWFR4 ;HISC/GJC-'Wasted Film Report' (4 of 4) ;10/7/94 14:28
|
|
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|
DISPLAY(A) ; Outputs the I-Types associated with a division
|
|
; The division name is passed in as a parameter.
|
|
N B,RATAB S B="",RATAB=3
|
|
W !!,"Division: ",A,!?RATAB,"Imaging Type(s): "
|
|
F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D Q:RAXIT
|
|
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR^RAWFR3
|
|
. W:$X>(IOM-30) !?($X+RATAB+$L("Imaging Type(s): "))
|
|
. W B,?($X+RATAB)
|
|
. Q
|
|
Q
|
|
DISPXAM(A) ; Display Examination Statuses which meet certain criteria.
|
|
; 'A' is the equivalent of the variable 'RAWFR'. This code is related
|
|
; to the 'CRIT^RAUTL1' subroutine. This sets up the RAWFR local array
|
|
; according to I-Type.
|
|
N RA,RAHD,UNDRLN,X,Y,Z
|
|
S RAHD(0)="The entries printed for this report will be based only"
|
|
S RAHD(1)="on exams that are in one of the following statuses:"
|
|
W !!?(IOM-$L(RAHD(0))\2),RAHD(0),!?(IOM-$L(RAHD(1))\2),RAHD(1)
|
|
S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT
|
|
. I $D(^RA(72,"AA",X)) K UNDRLN S Y="" D
|
|
.. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
|
|
.. S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN
|
|
.. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT
|
|
... S Z=0 F S Z=$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT
|
|
.... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3))
|
|
.... S RA(.3,A)=$P(RA(.3),"^",A)
|
|
.... I RA(0)]"",(RA(.3)]""),(RA(.3,A)]""),("Yy"[RA(.3,A)) D
|
|
..... S RAWFR(Z)=X ; Where 'X' is the I-Type
|
|
..... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
|
|
...... W @IOF,!?10,X,!?10,UNDRLN
|
|
...... Q
|
|
..... W !?15,$P(RA(0),"^")
|
|
..... Q
|
|
.... Q
|
|
... Q
|
|
.. Q
|
|
. Q
|
|
Q
|
|
ZEROUT ; Zero out global array totals for division/i-type
|
|
N X,Y,Z S RATOT=0,X="",Z=$S(RASYN=1:"S",1:"NS")
|
|
F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
|
|
. Q:'$D(^TMP($J,"RA D-TYPE",X))
|
|
. S RATOT=RATOT+1,^TMP($J,"RA WFR",Z,X)=0,Y=""
|
|
. F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D
|
|
.. Q:'$D(^TMP($J,"RA I-TYPE",Y))
|
|
.. S ^TMP($J,"RA WFR",Z,X,"I",Y)=0
|
|
.. S ^TMP($J,"RA WFR",Z,X,"I",Y,"F"," ")=0
|
|
.. S ^TMP($J,"RA WFR",Z,X,"I",Y,"WF"," ")=0
|
|
.. Q
|
|
. Q
|
|
Q
|