source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADLQ3.m@ 1211

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

revised back to 6/30/08 version

File size: 4.1 KB
Line 
1RADLQ3 ;HISC/GJC-Delq Status/Incomplete Rpt's ;5/7/97 15:58
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3DISPXAM ; Display exam statuses for selected Imaging Types. These exam
4 ; statuses need the 'DELINQUENT STATUS REPORT?' field tripped to
5 ; 'yes' in file 72.
6 N RA,RAHD,UNDRLN,X,Y,Z
7 S RAHD(0)="The entries printed for this report will be based only"
8 S RAHD(1)="on exams that are in one of the following statuses:"
9 I '$D(RALL) D
10 . W !!?(IOM-$L(RAHD(0))\2),RAHD(0)
11 . W !?(IOM-$L(RAHD(1))\2),RAHD(1)
12 . Q
13 S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT
14 . I $D(^RA(72,"AA",X)) S Y="" K UNDRLN D
15 .. I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
16 .. I '$D(RALL) S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN
17 .. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT
18 ... S Z=0 F S Z=+$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT
19 .... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3))
20 .... S RA(.3,15)=$P(RA(.3),"^",15)
21 .... I RA(0)]"",(RA(.3)]""),(RA(.3,15)]""),("Yy"[RA(.3,15)) D
22 ..... S RACRT(Z)=""
23 ..... I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
24 ...... W @IOF,!?10,X,!?10,UNDRLN
25 ...... Q
26 ..... W:'$D(RALL) !?15,$P(RA(0),"^")
27 ..... Q
28 .... Q
29 ... Q
30 .. Q
31 . Q
32 Q
33OUTPUT ; Print out the results
34 N RAEOS I $D(RAVAR(0)),(RAVAR(0)'=RAVAR) S RAEOS=6
35 E S RAEOS=4
36 F I=1:1:$L(RANODE,"^") D
37 . S @$P("RACN^RAPRC^RAST^RADT^RAWHE^RARP^RASSN^RAVRFIED^RAIPHY^RATECH","^",I)=$P(RANODE,"^",I)
38 . Q
39 I $Y>(IOSL-RAEOS) D Q:RAXIT
40 . S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2
41 . Q
42 I RAEOS=6 D
43 . N RASTR S RASTR="*** OUTPATIENT ***"
44 . S RASTR(0)=$$REPEAT^XLFSTR(" ",((IOM-($L(RASTR)*3))\2))
45 . S RASTR(1)=RASTR_RASTR(0)_RASTR_RASTR(0)_RASTR
46 . W !!,RASTR(1)
47 . Q
48 ; Note: Inform the user that the following data will be for outpatients.
49 ; Since only inpatient and outpatient is possibly stored, any
50 ; change in the variable RAVAR will be a change to 'outpatient'.
51 I IOM=132 D ;132 column format
52 . W !,RANME,?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT,?RATAB(4)
53 . W $E(RAWHE,1,25),?RATAB(5),RAVRFIED
54 . W !?RATAB(6),$E(RAPRC,1,30),?RATAB(7),$E(RAST,1,30)
55 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,20),?RATAB(10),RATECH
56 . Q
57 E D ;default to 80 column
58 . W !,$E(RANME,1,20),?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT
59 . W ?RATAB(4),$E(RAWHE,1,15),?RATAB(5),RAVRFIED
60 . W !?RATAB(6),$E(RAPRC,1,20),?RATAB(7),$E(RAST,1,11)
61 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,15),?RATAB(10),RATECH
62 . Q
63 W !,RALN1
64 S RAVAR(0)=RAVAR ; track the patient status: inpatient -or- outpatient
65 Q
66CHECK(DUZ) ; Check for the existence of RACCESS. Pass in user's DUZ!
67 S RAPSTX="" D SETVARS^RAPSET1(0)
68 Q
69LIST ; List divisions and I-Types
70 N A,B S A=""
71 F S A=$O(^TMP($J,"RADLQ",A)) Q:A']"" D
72 . W !!,"Division: ",$P($G(^DIC(4,A,0)),"^"),!?3,"Imaging Type(s): "
73 . S B="" F S B=$O(^TMP($J,"RADLQ",A,B)) Q:B']"" D Q:RAXIT
74 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT
75 .. W:$X>(IOM-30) !?($X+$L("Imaging Type(s): ")+3) W B,?($X+3)
76 .. Q
77 . Q
78 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT
79 W !!?RATAB(6),"Total Over All Divisions: ",+$G(^TMP($J,"RADLQ"))
80 Q
81EXIT ; Kill and quit
82 K %DT,BEGDATE,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,I,INVMAXDT,RA,RA1,RA2
83 K RABEG,RACN,RACNI,RACRT,RADFN,RADIV,RADIVNM,RADT,RADTE,RADTI,RAEND
84 K RAEXAM,RAFLAG,RAHD,RAHEAD,RAIPHY,RAITYPE,RALN1,RALN2,RAMES,RANME
85 K RANODE,RAPAT,RAPG,RAPOP,RAPRC,RAQUIT,RAREGEX,RARP,RASORT1,RASORT2
86 K RASSN,RAST,RASTI,RASV,RATAB,RATECH,RAVAR,RAVRFIED,RAWHE,RAXIT
87 K X,Y,ZTDESC,ZTRTN,ZTSAVE
88 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RADLQ")
89 K:$D(RAPSTX) RACCESS,RAPSTX D CLOSE^RAUTL
90 K DISYS,I,POP
91 Q
92ZEROUT(SUB) ; Zero out the ^TMP($J global.
93 N X,Y,Z
94 S X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
95 . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=0
96 . F S Y=+$O(^TMP($J,"RA D-TYPE",X,Y)) Q:'Y D
97 .. S ^TMP($J,SUB,Y)=0,Z=""
98 .. F S Z=$O(RACCESS(DUZ,"DIV-IMG",X,Z)) Q:Z']"" D
99 ... Q:'$D(^TMP($J,"RA I-TYPE",Z)) S ^TMP($J,SUB,Y,Z)=0
100 ... I SUB="RADLQ" D
101 .... S:RASORT1'="B" ^TMP($J,SUB,Y,Z,RASORT1)=0
102 .... S:RASORT1="B" ^TMP($J,SUB,Y,Z,"I")=0,^TMP($J,SUB,Y,Z,"O")=0
103 .... Q
104 ... Q
105 .. Q
106 . Q
107 Q
Note: See TracBrowser for help on using the repository browser.