source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR1.m@ 613

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

initial load of WorldVistAEHR
File size: 6.9 KB
Line 
1RARTR1 ;HISC/FPT,GJC-Queue/print Radiology Reports (cont.) ;1/8/97 08:08
2 ;;5.0;Radiology/Nuclear Medicine;**8,18,56**;Mar 16, 1998;Build 3
3 ;Supported IA #10104 REPEAT^XLFSTR
4 ;Supported IA #10060 and #2056 $$GET1^DIQ for file 200
5 ;last modification by SS for P18 JUNE 29,00
6PRTDX ; print dx codes on report
7 I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
8 S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
9 I '$D(RAUTOE) W !?RATAB,"Primary Diagnostic Code: ",!?RATAB+4,$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
10 I $D(RAUTOE) D
11 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Primary Diagnostic Code: "_$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
12 . Q
13 I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
14 I '$D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) W ! Q
15 I '$D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
16 . W !!?RATAB,"Secondary Diagnostic Codes: "
17 . S RADXCODE=0
18 . F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0!('$D(^RA(78.3,+RADXCODE,0)))!($D(RAOOUT)) D
19 .. D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL W !?RATAB+4,$P(^RA(78.3,RADXCODE,0),U,1)
20 .. Q
21 . K RADXCODE W !
22 . Q
23 I $D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
24 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
25 . Q
26 I $D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D
27 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Secondary Diagnostic Codes: "
28 . S RADXCODE=0
29 . F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0 D
30 .. Q:'$D(^RA(78.3,+$G(RADXCODE),0))#2
31 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$P(^RA(78.3,+$G(RADXCODE),0),U)
32 .. Q
33 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
34 . Q
35 Q
36WARNING ; this printed report should not be used for charting
37 S RARPTSTT=$$RSTAT^RAO7PC1A()
38 S:RARPTSTT="NO REPORT" RARPTSTT="REPORT STATUS UNKNOWN"
39 S:RAST="R" RARPTSTT="("_RARPTSTT_")"
40 S RAPOSITN=(80-$L(RARPTSTT)\2)
41 I '$D(RAUTOE) D ;P18 modif
42 . W !?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
43 . W:RAST="R" !?(80-$L(RARPTSTT)\2)-1,"* PRELIMINARY REPORT *" ;P18
44 . W !?(80-$L(RARPTSTT)\2)-1,"*"_RARPTSTT_"*",!?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
45 . Q
46 I $D(RAUTOE) D
47 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
48 . I RAST="R" S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="* PRELIMINARY REPORT *" ;P18
49 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="*"_RARPTSTT_"*" ;P18
50 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
51 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
52 . Q
53 K RAPOSITN,RARPTSTT
54 Q
55SECRES ; Print from the secondary resident multiple
56 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0)) ; no data, quit
57 N RASR,RASRSBN,RASRSBT,DIERR,RAZ
58 I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
59 W:'$D(RAUTOE) !,"Secondary Interpreting Resident:"
60 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Resident:"
61 S RASR=0
62 F S RASR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR)) Q:RASR'>0 D
63 . S RASR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR,0))
64 . S RAZ=$$GET1^DIQ(200,+RASR(0)_",",.01)
65 . Q:RAZ=""
66 . S RASRSBN=$E($$GET1^DIQ(200,+RASR(0)_",",20.2),1,25)
67 . S:RASRSBN']"" RASRSBN=$E(RAZ,1,25)
68 . S RASRSBT=$$GET1^DIQ(200,+RASR(0)_",",20.3) ; max:; 50 chars
69 . I RASRSBT']"" S RASRSBT=$$TITLE^RARTR0(+RASR(0))
70 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
71 . W:'$D(RAUTOE) !?2,$S(RASRSBN]"":RASRSBN,1:"Unknown"),", ",$E(RASRSBT,1,((IOM-$X)-16))
72 . ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
73 . I $D(RAUTOE) D
74 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASRSBN]"":RASRSBN,1:"Unknown")
75 .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
76 .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASRSBT,1,((80-RALEN)-16))
77 .. Q
78 . I '$D(RAVERFND),(RAVERF=+RASR(0)) D
79 .. S RAVERFND=""
80 .. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
81 ... W:RAWHOVER=+RASR(0) !?10,"(Verifier, no e-sig)"
82 ... W:RAWHOVER'=+RASR(0) !?10,"Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
83 ... Q
84 .. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
85 ... S:RAWHOVER=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
86 ... S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
87 ... Q
88 .. W:'$D(RAUTOE) " (Verifier)"
89 .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
90 .. Q
91 . I RAPVERF=+RASR(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
92 . Q
93 Q
94SECSTF ; Print from the secondary staff multiple
95 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0)) ; no data, quit
96 N RASS,RASSSBN,RASSSBT,DIERR,RAZ
97 I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
98 W:'$D(RAUTOE) !,"Secondary Interpreting Staff:"
99 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Staff:"
100 S RASS=0
101 F S RASS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS)) Q:RASS'>0 D
102 . S RASS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS,0))
103 . S RAZ=$$GET1^DIQ(200,+RASS(0)_",",.01)
104 . Q:RAZ=""
105 . S RASSSBN=$E($$GET1^DIQ(200,+RASS(0)_",",20.2),1,25)
106 . S:RASSSBN="" RASSSBN=$E(RAZ,1,25)
107 . S RASSSBT=$$GET1^DIQ(200,+RASS(0)_",",20.3) ; max: 50 chars
108 . I RASSSBT']"" S RASSSBT=$$TITLE^RARTR0(+RASS(0))
109 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
110 . W:'$D(RAUTOE) !?2,$S(RASSSBN]"":RASSSBN,1:"Unknown"),", ",$E(RASSSBT,1,((IOM-$X)-16))
111 . ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
112 . I $D(RAUTOE) D
113 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASSSBN]"":RASSSBN,1:"Unknown")
114 .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
115 .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASSSBT,1,((80-RALEN)-16))
116 .. Q
117 . I '$D(RAVERFND),(RAVERF=+RASS(0)) D
118 .. S RAVERFND=""
119 .. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
120 ... W:RAWHOVER=+RASS(0) !?10,"(Verifier, no e-sig)"
121 ... W:RAWHOVER'=+RASS(0) !?10,"Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
122 ... Q
123 .. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
124 ... S:RAWHOVER=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
125 ... S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
126 ... Q
127 .. W:'$D(RAUTOE) " (Verifier)"
128 .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
129 .. Q
130 . I RAPVERF=+RASS(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
131 . Q
132 Q
Note: See TracBrowser for help on using the repository browser.