Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAWFR4

RAWFR4.m

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