source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LREPIRS1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1LREPIRS1 ;DALOI/CKA-EMERGING PATHOGENS LOCAL REPORT ;9/9/03
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ; Reference to ^DIC(21 supported by IA #913
4 Q
5REPORT ;
6 S X1=DT,X2=180 D C^%DTC
7 S LRSP=" "
8 S ^XTMP("LREPILOCALREP"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$S($D(DUZ):DUZ,1:"UNKNOWN")
9 S LRHDGLC=0 D SAVHDG^LREPIRS2
10 S MSG=0,LRLC=1,LRSPSHT=""
11 F S MSG=$O(^TMP("HLS",$J,MSG)) Q:'MSG S LRMSGLIN=^(MSG) D
12 .S LRSPSHT=""
13 .Q:$P(LRMSGLIN,"|")=""
14 .Q:'$D(LRSEG($P(LRMSGLIN,"|")))
15 .I $P(LRMSGLIN,"|")="PID" D
16 ..S LRSPSHT="********************************************************************************"
17 ..S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1
18 .I $P(LRMSGLIN,"|")="PID" D
19 ..I $D(LRSEG("PID",1)) S LRSPSHT=$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
20 ..I $D(LRSEG("PID",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,20)_" "
21 ..I $D(LRSEG("PID",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,4) D
22 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,16-($L($P($P(LRMSGLIN,HLFS,4),LRCS,4))))
23 ..I $D(LRSEG("PID",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,6),LRCS)_","_$P($P(LRMSGLIN,HLFS,6),LRCS,2)_" "_$P($P(LRMSGLIN,HLFS,6),LRCS,3)_" " D
24 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,29-($L($P(LRMSGLIN,HLFS,6))))
25 ..I $D(LRSEG("PID",5)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8)) D
26 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,9-($L($P(LRMSGLIN,HLFS,8))))
27 ..I $D(LRSEG("PID",6)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,9)_" "
28 ..I $D(LRSEG("PID",7)) D K LRZ,LRY
29 ...S LRZ=0,DFN=$P($P(LRMSGLIN,HLFS,4),LRCS) F LRY=1:1 S LRZ=$O(^DPT(DFN,.02,LRZ)) Q:'LRZ
30 ...I LRY>2 S LRSPSHT=LRSPSHT_"MULTIPLE "
31 ...E S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,11),LRCS,2)_" "
32 ..I $D(LRSEG("PID",8)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,1)_$E(LRSP,1,9-$L($P($P(LRMSGLIN,HLFS,12),LRCS,1)))
33 ..I $D(LRSEG("PID",9)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,4),U,2)_" " D
34 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,15-$L($P($P($P(LRMSGLIN,HLFS,12),LRCS,4),U,2)))
35 ..I $D(LRSEG("PID",10)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,5)_" "
36 ..I $D(LRSEG("PID",11)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,9),U,2)_$E(LRSP,1,20-$L($P($P($P(LRMSGLIN,HLFS,12),LRCS,9),U,2)))
37 ..I $D(LRSEG("PID",12)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,23),LRCS,2)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,23),LRCS,2)))
38 ..I $D(LRSEG("PID",13)) D I LRPOS="" S LRSPSHT=LRSPSHT_" "
39 ...S LRPOS=$P(LRMSGLIN,HLFS,28)
40 ...Q:LRPOS=""
41 ...S LRPOSN=0
42 ...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
43 ...S LRSPSHT=LRSPSHT_LRPOSNAM_" "
44 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
45 .K LRPOS,LRPOSN,LRPOSNAM
46 .I $P(LRMSGLIN,"|")="PV1" D
47 ..I $D(LRSEG("PV1",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
48 ..I $D(LRSEG("PV1",2)) D
49 ...S TYPE=$P(LRMSGLIN,HLFS,3),TYPE=$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
50 ...S LRSPSHT=LRSPSHT_TYPE_$E(LRSP,1,14-$L(TYPE))
51 ...K TYPE
52 ..I $D(LRSEG("PV1",3)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,4)_$E(LRSP,1,20-$L($P(LRMSGLIN,HLFS,4)))
53 ..I $D(LRSEG("PV1",4)) S LRSPSHT=LRSPSHT_$S($P($P(LRMSGLIN,HLFS,37),LRCS,2)'="":$P($P(LRMSGLIN,HLFS,37),LRCS,2),1:"**No Facility**")_$E(LRSP,1,23-$L($P($P(LRMSGLIN,HLFS,37),LRCS,2)))
54 ..I $D(LRSEG("PV1",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,40)_$E(LRSP,1,9-$L($P(LRMSGLIN,HLFS,40)))
55 ..I $D(LRSEG("PV1",6)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,45))_" "
56 ..I $D(LRSEG("PV1",7)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,46))
57 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
58 .I $P(LRMSGLIN,"|")="NTE" D
59 ..I $D(LRSEG("NTE",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,8-$L($P(LRMSGLIN,HLFS,2)))
60 ..I $D(LRSEG("NTE",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_" "
61 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
62 .I $P(LRMSGLIN,"|")="OBR" D
63 ..I $D(LRSEG("OBR",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
64 ..I $D(LRSEG("OBR",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,5),LRCS,2)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,5),LRCS,2)))
65 ..I $D(LRSEG("OBR",3)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))_$E(LRSP,1,17-$L($$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))))
66 ..I $D(LRSEG("OBR",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,16),LRCS,3)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,16),LRCS,3)))
67 ..I $D(LRSEG("OBR",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,19)
68 ..S LRSPSHT=LRSPSHT_" "_$P($P(LRMSGLIN,HLFS,27),LRCS,2)
69 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
70 .I $P(LRMSGLIN,"|")="OBX" D
71 ..I $P(LRMSGLIN,HLFS,3)="ST" D
72 ...S TST=$P(LRMSGLIN,HLFS,4),TSTNM=$P($P(TST,LRCS,2),LRCS)
73 ...S OV=$P(LRMSGLIN,HLFS,6)
74 ..I $P(LRMSGLIN,HLFS,3)="CE" D
75 ...S TSTNM=""
76 ...S OV=$P($P(LRMSGLIN,HLFS,6),LRCS,2)
77 ..S FD=$$CDT^LREPIRP($P(LRMSGLIN,HLFS,15)),RR=$P(LRMSGLIN,HLFS,9)
78 ..S UN=$P(LRMSGLIN,HLFS,7)
79 ..I $P($P(LRMSGLIN,HLFS,4),LRCS,9)="LOINC" D
80 ...S LOINC=$P($P(LRMSGLIN,HLFS,4),LRCS,7),LOINCN=$P($P(LRMSGLIN,HLFS,4),LRCS,8)
81 ..I $D(LRSEG("OBX",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
82 ..I $D(LRSEG("OBX",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_" "
83 ..I $D(LRSEG("OBX",3)) S LRSPSHT=LRSPSHT_TSTNM_" "
84 ..I $D(LRSEG("OBX",4)) S LRSPSHT=LRSPSHT_$G(LOINC)_" "
85 ..I $D(LRSEG("OBX",5)) S LRSPSHT=LRSPSHT_$G(LOINCN)_" "
86 ..I $D(LRSEG("OBX",6)) S LRSPSHT=LRSPSHT_OV_" "
87 ..I $D(LRSEG("OBX",7)) S LRSPSHT=LRSPSHT_UN_" "
88 ..I $D(LRSEG("OBX",8)) S LRSPSHT=LRSPSHT_RR_" "
89 ..I $D(LRSEG("OBX",9)) S LRSPSHT=LRSPSHT_FD_" "
90 ..S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,5)
91 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
92 ..K TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV
93 .I $P(LRMSGLIN,"|")="DG1" D
94 ..I $D(LRSEG("DG1",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
95 ..I $D(LRSEG("DG1",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,1)_" " D
96 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,14-$L($P($P(LRMSGLIN,HLFS,4),LRCS,1)))
97 ..I $D(LRSEG("DG1",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,2) D
98 ...S LRSPSHT=LRSPSHT_$E(LRSP,1,39-$L($P($P(LRMSGLIN,HLFS,4),LRCS,2)))
99 ..I $D(LRSEG("DG1",4)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,5))_" "
100 ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1
101 K MSGLIN,LRSEG,ENTRY,FD,HLFS,LOINC,LOINCN,LRCS,LRHDGLC,LRLC,LRMSGLIN
102 K LRPOS,LRSP,LRSPSHT,MSG,OV,RR,TST,TSTNM,TYPE,UN,X,X1,X2
103 Q
Note: See TracBrowser for help on using the repository browser.