source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7PC1A.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RAO7PC1A ;HISC/GJC-Procedure Call utilities (cont) ;1/22/03 12:41
2 ;;5.0;Radiology/Nuclear Medicine;**1,10,26,31,36,45**;Mar 16, 1998
3SETDATA ; Called from within the EN1 subroutine of RAO7PC1
4 ; Sets the ^TMP($J,"RAE1",patient ien,Exam ID) node.
5 ; See EN1^RAO7PC1 for further explanation.
6 ;
7 ; Output (new) :
8 ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",1)=cptmod^cptmodname
9 ; ,2)=cptmod^cptmodname
10 N RA,RA1,RA2,RA3
11 S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0))
12 S RAITY=+$P(RAREX(0),"^",2),RAILOC=+$P(RAREX(0),"^",4)
13 S RAILOC=$P($G(^SC(+$P($G(^RA(79.1,RAILOC,0)),"^"),0)),"^")
14 S RAITY(0)=$G(^RA(79.2,RAITY,0))
15 F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D Q:RAXIT
16 . S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0))
17 . Q:RAXAM(0)=""
18 . S RAORDER=+$P(RAXAM(0),"^",11)
19 . ; quit if exam is WAITING and its order status isn't ACTIVE
20 . ; because this means exam hasn't finished being registered
21 . I $P($G(^RA(72,+$P(RAXAM(0),U,3),0)),U,3)=1,$P($G(^RAO(75.1,RAORDER,0)),U,5)'=6 Q
22 . S RAORDER(7)=$P($G(^RAO(75.1,RAORDER,0)),"^",7) ; CPRS order ien
23 . S RAXSTAT=+$P(RAXAM(0),"^",3),RAXSTAT(0)=$G(^RA(72,RAXSTAT,0))
24 . S RAXID=RAIBDT_"-"_RANO
25 . S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown")
26 . S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0))
27 . S RACPT=+$P(RAPRC,"^",9) ; pntr to 81
28 . S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT)
29 . S RACPT=$S($P(RACPT,"^",2)]"":$P(RACPT,"^"),1:"")
30 . S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown")
31 . ; quit if cancelled exam, and cancelled exams not requested
32 . I ('$G(RACINC)),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) Q
33 . S RADIAG=+$P(RAXAM(0),U,13),RARPT=+$P(RAXAM(0),U,17)
34 .; E3R 17541, 15507
35 .; if want cancel'd cases returned, and this case is cancelled, then
36 .; also require div param ALLOW RPTS ON CANCELLED CASES? = Y and
37 .; presence of report, else skip this case
38 . I $G(RACINC),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) D Q:RASHOCAN=0
39 .. S RASHOCAN=0
40 .. I $P($G(^RA(79,+$P(RAREX(0),"^",3),.1)),"^",22)="Y",RARPT S RASHOCAN=1
41 .. Q
42 . S RABNOR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,4))
43 . S:RABNOR'="Y" RABNOR=""
44 . S RABNORMR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,3))
45 . S:RABNORMR'="Y" RABNORMR=""
46 . S RARPTST=$P($G(^RARPT(RARPT,0)),U,5)
47 . S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report")
48 . S ^TMP($J,"RAE1",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_RABNOR_U_$S(RARPT=0:"",1:RARPT)_U_$P(RAXSTAT(0),"^",3)_"~"_$P(RAXSTAT(0),"^")_U_RAILOC_U_$P(RAITY(0),"^",3)_"~"_$P(RAITY(0),"^")_U_RABNORMR_U_RACPT_U_$G(RAORDER(7))
49 . S ^TMP($J,"RAE1",RADFN,RAXID)=^TMP($J,"RAE1",RADFN,RAXID)_U_$S($O(^RARPT(RARPT,2005,0)):"Y",1:"N")
50 . D CPTMOD
51 . S RACNT=RACNT+1
52 .;
53 .; Condensed Radiology Display in CPRS GUI:
54 .; subtract from count if counting parent; count only 1 case from printset
55 .; and
56 .; store values of MEMBER OF SET and ordered parent procedure name
57 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P" D
58 .. I $P(RAXAM(0),U,25)="2",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO),-1) S RACNT=RACNT-1
59 .. I $P(RAXAM(0),U,25) D
60 ... S RA3=$S('RAORDER:"",1:$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAORDER,0)),U,2),0)),U))
61 ... S RA3=$S(RA3'="":RA3,1:"PARENT PROCEDURE")
62 ... S ^TMP($J,"RAE1",RADFN,RAXID,"CPRS")=$P(RAXAM(0),U,25)_U_RA3
63 ... Q
64 .. Q
65 . S:RACNT=RAEXN RAXIT=1
66 .; Condensed Radiology Display in CPRS GUI:
67 .; do not exit until all cases of printset have been stored
68 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) S RAXIT=0
69 . K RAXSTAT,RAORDER
70 . Q
71 K RAILOC,RAITY
72 Q
73CASE ; Return the case numbers and the total number of case numbers
74 ; associated with a particular order. Called from CASE^RAO7PC1.
75 ; Sets RARRAY(case #)="" for all cases associated with an order.
76 ; Sets first piece of RATTL to the number of cases found for an
77 ; order, and the second piece is PRINTSET if the report covers
78 ; multiple cases. See CASE^RAO7PC1 for more information.
79 I '$D(^RAO(75.1,RAOIFN,0))#2 S RATTL="-1^invalid order ien" Q
80 I '$D(^RADPT("AO",RAOIFN)) D Q ; case has yet to be registered
81 . S RATTL="-2^no case registered to date"
82 . Q
83 N RACNI,RADFN,RADTI,RAEXAM S RADFN=0
84 F S RADFN=$O(^RADPT("AO",RAOIFN,RADFN)) Q:RADFN'>0 D
85 . S RADTI=0
86 . F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D
87 .. S RACNI=0
88 .. F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D
89 ... S RAEXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
90 ... Q:$P($G(^RA(72,+$P(RAEXAM,"^",3),0)),"^",3)=0 ; xam cancelled
91 ... S RATTL=+$G(RATTL)+1,@(RARRAY_"("_+RAEXAM_")")=""
92 ... Q
93 .. Q
94 . Q
95 I 'RATTL S RATTL="-2^cases cancelled" Q
96 S:$P(RAEXAM,"^",25)=2 RATTL=RATTL_"^PRINTSET" ; combined reports
97 Q
98 ;
99EN2 ; IA: 2012, Return last 7 days of non-cancelled exams
100 ; Required: RADFN (valid patient ien) called from EN2^RAO7PC1
101 ; Output:
102 ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^
103 ; report status^imaging location IEN^imaging location name^
104 ; contrast medium or media used
105 ; Note: Single characters in parenthesis indicate contrast
106 ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic;
107 ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin;
108 ; (B)=Barium; (M)=unspecified contrast media
109 ;
110 ; Exam ID: exam date/time (inverse) concatenated with the case IEN
111 ;
112 Q:'$D(RADFN) Q:'RADFN K ^TMP($J,"RAE7")
113 N I,RABDT,RACNST,RACSE,RADT,RAEDT,RAIBDT,RAIEDT,RALOC,RACMEDIA,RANO
114 N RAPRC,RAREX,RARPT,RARPTST,RAXAM,RAXID,RAXSTAT
115 S RADT=$S($D(DT)#2:DT,1:$$DT^XLFDT()),RACNST=9999999.9999
116 S RABDT=$$FMADD^XLFDT(RADT,-7,0,0,0),RAEDT=RADT
117 S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001)
118 F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D
119 . S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0))
120 . S RALOC=+$P(RAREX(0),U,4),RALOC(0)=$G(^RA(79.1,RALOC,0))
121 . S RALOC=$P($G(^SC(+RALOC(0),0)),"^")
122 . F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D
123 .. S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0))
124 .. S RAXID=RAIBDT_"-"_RANO
125 .. S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown")
126 .. S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0))
127 .. S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown")
128 .. Q:$P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0 ; cancelled xam
129 .. S I=0,RACMEDIA="" F S I=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CM",I)) Q:'I S RACMEDIA=RACMEDIA_$P(^(I,0),U) ;RA*5*45
130 .. S RARPT=+$P(RAXAM(0),U,17)
131 .. S RARPTST=$P($G(^RARPT(RARPT,0)),U,5)
132 .. S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report")
133 .. S ^TMP($J,"RAE7",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_+RALOC(0)_U_RALOC_U_RACMEDIA
134 .. Q
135 . Q
136 Q
137CPTMOD ;extract cpt modifiers if any
138 ;RA loop var, RA1 counter, RA2 intermed vars
139 Q:'$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",0))
140 S RA=0,RA1=1
141 F S RA=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA)) Q:'RA I $D(^(RA,0)) D
142 . S RA2=$P(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA,0),"^")
143 . S RA2=$$BASICMOD^RACPTMSC(RA2,+RAREX(0)) Q:+RA2<0
144 . S ^TMP($J,"RAE1",RADFN,RAXID,"CMOD",RA1)=$P(RA2,"^",2)_"^"_$P(RA2,"^",3),RA1=RA1+1
145 Q
Note: See TracBrowser for help on using the repository browser.