source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPI2.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1LREPI2 ;DALOI/SED-EMERGING PATHOGENS HL7 BUILD ;5/1/98
2 ;;5.2;LAB SERVICE;**132,157,175,242,260,281,320**;Sep 27, 1994
3 ;
4 ;Reference to ^DPT(DFN,0),U,9) supported by IA # 10035
5START ;START WITH THE PROTOCOL USED
6 S LRPROT=0 F S LRPROT=$O(^TMP($J,LRPROT)) Q:+LRPROT'>0 D
7 .D INIT^HLFNC2(LRPROT,.HL)
8 .S LRCS=$E(HL("ECH")),LRMSGNM=1,LRMSGSZ=0
9 .S LRMSGDF=$S(+$P($G(^LAB(69.4,LRPROT,0)),U,3)>0:+$P($G(^LAB(69.4,LRPROT,0)),U,3),1:30000)
10 .D EN I LRMSGSZ D MOVE,SEND
11 .F LRTND="ETI","TST","HEP" D:$D(^TMP($J,LRTND)) TOTAL
12 .D SEND,ALERT
13 D REPORT^LREPIRP
14 K ^TMP("HLS",$J)
15 K LRMSGDF,LRMSGNM,LRMSGSZ,%,%X
16 Q
17ALERT ;Send a Alert if desired.
18 K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
19 Q:+$G(LRRTYPE)=1
20 S X="NOW",%DT="SRT" D ^%DT,DD^%DT
21 S XQAMSG=$P(^LAB(69.4,LRPROT,0),U,5)_" Was processed at "_Y
22 ;GET THE DUZ'S FOR ALERTS
23 S LRIEN=0 F S LRIEN=$O(^LAB(69.4,LRPROT,1,LRIEN)) Q:+LRIEN'>0 D
24 .S LRDATA=$G(^LAB(69.4,LRPROT,1,LRIEN,0))
25 .I $P(LRDATA,";",2)["VA(200" S XQA($P(LRDATA,";",1))=""
26 .I $P(LRDATA,";",2)["XMB(3.8" D
27 ..S LRMG=$P(LRDATA,";",1) ;Q:'$D(^XMB(3.8,LRMG))
28 ..S LRMGN=$$GET1^DIQ(69.4,LRMG,1) Q:LRMGN=""
29 ..S X=LRMGN,XMDUZ=DUZ D INST^XMA21
30 ..;S LRDUZ=0 F S LRDUZ=$O(^XMB(3.8,LRMG,1,"B",LRDUZ)) Q:+LRDUZ'>0 S XQA(LRDUZ)=""
31 Q:'$D(XQA)
32 D SETUP^XQALERT
33 Q
34SEND ;SEND THE HL7 MESSAGE
35 D HEAD
36 N HLP
37 S HLP("NAMESPACE")="LR"
38 D GENERATE^HLMA(LRPROT,"GM",1,.HLRST,"",.HLP)
39 S LRMSGNM=LRMSGNM+1,LRMSGSZ=0
40 K ^TMP("HLS",$J)
41 Q
42EN ;ENTRY TO BUILD A MESSAGE
43 S (LRCNT,LRPID)=1,DFN=0
44 F S DFN=$O(^TMP($J,LRPROT,DFN)) Q:+DFN'>0 D
45 .I LRMSGSZ>5000 D MOVE,SEND
46 .Q:$E($P(^DPT(DFN,0),U,9),1,5)="00000"
47 .D PID^LREPI3
48 .S LRPV1=1,LRENDT=0,LRPFG="",LREFG=0,LRPVVV=0
49 .F S LRENDT=$O(^TMP($J,LRPROT,DFN,LRENDT)) S LRPFG="" Q:+LRENDT'>0!(LREFG) D
50 ..D PV1
51 ..I $D(^TMP("LREPISRCH",$J,DFN)),LRPROT=LRPROTX D RXNT^LREPIPH
52 ..S LRPATH=0,LRNTE=1,LRPVVV=1
53 ..F S LRPATH=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH)) Q:+LRPATH'>0!(LREFG) D
54 ...D:LRPFG'=LRPATH NTE^LREPI3
55 ...S LRPFG=LRPATH,LROBR=1,LRINVD=0
56 ...F S LRINVD=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD)) Q:+LRINVD'>0!(LREFG) D
57 ....S LRND=""
58 ....F S LRND=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND)) Q:LRND=""!(LREFG) D
59 .....S LRDFN=$$LRDFN^LR7OR1(DFN) Q:'LRDFN
60 .....S LREFG=+$P($G(^LAB(69.5,LRPATH,0)),U,6)
61 .....S:LRND'="PTF" LROBR=$$EN^LREPI1(LRDFN,LRND,LRINVD,LROBR)+1
62 .....D:LRND="PTF" DG1^LREPI3
63 .....D MOVE
64 Q
65TOTAL ;Report the total counts -> "ETI" or "TST" or "HEP"
66 ; \/
67 S LRITN=0 F S LRITN=$O(^TMP($J,LRTND,LRITN)) Q:+LRITN'>0 D
68 .S (LRNLT,LRTNM)=""
69 .I LRTND="TST" D
70 ..I '$D(^TMP($J,"TPROT",LRITN,LRPROT)) QUIT
71 ..S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
72 ..S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
73 ..Q:'$D(^LAM(LRNL,0))
74 ..S LRNLT=$P(^LAM(LRNL,0),U,2)
75 .I LRTND="ETI" D
76 ..I '$D(^TMP($J,"EPROT",LRITN)) QUIT
77 ..S LRTNM=$P($G(^LAB(61.2,LRITN,0)),U,1)
78 ..S LRNL=$G(^LAB(61.2,LRITN,64)) Q:+LRNL'>0
79 ..Q:'$D(^LAM(LRNL,0))
80 ..S LRNLT=$P(^LAM(LRNL,0),U,2)
81 .I LRTND="STOT" D
82 ..I '$D(^TMP($J,"SPROT",LRITN,LRPROT)) QUIT
83 ..S LRTNM=""
84 ..S LRNL=LRITN
85 ..S LRNLT=""
86 .I LRTND="HEP" D
87 ..I '$D(^TMP($J,"HEP",LRITN)) QUIT
88 ..S LRNLT=""
89 ..I LRITN=1 S LRTNM="1-Declined Assessment for Hepatitis C"
90 ..I LRITN=2 S LRTNM="2-No Risk Factors for Hepatitis C"
91 ..I LRITN=3 S LRTNM="3-Previously Assessed for Hepatitis C"
92 ..I LRITN=4 S LRTNM="4-Risk Factors for Hepatitis C"
93 ..I LRITN=5 S LRTNM="5-Positive Test for Hepatitis C antibody"
94 ..I LRITN=6 S LRTNM="6-Negative Test for Hepatitis C antibody"
95 ..I LRITN=7 S LRTNM="7- Hepatitis C diagnosis (ICD-9 based)"
96 .K LRDATA
97 .I '$G(LRTNM) D NAME
98 .S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_LRTNM_LRCS_+^TMP($J,LRTND,LRITN)
99 .S LRCNT=LRCNT+1
100 .S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
101 .S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
102 .K LRDATA
103 .S (LRPCNT,LRPTOT)=0
104 .F S LRPCNT=$O(^TMP($J,LRTND,LRITN,LRPCNT)) Q:+LRPCNT'>0 S LRPTOT=LRPTOT+1
105 .Q:LRPTOT'>0
106 .I '$G(LRTNM) D NAME
107 .S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_"PATIENTS WITH "_LRTNM_LRCS_LRPTOT ;+^TMP($J,LRPCNT,LRITN)
108 .S LRCNT=LRCNT+1
109 .S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
110 .S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
111 Q
112NAME ;
113 Q:LRTND'="TST"
114 S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
115 S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
116 Q:'$D(^LAM(LRNL,0))
117 S LRNLT=$P(^LAM(LRNL,0),U,2)
118 ;
119 QUIT
120HEAD ;ENTER A NTE FOR REPORT HEADER
121 K LRDATA
122 S LRDATA="NTE"_HLFS_HLFS_$S(LRRTYPE:"R",1:"")_LRCS
123 I $G(LR31799Z)=1 S LRDATA=LRDATA_"*** H E P A T I T I S C MARCH 17 1999 ***"
124 S LRDATA=LRDATA_"REPORTING DATE FROM "_$$HLDATE^HLFNC(LRRPS)
125 S LRDATA=LRDATA_" TO "_$$HLDATE^HLFNC(LRRPE)
126 S LRDATA=LRDATA_LRCS_LRMSGNM
127 I LRPROTX=LRPROT S LRDATA=LRDATA_LRCS_LRCS_"V3"
128 I '$O(^TMP("HLS",$J,1)) S LRDATA=LRDATA_LRCS_"N"
129 S ^TMP("HLS",$J,1)=$$UP^XLFSTR(LRDATA),LRMSGSZ=LRMSGSZ+$L(LRDATA)
130 S ^TMP("LREPIREP",$J,1)=$$UP^XLFSTR(LRDATA)
131 K LRDATA
132 Q
133MOVE S LRMOVE=0
134 F S LRMOVE=$O(^TMP("HL7",$J,LRMOVE)) Q:+LRMOVE'>0 D
135 .S LRCNT=LRCNT+1
136 .S ^TMP("HLS",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
137 .S ^TMP("LREPIREP",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
138 .S LRMSGSZ=LRMSGSZ+$L(^TMP("HL7",$J,LRMOVE))
139 K ^TMP("HL7",$J),LRMOVE
140 Q
141 ;
142PV1 ;
143 ;I $O(^TMP($J,LRPROT,DFN,LRENDT,""))!('$D(^TMP("LREPISRCH",$J,DFN)))!($P(LRNDTDA,"^",3))="UPDT" D PV1^LREPI3 S LRPVVV=1
144 I LRPV1>1,$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH))="",$P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)'="UPDT" Q
145 I $P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)="UPDT" D PV1^LREPI3 S LRPVVV=1 Q
146 I $O(^TMP($J,LRPROT,DFN,LRENDT,""))]"" D PV1^LREPI3 S LRPVVV=1 Q
147 I '$D(^TMP("LREPISRCH",$J,DFN)) D PV1^LREPI3 S LRPVVV=1 Q
Note: See TracBrowser for help on using the repository browser.