source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDV02.m@ 1606

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1ORDV02 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:18
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,118,146,141,208**;Dec 17, 1997
3 ;LAB Components
4LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Order Component
5 ;External calls to ^GMTSLROE
6 ;
7 I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
8 . N BEG,END,MAX
9 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
10 . S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
11 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA
12 . D GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
13 ;
14 N D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO
15 Q:'$L(OREXT)
16 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
17 Q:'$L($T(@GO))
18 S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA,GMTSBEG=ORDBEG,GMTSEND=ORDEND
19 S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
20 K ^TMP("ORDATA",$J)
21 I '$L($T(GCPR^OMGCOAS1)) D
22 . K ^TMP("LRO",$J)
23 . D @GO
24 S (CTR,D)=0
25 F S D=$O(^TMP("LRO",$J,D)) Q:'D D
26 . S SN=0
27 . F S SN=$O(^TMP("LRO",$J,D,SN)) Q:'SN S ORX0=^(SN) I $L(ORX0) D
28 .. S SITE=$S($L($G(^TMP("LRO",$J,D,SN,"facility"))):^("facility"),1:ORSITE)
29 .. S ^TMP("ORDATA",$J,D,"WP",1)="1^"_SITE ;Station ID
30 .. S ^TMP("ORDATA",$J,D,"WP",2)="2^"_$P(ORX0,U) ;collection date
31 .. S ^TMP("ORDATA",$J,D,"WP",3)="3^"_$P($P(ORX0,U,2),";",2) ;test name
32 .. S ^TMP("ORDATA",$J,D,"WP",4)="4^"_$P($P(ORX0,U,2),";") ;test ien
33 .. S ^TMP("ORDATA",$J,D,"WP",5)="5^"_$P($P(ORX0,U,3),";",2) ;specimen name
34 .. S ^TMP("ORDATA",$J,D,"WP",6)="6^"_$P($P(ORX0,U,3),";") ;specimen ien
35 .. S ^TMP("ORDATA",$J,D,"WP",7)="7^"_$P(ORX0,U,4) ;urgency
36 .. S ^TMP("ORDATA",$J,D,"WP",8)="8^"_$P($P(ORX0,U,6),";",2) ;provider name
37 .. S ^TMP("ORDATA",$J,D,"WP",9)="9^"_$P($P(ORX0,U,6),";") ;provider ien
38 .. S ^TMP("ORDATA",$J,D,"WP",10)="10^"_$P(ORX0,U,7) ;order date/time
39 .. S ^TMP("ORDATA",$J,D,"WP",11)="11^"_$P(ORX0,U,8) ;accession number
40 .. S ^TMP("ORDATA",$J,D,"WP",12)="12^"_$P(ORX0,U,9) ;available date/time
41 .. S ^TMP("ORDATA",$J,D,"WP",13)="13^"_$P(ORX0,U,5) ;status
42 K ^TMP("LRO",$J)
43 S ROOT=$NA(^TMP("ORDATA",$J))
44 Q
45CH(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Chemistry/Hematology
46 ;External references to ^DPT(DFN,"LR"),^LR(LRDFN, ^GMTSLRCE
47 ;
48 I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
49 . N BEG,END,MAX
50 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
51 . S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
52 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA
53 . D GCPR^OMGCOAS1(DFN,"LRC",BEG,END,MAX)
54 ;
55 N CTR,ORI,TST,PC,ORX0,GMCFLAG,GMCMNT,GMW,IX0,IX,LRDFN,CNT,PTR,MAX,GMTS1,GMTS2,GMTSAGE,ORSITE,SEX,SITE,GO,VA,VAIN,VAERR,VAIN,VADM
56 Q:'$L(OREXT)
57 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
58 Q:'$L($T(@GO))
59 S LRDFN=+$G(^DPT(DFN,"LR"))
60 I GO["GMTSLRCE" Q:'LRDFN
61 D OERR^VADPT
62 S GMTSAGE=$S(+VADM(4)>0:+VADM(4),1:99),SEX=$P(VADM(5),"^")
63 S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
64 S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
65 K ^TMP("ORDATA",$J)
66 I '$L($T(GCPR^OMGCOAS1)) D
67 . K ^TMP("LRC",$J)
68 . D @GO
69 S CTR=0,ORI=GMTS1
70 F S ORI=$O(^TMP("LRC",$J,ORI)) Q:'ORI!(ORI>GMTS2) D
71 . S TST=""
72 . F S TST=$O(^TMP("LRC",$J,ORI,TST)) Q:TST="" D
73 .. I TST S ORX0=$G(^TMP("LRC",$J,ORI,TST)) Q:ORX0="" D
74 ... S SITE=$S($L($G(^TMP("LRC",$J,ORI,TST,"facility"))):^("facility"),1:ORSITE)
75 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",1)="1^"_SITE ;Station ID
76 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",2)="2^"_$P(ORX0,U) ;collection date
77 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",3)="3^"_$P(ORX0,U,3) ;test name
78 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",4)="4^"_$P(ORX0,U,2) ;specimen
79 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",5)="5^"_$P(ORX0,U,4) ;result
80 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",6)="6^"_$P(ORX0,U,5) ;indicator
81 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",7)="7^"_$P(ORX0,U,6) ;units
82 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",8)="8^"_$P(ORX0,U,7) ;ref low
83 ... S ^TMP("ORDATA",$J,ORI,TST,"WP",9)="9^"_$P(ORX0,U,8) ;ref high
84 ... D SPMRG^ORDVU("^TMP(""LRC"","_$J_","_ORI_",""C"")","^TMP(""ORDATA"","_$J_","_ORI_","_TST_",""WP"",10)",10) ;comments
85 ... I $O(^TMP("LRC",$J,ORI,"C",0)) S ^TMP("ORDATA",$J,ORI,TST,"WP",11)="11^[+]" ;flag for details
86 .. S CTR=CTR+1
87 K ^TMP("LRC",$J)
88 S ROOT=$NA(^TMP("ORDATA",$J))
89 Q
90SP(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgical Pathology
91 ;External references to ^DPT(DFN,"LR"), ^GMTSLRAE,
92 ;
93 I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
94 . N BEG,END,MAX
95 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
96 . S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
97 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA
98 . D GCPR^OMGCOAS1(DFN,"SP",BEG,END,MAX)
99 ;
100 N ORDT,ORX0,ORCNT,GMI,MAX,LRDFN,IX,X,IX0,GMTS1,GMTS2,ORSITE,SITE,GO
101 Q:'$L(OREXT)
102 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
103 Q:'$L($T(@GO))
104 S LRDFN=+$G(^DPT(DFN,"LR"))
105 I GO["GMTSLRAE" Q:'LRDFN
106 S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
107 S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
108 K ^TMP("ORDATA",$J)
109 I '$L($T(GCPR^OMGCOAS1)) D
110 . K ^TMP("LRA",$J)
111 . D @GO
112 S ORDT=GMTS1,ORCNT=0
113 F S ORDT=$O(^TMP("LRA",$J,ORDT)) Q:(ORDT'>0)!(ORDT>GMTS2) S ORX0=^(ORDT,0) D
114 . S SITE=$S($L($G(^TMP("LRA",$J,ORDT,"facility"))):^("facility"),1:ORSITE)
115 . S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
116 . S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$P(ORX0,U) ;collection date
117 . S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$P(ORX0,U,2) ;accession number
118 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",.1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",3)",3) ;specimen
119 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",.2)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",5)",5) ;brief Clinical Hx
120 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",6)",6) ;gross Description
121 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",7)",7) ;microscopic Exam
122 . I $D(^TMP("LRA",$J,ORDT,1.2,1,0)) S X=^(0) D
123 .. S ^TMP("LRA",$J,ORDT,1.2,1,0)=$$DATE^ORDVU(X)
124 .. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.2)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",8)",8) ;supplemetary Report
125 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.3)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",9)",9) ;frozen Section
126 . D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.4)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",10)",10) ;surgical path Dx
127 . S ^TMP("ORDATA",$J,ORDT,"WP",11)="11^[+]" ;flag for detail
128 K ^TMP("LRA",$J)
129 S ROOT=$NA(^TMP("ORDATA",$J))
130 Q
131CY(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Cytopathology
132 ;External references to ^DPT(DFN,"LR"), ^GMTSLRPE
133 ;
134 I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
135 . N BEG,END,MAX
136 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
137 . S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
138 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA
139 . D GCPR^OMGCOAS1(DFN,"CY",BEG,END,MAX)
140 ;
141 N ORDT,ORX0,GMI,IX0,MAX,LRDFN,IX,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
142 Q:'$L(OREXT)
143 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
144 Q:'$L($T(@GO))
145 S LRDFN=+$G(^DPT(DFN,"LR"))
146 I GO["GMTSLRPE" Q:'LRDFN
147 S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
148 S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
149 K ^TMP("ORDATA",$J)
150 I '$L($T(GCPR^OMGCOAS1)) D
151 . K ^TMP("LRCY",$J)
152 . D @GO
153 S ORDT=GMTS1,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
154 F S ORDT=$O(^TMP("LRCY",$J,ORDT)) Q:(ORDT'>0)!(ORDT>GMTS2) S ORX0=$G(^(ORDT,0)) D
155 . S ORMORE=0,SITE=$S($L($G(^TMP("LRCY",$J,ORDT,"facility"))):^("facility"),1:ORSITE)
156 . S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
157 . S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$P(ORX0,U) ;collection date
158 . S ^TMP("ORDATA",$J,ORDT,"WP",5)="5^"_$P(ORX0,U,2) ;accession number
159 . S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$$DATE^ORDVU($P($G(^TMP("LRCY",$J,ORDT,1)),U,2)) ;report release date
160 . I $O(^TMP("LRCY",$J,ORDT,1,0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",3)",3) ;specimen
161 . I $O(^TMP("LRCY",$J,ORDT,"AH",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""AH"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",6)",6) ;brief Clinical Hx
162 . I $O(^TMP("LRCY",$J,ORDT,"G",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""G"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",7)",7) ;gross Description
163 . I $O(^TMP("LRCY",$J,ORDT,"MI",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""MI"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",8)",8) ;microscopic Exam
164 . I $O(^TMP("LRCY",$J,ORDT,"NDX",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""NDX"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",9)",9) ;cythopathology DX
165 . I $O(^TMP("LRCY",$J,ORDT,"SR",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""SR"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",10)",10) ;supplemetary Report
166 . I ORMORE S ^TMP("ORDATA",$J,ORDT,"WP",11)="11^[+]" ;flag for detail
167 K ^TMP("LRCY",$J)
168 S ROOT=$NA(^TMP("ORDATA",$J))
169 Q
Note: See TracBrowser for help on using the repository browser.