source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LREPI3.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 
1LREPI3 ;DALOI/SED-EMERGING PATHOGENS HL7 SEGMENTS ;5/21/98
2 ;;5.2;LAB SERVICE;**132,175,260,281,320**;Sep 27, 1994
3 ; Reference to ^DGPT supported by IA #418
4 ; Reference to ^SC supported by IA #10040
5 ; Reference to ^DIC(21 supported by IA #4280
6 ; Reference to ^ICD9 supported by IA #10082
7 ; Reference to ICN supported by IA #2701
8 ; Reference to VAFHLPID supported by IA # 263
9 ; Reference to VAFHLPV1 supporte by IA # 3018
10 ; Reference to ^DIC(5 supported by IA # 10056
11 ; Reference to $$HOMELESS supported by IA #1528
12 ; Reference to VADPT suppoted by IA #10061
13 ; Reference to ^AUPNVPOV supported by IA # 3094
14 ; Reference to ^AUPNVSIT supported by IA #3530
15 ; Reference to $$STA^XUAF4(IEN) supported by IA #2171
16 ; Reference to $$PTR2CODE^DGUTL4 supported by IA #3799
17NTE ;TO BUILD THE NTE SEGMENT TO DEFINE THE EPI
18 S LRDATA="NTE"_HLFS_LRNTE_HLFS_$P(^LAB(69.5,LRPATH,0),U,9)_LRCS_$P(^LAB(69.5,LRPATH,0),U,1)
19 S LRCNT=LRCNT+1,^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
20 S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
21 S LRMSGSZ=LRMSGSZ+$L(LRDATA)
22 S LRNTE=LRNTE+1
23 Q
24DG1 ;BUILD THE DG1 FOR ICD9 CODES
25 K ^TMP($J,"DG1")
26 S IFN=+$G(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND))
27DG11 Q:+IFN'>0
28 Q:'$D(^DGPT(IFN))
29 ;SEARCH FOR LEGIONAIRS HERE
30 I $P($G(^DGPT(IFN,300)),U,3)=1 D
31 .S ICD9=$O(^ICD9("BA","482.80 ",0)) Q:+ICD9'>0
32 .S ^TMP($J,"DG1",ICD9)=$P($G(^DGPT(IFN,70)),"^",10)_"^"_$$HLDATE^HLFNC($P($G(^DGPT(IFN,0)),"^",2))
33 I $D(^DGPT(IFN,70)) F LRI=10,11,16:1:24 D
34 .S ICD9=$P(^DGPT(IFN,70),U,LRI) Q:+ICD9'>0
35 .S ^TMP($J,"DG1",ICD9)=$P($G(^DGPT(IFN,70)),"^",10)_"^"_$$HLDATE^HLFNC($P($G(^DGPT(IFN,0)),"^",2))
36 ;SEARCH SUB FIELDS
37 S LRMV=0 F S LRMV=$O(^DGPT(IFN,"M",LRMV)) Q:+LRMV'>0 D
38 .;SEARCH FOR LEGIONAIRS HERE IN SUB FILE
39 .I $P($G(^DGPT(IFN,"M",LRMV,300)),U,3)=1 D
40 ..S ICD9=$O(^ICD9("BA","482.80 ",0)) Q:+ICD9'>0
41 ..S ^TMP($J,"DG1",ICD9)=$P($G(^DGPT(IFN,70)),"^",10)_"^"_$$HLDATE^HLFNC($P($G(^DGPT(IFN,0)),"^",2))
42 .I $D(^DGPT(IFN,"M",LRMV,0)) F LRI=5:1:9,11:1:15 D
43 ..S ICD9=$P(^DGPT(IFN,"M",LRMV,0),U,LRI) Q:+ICD9'>0
44 ..S ^TMP($J,"DG1",ICD9)=$P($G(^DGPT(IFN,70)),"^",10)_"^"_$$HLDATE^HLFNC($P($G(^DGPT(IFN,0)),"^",2))
45 Q:'$D(^TMP($J,"DG1"))
46BLD S ICD9=0 F S ICD9=$O(^TMP($J,"DG1",ICD9)) Q:+ICD9'>0 D
47 .S:'$D(DGCNT) DGCNT=1
48 .K LRDATA
49 .S LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_$P(^ICD9(ICD9,0),U,1)
50 .S LRDATA=LRDATA_LRCS_$P(^ICD9(ICD9,0),U,3)_LRCS_"I9"
51 .I LRPROT=LRPROTX S LRDATA=LRDATA_HLFS_$P(^TMP($J,"DG1",ICD9),"^",2)_HLFS_HLFS_$S(ICD9=$P(^TMP($J,"DG1",ICD9),"^"):"PR",1:"")
52 .S ^TMP("HL7",$J,DGCNT)=$$UP^XLFSTR(LRDATA),DGCNT=DGCNT+1
53 K ^TMP($J,"DG1"),LRDATA,DGCNT,ICD9,LRMV
54 Q
55PID ;TO BUILD PID SEGMENT
56 K MSG
57 S FLDS="1,2,3,5,7,8,10BT,19,22BT" S MSG=$$EN^VAFHLPID(DFN,FLDS,LRPID)
58 ;MADE CHANGE FOR PID SEGMENTS TOO LONG;CKA;06/30/04
59 D DEM^VADPT
60 I $D(VAFPID(1)) D
61 .S $P(MSG,HLFS,11)=VADM(12),MSG=MSG_VAFPID(1),$P(MSG,HLFS,23)=VADM(11)
62 S ICN=$$GETICN^MPIF001(DFN)
63 S:ICN<0 $P(MSG,HLFS,4)=$P(MSG,HLFS,4)_LRCS_""""""_LRCS_"VAMPI"
64 S:ICN>0 $P(MSG,HLFS,4)=$P(MSG,HLFS,4)_LRCS_ICN_LRCS_"VAMPI"
65 ;ADDITIONAL DATA ADDED HERE HOMELESSNESS
66 S:$$HOMELESS^SOWKHIRM(DFN) $P(MSG,HLFS,12)="HOMELESS"
67 ;NOW GET PERIOD OF SERVICE
68 K VAEL D ELIG^VADPT
69 S:$G(VAEL(2))'="" $P(MSG,HLFS,28)=$P($G(^DIC(21,+VAEL(2),0)),U,3)
70 K VAEL
71 ;GET ZIP IF THERE
72 K VAPA D ADD^VADPT
73 S $P(MSG,HLFS,12)=$P(MSG,HLFS,12)_LRCS_LRCS_LRCS_VAPA(5)_LRCS_$G(VAPA(6))_LRCS_LRCS_LRCS_LRCS
74 I VAPA(7)'="",VAPA(5)'="" S CTY=$P(VAPA(7),U,2),CTYN=$P(VAPA(7),U) I CTYN'="" S CTYCD=$P($G(^DIC(5,$P(VAPA(5),U),1,CTYN,0)),U,3) D
75 .S $P(MSG,HLFS,12)=$P(MSG,HLFS,12)_$G(CTYCD)_"^"_$G(CTY)
76 K VAPA,CTY,CTYN,CTYCD,LRRACE
77 I $P(MSG,HLFS,12)="~~~~~~~~" S $P(MSG,HLFS,12)=""
78 S LRRACE=$$PTR2CODE^DGUTL4($P(VADM(8),U))
79 I $L(MSG)>245 D
80 .S $P(MSG,HLFS,11)=VADM(12),$P(MSG,HLFS,23)=VADM(11)
81 S:$P(MSG,HLFS,11)="""""~""""~0005~""""~""""~CDC" $P(MSG,HLFS,11)=""
82 S:$P(MSG,HLFS,23)="""""~""""~0189~""""~""""~CDC" $P(MSG,HLFS,23)=""
83 S $P(MSG,HLFS,11)=LRRACE_"~"_$P(MSG,HLFS,11)
84 I $P(MSG,HLFS,11)="~" S $P(MSG,HLFS,11)=""
85 S LRPID=LRPID+1,LRCNT=LRCNT+1,^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(MSG)
86 S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(MSG)
87 S LRMSGSZ=LRMSGSZ+$L(MSG)
88 K FLDS,VAEL,ICN,VAFPID,VADM
89 Q
90PV1 ;TO BUILD PV1 SEGMENT
91 K PTF,Y,C,LRDATA,MSG,LRPATLOC
92 S LRDATA=""
93 I $P(^TMP($J,LRPROT,DFN,LRENDT),U)="I" D
94 .S FLDS="1,2,3,36,39,44,45" S LRDATA=$$IN^VAFHLPV1(DFN,LRENDT,FLDS,"","","","")
95 I $P(LRDATA,HLFS)="" S $P(LRDATA,HLFS)="PV1"
96 S $P(LRDATA,HLFS,2)=LRPV1
97 S $P(LRDATA,HLFS,7)=""
98 S $P(LRDATA,HLFS,3)=$P(^TMP($J,LRPROT,DFN,LRENDT),U)
99 I $P(LRDATA,HLFS,3)="O" D
100 .S LRPATLOC=$P(^TMP($J,LRPROT,DFN,LRENDT),U,2)
101 .S LRFILE=$P(LRPATLOC,";",2)
102 .S LRIFN=$P(LRPATLOC,";")
103 .I LRFILE="SC(" D
104 ..I $P($G(^SC(LRIFN,0)),U,4)'="" D
105 ...S LRPATLOC=$$STA^XUAF4($P($G(^SC(LRIFN,0)),U,4))
106 .I LRFILE="DIC(4" D
107 ..I $$STA^XUAF4(LRIFN)'="" D
108 ...S LRPATLOC=$$STA^XUAF4(LRIFN)
109 .S $P(LRDATA,HLFS,39)=LRPATLOC
110 .K LRPATLOC,LRFILE,LRIFN
111 S:$P(^TMP($J,LRPROT,DFN,LRENDT),U,3)="UPDT" $P(LRDATA,HLFS,3)="U"
112 S $P(LRDATA,HLFS,45)=$$HLDATE^HLFNC(LRENDT)
113 S:$P(LRDATA,HLFS,46)="""""" $P(LRDATA,HLFS,46)=""
114 ;MADE CHANGE FOR FUTURE DISCHARGE DATES;CKA 6/30/2004
115 S:$P(LRDATA,HLFS,46)>LRRPE $P(LRDATA,HLFS,46)=""
116 S PTF=$P(^TMP($J,LRPROT,DFN,LRENDT),U,2) I +PTF>0 D
117 .Q:'$D(^DGPT(PTF,0))
118 .Q:$P(^DGPT(PTF,0),U,6)'=3
119 .Q:'$D(^DGPT(PTF,70))
120 .I +$P(^DGPT(PTF,70),U)>0,+$P(^DGPT(PTF,70),U)<LRRPE S $P(LRDATA,HLFS,46)=$$HLDATE^HLFNC($P(^DGPT(PTF,70),U))
121 .S (Y,LRDTY)=$P(^DGPT(PTF,70),U,3)
122 .Q:+Y'>0
123 .S Y=$$EXTERNAL^DILFD(45,72,,Y) ;removed direct reference to ^DD(45,72
124 .;S C=$P(^DD(45,72,0),U,2) D Y^DIQ ;RLM
125 .S $P(LRDATA,HLFS,37)=LRDTY_LRCS_Y_LRCS_"VA45"
126 .S $P(LRDATA,HLFS,40)=$P(^DGPT(PTF,0),U,3)
127 S LRCNT=LRCNT+1,^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA),LRPV1=LRPV1+1
128 S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
129 S LRMSGSZ=LRMSGSZ+$L(LRDATA)
130 I $P(LRDATA,HLFS,3)="O" D D MOVE^LREPI2
131 .S VIFN=0
132 .F S VIFN=$O(^AUPNVPOV("AA",DFN,9999999-$P(LRENDT,"."),VIFN)) Q:+VIFN'>0 D
133 ..S LRVISIT=$P(^AUPNVSIT($P(^AUPNVPOV(VIFN,0),U,3),812),U,2)
134 ..I LRVISIT'=26 S LRVISIT=0 Q
135 ..S ICD9N=$P($G(^AUPNVPOV(VIFN,0)),U)
136 ..Q:ICD9N=""
137 ..S ICD9=$P(^ICD9(ICD9N,0),U)
138 ..S:'$D(DGCNT) DGCNT=1
139 ..S LRDATA="DG1"_HLFS_DGCNT_HLFS_HLFS_ICD9
140 ..S LRDATA=LRDATA_LRCS_$P(^ICD9(ICD9N,0),U,3)_LRCS_"I9"
141 ..S LRDATA=LRDATA_HLFS_$$HLDATE^HLFNC(LRENDT)_HLFS_HLFS_$S($P(^AUPNVPOV(VIFN,0),U,12)="P":"PR",1:"")
142 ..S ^TMP("HL7",$J,DGCNT)=$$UP^XLFSTR(LRDATA)
143 .. S DGCNT=DGCNT+1
144 K DGCNT,VIFN,ICD9N,ICD9,LRDATA,LRVISIT
145 Q:$G(PTF)'>0
146 Q:'$D(^DGPT(PTF,0))
147 Q:$P(^DGPT(PTF,0),U,6)'=3
148 S IFN=PTF D DG11
149 D MOVE^LREPI2
150 K PTF,Y,C,LRDATA,LRDTY,IFN,ICD9,ICD9N,LROLLOC,VIFN
151 Q
152 ;
Note: See TracBrowser for help on using the repository browser.