source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTUVR3.m@ 619

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

initial load of WorldVistAEHR
File size: 5.5 KB
RevLine 
[613]1RARTUVR3 ;HISC/GJC-Unverified Reports ;8/19/97 11:28
2 ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
3 ;Supported IA #2056 GET1^DIQ
4EN1 ; Entry point for unverified reports option when sort is on
5 ; Exam Date or Pri. Inter. Staff
6 ; Data Storage:
7 ; RABD="E":
8 ; ^TMP($J,"RAUVR",Division,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
9 ; RABD="S":
10 ; ^TMP($J,"RAUVR",Pri. Staff,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
11 K ^TMP($J,"RAUVR") S (RAOUT,RAPAGE)=0,RASTATUS=""
12 D:RABD="E" ZERO ; zero out totals for division data
13 S RADTE=BEGDATE-.0001
14 F S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>ENDDATE)!(RAOUT) D
15 . S RADFN=0
16 . F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0!(RAOUT) D
17 .. S RADTI=0
18 .. F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0!(RAOUT) D
19 ... S RACN=0
20 ... F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0!(RAOUT) D
21 .... S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI
22 .... S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
23 .... Q:'+$P(RA7003,"^",17) ; no report
24 .... S RA74=$G(^RARPT(+$P(RA7003,"^",17),0))
25 .... Q:$P(RA74,"^",5)="" ; no status, skeletal rpt created by imaging
26 .... Q:"^V^X^EF^"[("^"_$P(RA74,"^",5)_"^") ;Skip Verified, Deleted, E-filed rpts
27 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
28 .... ; ***** check if user selected this division & imaging type ****
29 .... S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) ; 0 node Reg. Exams sub-file
30 .... S RADIVNME=$P($G(^DIC(4,+$P(RA7002,"^",3),0)),"^") ; dinum to file 4!
31 .... S:RADIVNME="" RADIVNME="Unknown"
32 .... Q:'$D(^TMP($J,"RA D-TYPE",RADIVNME))
33 .... Q:'$D(^TMP($J,"RA I-TYPE",$P($G(^RA(79.2,+$P(RA7002,"^",2),0)),"^")))
34 .... ;*****************************************************************
35 .... S (RAMEMLOW,RAPRTSET,RAPSET)=0 D EN1^RAUTL20 ; mem of a printset?
36 .... S:RAPRTSET RAPSET="1." S:RAMEMLOW RAPSET="1+"
37 .... S RAPIS=$$GET1^DIQ(200,+$P(RA7003,"^",15)_",",.01)
38 .... S:RAPIS="" RAPIS="Unknown"
39 .... S RAPAT=$G(^DPT(RADFN,0))
40 .... S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unknown"
41 .... S RAPAT=$P(RAPAT,"^") S:RAPAT="" RAPAT="Unknown"
42 .... ;*****************************************************************
43 .... ; Store off the data into our TMP global. First subscript is $J.
44 .... ; Second subscript is: RABD="E", exam date. I RABD="S", second
45 .... ; subscript is Pri. Int'g Staff. Other Subscripts: sub3-exam date,
46 .... ; sub4-patient name, sub5-case number
47 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
48 .... S:RABD="S" ^TMP($J,"RAUVR",RAPIS,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
49 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME)=+$G(^TMP($J,"RAUVR",RADIVNME))+1
50 .... ;*****************************************************************
51 .... Q
52 ... Q
53 .. Q
54 . Q
55 S:RABD="S" RAHD="UNVERIFIED IMAGING REPORTS BY PRIMARY INTERPRETING STAFF"
56 S:RABD="E" RAHD="UNVERIFIED IMAGING REPORTS BY DIVISION"
57 S $P(RADASH,"-",(IOM+1))=""
58 I '$D(^TMP($J,"RAUVR")) D Q
59 . N RA1,RANODATA S RANODATA="*** No Unverified Reports ***",RA1=""
60 . I RABD="S" D HDR W !!?(IOM-$L(RANODATA)\2),RANODATA
61 . I RABD="E" D
62 .. N RA1
63 .. S RA1="" F S RA=$O(^TMP($J,"RA D-TYPE",RA1)) Q:RA1="" D Q:RAOUT
64 ... D HDR
65 ... S RANODATA="*** No Unverified Reports for division: "_RA1_" ***"
66 ... W !!?(IOM-$L(RANODATA)\2),RANODATA
67 ... S:$O(^TMP($J,"RA D-TYPE",RA1))]"" RAOUT=$$EOS^RAUTL5()
68 ... Q
69 .. Q
70 . Q
71 D GETDATA
72KILL ; cleanup symbol table
73 K RA7002,RA7003,RA74,RACSE,RAEXDT,RAHD,RAMEMLOW,RANODE,RAPAT,RAPIS
74 K RAPRC,RAPRTSET,RAPSET,RAXSTAT
75 Q
76HDR ; header code
77 W:$Y @IOF ; clear screen if not at top-of-page
78 S RAPAGE=RAPAGE+1 W !?(IOM-$L(RAHD)\2),RAHD
79 W !,$S(RABD="S":"Primary Interpreting Staff: ",1:"Division: "),RA1
80 W ?94,$$FMTE^XLFDT(DT,"1P")_" Page: "_RAPAGE
81 W !,?87,"Exam",?96,"Report",!,"Patient",?21,"Patient ID",?38,"Exam Date",?48,"Case",?55,"Procedure",?87,"Status",?96,"Entered",?106,"Pri. Int'g Staff"
82 W !,RADASH
83 Q
84GETDATA ; get to the data
85 S RA1="",(RAPAGE,RAOUT)=0
86 F S RA1=$O(^TMP($J,"RAUVR",RA1)) Q:RA1="" D Q:RAOUT
87 . D HDR S RAEXDT=0
88 . I RABD="E",$G(^TMP($J,"RAUVR",RA1))=0 D Q
89 .. S X="*** No Unverified Reports for division ***"
90 .. W !!?(IOM-$L(X)\2),X
91 .. S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5()
92 .. Q
93 . F S RAEXDT=$O(^TMP($J,"RAUVR",RA1,RAEXDT)) Q:RAEXDT'>0 D Q:RAOUT
94 .. S RAPAT=""
95 .. F S RAPAT=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT)) Q:RAPAT="" D Q:RAOUT
96 ... S RACSE=0
97 ... F S RACSE=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) Q:RACSE'>0 D Q:RAOUT
98 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
99 .... S RANODE=$G(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE))
100 .... D PRTDATA
101 .... Q
102 ... Q
103 .. Q
104 . S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5()
105 . Q
106 Q
107PRTDATA ; print the data
108 S RAPRC=$E($S($P(^RAMIS(71,+$P(RANODE,"^",4),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,30)
109 S:+$P(RANODE,"^") RAPRC=$TR($P(RANODE,"^"),"1","")_RAPRC
110 S RAXSTAT=$E($S($P(^RA(72,+$P(RANODE,"^",5),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,7)
111 S RARPTENT=$$FMTE^XLFDT(($P($G(^RARPT(+$P(RANODE,"^",19),0)),"^",6)\1),"2P")
112 S:RABD="S" RAPIS=RA1
113 S:RABD="E" RAPIS=$$GET1^DIQ(200,+$P(RANODE,"^",17)_",",.01)
114 S:RAPIS="" RAPIS="Unknown"
115 W !,$E(RAPAT,1,20),?21,$P(RANODE,"^",2),?38,$$FMTE^XLFDT(RAEXDT,"2P"),?48,RACSE,?55,RAPRC,?87,RAXSTAT,?96,RARPTENT,?106,$E(RAPIS,1,25)
116 I $Y>(IOSL-4) S RAOUT=$$EOS^RAUTL5() D:'RAOUT HDR
117 Q
118ZERO ; set division totals to zero
119 S X="" F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X="" S ^TMP($J,"RAUVR",X)=0
120 Q
Note: See TracBrowser for help on using the repository browser.