source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPIRS3.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1LREPIRS3 ;DALOI/CKA-EMERGING PATHOGENS LOCAL REPORT-GENERATE SPSHT ;9/9/03
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ; Reference to ^DIC(21 supported by IA #913
4 Q
5SPSHT ;
6 S X1=DT,X2=180 D C^%DTC
7 S ^XTMP("LREPILOCALSPSHT"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$S($D(DUZ):DUZ,1:"UNKNOWN")
8HDG1 ;
9 S LRHDG="",LRLC=1,LRX=0
10 I $D(LRSEG("PID")) S LRX("PID")=LRX,LRHDG="|"_LRX("PID")_"| |"
11 I $D(LRSEG("PID",1)) S LRHDG=LRHDG_"PID|"
12 I $D(LRSEG("PID",2)) S LRHDG=LRHDG_"SSN|"
13 I $D(LRSEG("PID",3)) S LRHDG=LRHDG_"MPI|"
14 I $D(LRSEG("PID",4)) S LRHDG=LRHDG_"Patient Name|"
15 I $D(LRSEG("PID",5)) S LRHDG=LRHDG_"Date of Birth|"
16 I $D(LRSEG("PID",6)) S LRHDG=LRHDG_"Sex|"
17 I $D(LRSEG("PID",7)) S LRHDG=LRHDG_"Race|"
18 I $D(LRSEG("PID",8)) S LRHDG=LRHDG_"Homeless|"
19 I $D(LRSEG("PID",9)) S LRHDG=LRHDG_"State|"
20 I $D(LRSEG("PID",10)) S LRHDG=LRHDG_"Zip|"
21 I $D(LRSEG("PID",11)) S LRHDG=LRHDG_"County|"
22 I $D(LRSEG("PID",12)) S LRHDG=LRHDG_"Ethnicity|"
23 I $D(LRSEG("PID",13)) S LRHDG=LRHDG_"POS|"
24 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
25 I $D(LRSEG("PV1")) S LRX=LRX+1,LRX("PV1")=LRX,LRHDG="|"_LRX_"| |"
26 I $D(LRSEG("PV1",1)) S LRHDG=LRHDG_"PV1|"
27 I $D(LRSEG("PV1",2)) S LRHDG=LRHDG_"Patient Class|"
28 I $D(LRSEG("PV1",3)) S LRHDG=LRHDG_"Hospital Location|"
29 I $D(LRSEG("PV1",4)) S LRHDG=LRHDG_"Discharge Disposition|"
30 I $D(LRSEG("PV1",5)) S LRHDG=LRHDG_"Facility|"
31 I $D(LRSEG("PV1",6)) S LRHDG=LRHDG_"Admit Date/Time|"
32 I $D(LRSEG("PV1",7)) S LRHDG=LRHDG_"Discharge Date/Time|"
33 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
34 I $D(LRSEG("DG1")) S LRX=LRX+1,LRX("DG1")=LRX,LRHDG="|"_LRX_"| |"
35 I $D(LRSEG("DG1",1)) S LRHDG=LRHDG_"DG1|"
36 I $D(LRSEG("DG1",2)) S LRHDG=LRHDG_"Diagnosis Code|"
37 I $D(LRSEG("DG1",3)) S LRHDG=LRHDG_"Diagnosis|"
38 I $D(LRSEG("DG1",4)) S LRHDG=LRHDG_"Admission Date|"
39 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
40 I $D(LRSEG("NTE")) S LRX=LRX+1,LRX("NTE")=LRX,LRHDG="|"_LRX_"| |"
41 I $D(LRSEG("NTE",1)) S LRHDG=LRHDG_"NTE|"
42 I $D(LRSEG("NTE",2)) S LRHDG=LRHDG_"Comment|"
43 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
44 I $D(LRSEG("OBR")) S LRX=LRX+1,LRX("OBR")=LRX,LRHDG="|"_LRX_"| |"
45 I $D(LRSEG("OBR",1)) S LRHDG=LRHDG_"OBR|"
46 I $D(LRSEG("OBR",2)) S LRHDG=LRHDG_"Test Name|"
47 I $D(LRSEG("OBR",3)) S LRHDG=LRHDG_"Accession Date/Time|"
48 I $D(LRSEG("OBR",4)) S LRHDG=LRHDG_"Specimen|"
49 I $D(LRSEG("OBR",5)) S LRHDG=LRHDG_"Accession Number|"
50 I LRHDG'="" S LRHDG=LRHDG_"OBR SUBID"
51 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
52 I $D(LRSEG("OBX")) S LRX=LRX+1,LRX("OBX")=LRX,LRHDG="|"_LRX_"| |"
53 I $D(LRSEG("OBX",1)) S LRHDG=LRHDG_"OBX|"
54 I $D(LRSEG("OBX",2)) S LRHDG=LRHDG_"Value Type|"
55 I $D(LRSEG("OBX",3)) S LRHDG=LRHDG_"Test Name|"
56 I $D(LRSEG("OBX",4)) S LRHDG=LRHDG_"LOINC Code|"
57 I $D(LRSEG("OBX",5)) S LRHDG=LRHDG_"LOINC Name|"
58 I $D(LRSEG("OBX",6)) S LRHDG=LRHDG_"Test Result|"
59 I $D(LRSEG("OBX",7)) S LRHDG=LRHDG_"Units|"
60 I $D(LRSEG("OBX",8)) S LRHDG=LRHDG_"Flags or Interp|"
61 I $D(LRSEG("OBX",9)) S LRHDG=LRHDG_"Verified Date/Time|"
62 I LRHDG'="" S LRHDG=LRHDG_"OBX SUBID"
63 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1
64 S MSG=0,LRSPSHT="",LRPID="",LROBR=""
65 F S MSG=$O(^TMP("HLS",$J,MSG)) Q:'MSG S LRMSGLIN=^(MSG) D
66 .S LRSPSHT=""
67 .Q:$P(LRMSGLIN,"|")=""
68 .Q:'$D(LRSEG($P(LRMSGLIN,"|")))
69 .I $P(LRMSGLIN,"|")="PID" D
70 ..S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT,LRLC=LRLC+1
71 .I $P(LRMSGLIN,"|")="PID" D
72 ..S LRSPSHT="********************************************************************************"
73 ..I $D(LRSEG("PID")) S LRPID=$P(LRMSGLIN,HLFS,2),LRSPSHT=LRPID_"|"_LRX("PID")_"| | |"
74 ..I $D(LRSEG("PID",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,20)_"|"
75 ..I $D(LRSEG("PID",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,4)_"|"
76 ..I $D(LRSEG("PID",4)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,6)_"|"
77 ..I $D(LRSEG("PID",5)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))_"|"
78 ..I $D(LRSEG("PID",6)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,9)_"|"
79 ..I $D(LRSEG("PID",7)) D K LRZ,LRY
80 ...S LRZ=0,DFN=$P($P(LRMSGLIN,HLFS,4),LRCS) F LRY=1:1 S LRZ=$O(^DPT(DFN,.02,LRZ)) Q:'LRZ
81 ...I LRY>2 S LRSPSHT=LRSPSHT_"MULTIPLE|"
82 ...E S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,11),LRCS,2)_"|"
83 ..I $D(LRSEG("PID",8)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,1)_"|"
84 ..I $D(LRSEG("PID",9)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,4),U,2)_"|"
85 ..I $D(LRSEG("PID",10)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,5)_"|"
86 ..I $D(LRSEG("PID",11)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,9),U,2)_"|"
87 ..I $D(LRSEG("PID",12)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,23),LRCS,2)_"|"
88 ..I $D(LRSEG("PID",13)) D I LRPOS="" S LRSPSHT=LRSPSHT_"||"
89 ...S LRPOS=$P(LRMSGLIN,HLFS,28)
90 ...Q:LRPOS=""
91 ...S LRPOSN=0
92 ...F S LRPOSN=$O(^DIC(21,LRPOSN)) Q:LRPOSN'>0 I $P($G(^DIC(21,LRPOSN,0)),U,3)=LRPOS S LRPOSNAM=$P(^(0),U) Q
93 ...S LRSPSHT=LRSPSHT_LRPOSNAM_"|"
94 .K LRPOS,LRPOSN,LRPOSNAM
95 .I $P(LRMSGLIN,"|")="PV1" D
96 ..I $D(LRSEG("PV1")) S LRSPSHT=LRPID_"|"_LRX("PV1")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"
97 ..I $D(LRSEG("PV1",2)) D
98 ...S TYPE=$P(LRMSGLIN,HLFS,3)
99 ...S LRSPSHT=LRSPSHT_$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")_"|"
100 ...K TYPE
101 ..I $D(LRSEG("PV1",3)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,4)_"|"
102 ..I $D(LRSEG("PV1",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,37),LRCS,2)_"|"
103 ..I $D(LRSEG("PV1",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,40)_"|"
104 ..I $D(LRSEG("PV1",6)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,45))_"|"
105 ..I $D(LRSEG("PV1",7)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,46))_"|"
106 .I $P(LRMSGLIN,"|")="NTE" D
107 ..I $D(LRSEG("NTE")) S LRSPSHT=LRPID_"|"_LRX("NTE")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"
108 ..I $D(LRSEG("NTE",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_"|"
109 .I $P(LRMSGLIN,"|")="OBR" D
110 ..I $D(LRSEG("OBR")) S LROBR=$P(LRMSGLIN,HLFS,2),LRSPSHT=LRPID_"|"_LRX("OBR")_"|"_LROBR_"| |"
111 ..I $D(LRSEG("OBR",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,5),LRCS,2)_"|"
112 ..I $D(LRSEG("OBR",3)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))_"|"
113 ..I $D(LRSEG("OBR",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,16),LRCS,3)_"|"
114 ..I $D(LRSEG("OBR",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,19)_"|"
115 ..S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,27),LRCS,2)
116 .I $P(LRMSGLIN,"|")="OBX" D
117 ..I $D(LRSEG("OBX")) S LRSPSHT=LRPID_"|"_LRX("OBX")_"|"_LROBR_"|"_$P(LRMSGLIN,HLFS,2)_"|"
118 ..I $P(LRMSGLIN,HLFS,3)="ST" D
119 ...S TSTNM=$P($P(LRMSGLIN,HLFS,4),LRCS,2)
120 ...S OV=$P(LRMSGLIN,HLFS,6)
121 ..I $P(LRMSGLIN,HLFS,3)="CE" D
122 ...S TSTNM=""
123 ...S OV=$P($P(LRMSGLIN,HLFS,6),LRCS,2)
124 ..S FD=$$CDT^LREPIRP($P(LRMSGLIN,HLFS,15)),RR=$P(LRMSGLIN,HLFS,9)
125 ..S UN=$P(LRMSGLIN,HLFS,7)
126 ..I $P($P(LRMSGLIN,HLFS,4),LRCS,9)="LOINC" D
127 ...S LOINC=$P($P(LRMSGLIN,HLFS,4),LRCS,7),LOINCN=$P($P(LRMSGLIN,HLFS,4),LRCS,8)
128 ..I $D(LRSEG("OBX",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_"|"
129 ..I $D(LRSEG("OBX",3)) S LRSPSHT=LRSPSHT_TSTNM_"|"
130 ..I $D(LRSEG("OBX",4)) S LRSPSHT=LRSPSHT_$G(LOINC)_"|"
131 ..I $D(LRSEG("OBX",5)) S LRSPSHT=LRSPSHT_$G(LOINCN)_"|"
132 ..I $D(LRSEG("OBX",6)) S LRSPSHT=LRSPSHT_OV_"|"
133 ..I $D(LRSEG("OBX",7)) S LRSPSHT=LRSPSHT_UN_"|"
134 ..I $D(LRSEG("OBX",8)) S LRSPSHT=LRSPSHT_RR_"|"
135 ..I $D(LRSEG("OBX",9)) S LRSPSHT=LRSPSHT_FD_"|"
136 ..S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,5)
137 ..K TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV
138 .I $P(LRMSGLIN,"|")="DG1" D
139 ..I $D(LRSEG("DG1")) S LRSPSHT=LRPID_"|"_LRX("DG1")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"
140 ..I $D(LRSEG("DG1",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,1)_"|"
141 ..I $D(LRSEG("DG1",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,2)_"|"
142 ..I $D(LRSEG("DG1",4)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P($P(LRMSGLIN,HLFS,5),LRCS))_"|"
143 .S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT,LRLC=LRLC+1
144 K MSGLIN,LRSEG,LRZ
145 Q
Note: See TracBrowser for help on using the repository browser.