source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADLQ3.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

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