LREPI2 ;DALOI/SED - EMERGING PATHOGENS HL7 BUILD ;23 Apr 2013 4:22 PM
;;5.2;LAB SERVICE;**132,157,175,242,260,281,320,421**;Sep 27, 1994;Build 48
;
;Reference to ^DPT(DFN,0),U,9) supported by IA # 10035
START ;START WITH THE PROTOCOL USED
S LRPROT=0 F S LRPROT=$O(^TMP($J,LRPROT)) Q:+LRPROT'>0 D
.D INIT^HLFNC2(LRPROT,.HL)
.S LRCS=$E(HL("ECH")),LRMSGNM=1,LRMSGSZ=0
.S LRMSGDF=$S(+$P($G(^LAB(69.4,LRPROT,0)),U,3)>0:+$P($G(^LAB(69.4,LRPROT,0)),U,3),1:30000)
.D EN I LRMSGSZ D MOVE,SEND
.F LRTND="ETI","TST","HEP" D:$D(^TMP($J,LRTND)) TOTAL
.D SEND,ALERT
D REPORT^LREPIRP
K ^TMP("HLS",$J)
K LRMSGDF,LRMSGNM,LRMSGSZ,%,%X
Q
ALERT ;Send a Alert if desired.
K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
Q:+$G(LRRTYPE)=1
S X="NOW",%DT="SRT" D ^%DT,DD^%DT
S XQAMSG=$P(^LAB(69.4,LRPROT,0),U,5)_" Was processed at "_Y
;GET THE DUZ'S FOR ALERTS
S LRIEN=0 F S LRIEN=$O(^LAB(69.4,LRPROT,1,LRIEN)) Q:+LRIEN'>0 D
.S LRDATA=$G(^LAB(69.4,LRPROT,1,LRIEN,0))
.I $P(LRDATA,";",2)["VA(200" S XQA($P(LRDATA,";",1))=""
.I $P(LRDATA,";",2)["XMB(3.8" D
..S LRMG=$P(LRDATA,";",1) ;Q:'$D(^XMB(3.8,LRMG))
..S LRMGN=$$GET1^DIQ(69.4,LRMG,1) Q:LRMGN=""
..S X=LRMGN,XMDUZ=DUZ D INST^XMA21
..;S LRDUZ=0 F S LRDUZ=$O(^XMB(3.8,LRMG,1,"B",LRDUZ)) Q:+LRDUZ'>0 S XQA(LRDUZ)=""
Q:'$D(XQA)
D SETUP^XQALERT
Q
SEND ;SEND THE HL7 MESSAGE
D HEAD
N HLP
S HLP("NAMESPACE")="LR"
D GENERATE^HLMA(LRPROT,"GM",1,.HLRST,"",.HLP)
S LRMSGNM=LRMSGNM+1,LRMSGSZ=0
K ^TMP("HLS",$J)
Q
EN ;ENTRY TO BUILD A MESSAGE
S (LRCNT,LRPID)=1,DFN=0
F S DFN=$O(^TMP($J,LRPROT,DFN)) Q:+DFN'>0 D
.I LRMSGSZ>5000 D MOVE,SEND
.Q:$E($P(^DPT(DFN,0),U,9),1,5)="00000"
.D PID^LREPI3
.S LRPV1=1,LRENDT=0,LRPFG="",LREFG=0,LRPVVV=0
.F S LRENDT=$O(^TMP($J,LRPROT,DFN,LRENDT)) S LRPFG="" Q:+LRENDT'>0!(LREFG) D
..D PV1
..I $D(^TMP("LREPISRCH",$J,DFN)),LRPROT=LRPROTX D RXNT^LREPIPH
..S LRPATH=0,LRNTE=1,LRPVVV=1
..F S LRPATH=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH)) Q:+LRPATH'>0!(LREFG) D
...D:LRPFG'=LRPATH NTE^LREPI3
...S LRPFG=LRPATH,LROBR=1,LRINVD=0
...F S LRINVD=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD)) Q:+LRINVD'>0!(LREFG) D
....S LRND=""
....F S LRND=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND)) Q:LRND=""!(LREFG) D
.....S LRDFN=$$LRDFN^LR7OR1(DFN) Q:'LRDFN
.....S LREFG=+$P($G(^LAB(69.5,LRPATH,0)),U,6)
.....S:LRND'="PTF" LROBR=$$EN^LREPI1(LRDFN,LRND,LRINVD,LROBR)+1
.....D:LRND="PTF" DG1^LREPI3
.....D MOVE
Q
TOTAL ;Report the total counts -> "ETI" or "TST" or "HEP"
; \/
S LRITN=0 F S LRITN=$O(^TMP($J,LRTND,LRITN)) Q:+LRITN'>0 D
.S (LRNLT,LRTNM)=""
.I LRTND="TST" D
..I '$D(^TMP($J,"TPROT",LRITN,LRPROT)) QUIT
..S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
..S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
..Q:'$D(^LAM(LRNL,0))
..S LRNLT=$P(^LAM(LRNL,0),U,2)
.I LRTND="ETI" D
..I '$D(^TMP($J,"EPROT",LRITN)) QUIT
..S LRTNM=$P($G(^LAB(61.2,LRITN,0)),U,1)
..S LRNL=$G(^LAB(61.2,LRITN,64)) Q:+LRNL'>0
..Q:'$D(^LAM(LRNL,0))
..S LRNLT=$P(^LAM(LRNL,0),U,2)
.I LRTND="STOT" D
..I '$D(^TMP($J,"SPROT",LRITN,LRPROT)) QUIT
..S LRTNM=""
..S LRNL=LRITN
..S LRNLT=""
.I LRTND="HEP" D
..I '$D(^TMP($J,"HEP",LRITN)) QUIT
..S LRNLT=""
..I LRITN=1 S LRTNM="1-Declined Assessment for Hepatitis C"
..I LRITN=2 S LRTNM="2-No Risk Factors for Hepatitis C"
..I LRITN=3 S LRTNM="3-Previously Assessed for Hepatitis C"
..I LRITN=4 S LRTNM="4-Risk Factors for Hepatitis C"
..I LRITN=5 S LRTNM="5-Positive Test for Hepatitis C antibody"
..I LRITN=6 S LRTNM="6-Negative Test for Hepatitis C antibody"
..I LRITN=7 S LRTNM="7- Hepatitis C diagnosis (ICD based)"
.K LRDATA
.I '$G(LRTNM) D NAME
.S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_LRTNM_LRCS_+^TMP($J,LRTND,LRITN)
.S LRCNT=LRCNT+1
.S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
.S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
.K LRDATA
.S (LRPCNT,LRPTOT)=0
.F S LRPCNT=$O(^TMP($J,LRTND,LRITN,LRPCNT)) Q:+LRPCNT'>0 S LRPTOT=LRPTOT+1
.Q:LRPTOT'>0
.I '$G(LRTNM) D NAME
.S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_"PATIENTS WITH "_LRTNM_LRCS_LRPTOT ;+^TMP($J,LRPCNT,LRITN)
.S LRCNT=LRCNT+1
.S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
.S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
Q
NAME ;
Q:LRTND'="TST"
S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
Q:'$D(^LAM(LRNL,0))
S LRNLT=$P(^LAM(LRNL,0),U,2)
;
QUIT
HEAD ;ENTER A NTE FOR REPORT HEADER
K LRDATA
S LRDATA="NTE"_HLFS_HLFS_$S(LRRTYPE:"R",1:"")_LRCS
I $G(LR31799Z)=1 S LRDATA=LRDATA_"*** H E P A T I T I S C MARCH 17 1999 ***"
S LRDATA=LRDATA_"REPORTING DATE FROM "_$$HLDATE^HLFNC(LRRPS)
S LRDATA=LRDATA_" TO "_$$HLDATE^HLFNC(LRRPE)
S LRDATA=LRDATA_LRCS_LRMSGNM
I LRPROTX=LRPROT S LRDATA=LRDATA_LRCS_LRCS_"V3"
I '$O(^TMP("HLS",$J,1)) S LRDATA=LRDATA_LRCS_"N"
S ^TMP("HLS",$J,1)=$$UP^XLFSTR(LRDATA),LRMSGSZ=LRMSGSZ+$L(LRDATA)
S ^TMP("LREPIREP",$J,1)=$$UP^XLFSTR(LRDATA)
K LRDATA
Q
MOVE S LRMOVE=0
F S LRMOVE=$O(^TMP("HL7",$J,LRMOVE)) Q:+LRMOVE'>0 D
.S LRCNT=LRCNT+1
.S ^TMP("HLS",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
.S ^TMP("LREPIREP",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
.S LRMSGSZ=LRMSGSZ+$L(^TMP("HL7",$J,LRMOVE))
K ^TMP("HL7",$J),LRMOVE
Q
;
PV1 ;
;I $O(^TMP($J,LRPROT,DFN,LRENDT,""))!('$D(^TMP("LREPISRCH",$J,DFN)))!($P(LRNDTDA,"^",3))="UPDT" D PV1^LREPI3 S LRPVVV=1
I LRPV1>1,$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH))="",$P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)'="UPDT" Q
I $P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)="UPDT" D PV1^LREPI3 S LRPVVV=1 Q
I $O(^TMP($J,LRPROT,DFN,LRENDT,""))]"" D PV1^LREPI3 S LRPVVV=1 Q
I '$D(^TMP("LREPISRCH",$J,DFN)) D PV1^LREPI3 S LRPVVV=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI2 5740 printed Apr 09, 2024@21:20:38 Page 2
LREPI2 ;DALOI/SED - EMERGING PATHOGENS HL7 BUILD ;23 Apr 2013 4:22 PM
+1 ;;5.2;LAB SERVICE;**132,157,175,242,260,281,320,421**;Sep 27, 1994;Build 48
+2 ;
+3 ;Reference to ^DPT(DFN,0),U,9) supported by IA # 10035
START ;START WITH THE PROTOCOL USED
+1 SET LRPROT=0
FOR
SET LRPROT=$ORDER(^TMP($JOB,LRPROT))
if +LRPROT'>0
QUIT
Begin DoDot:1
+2 DO INIT^HLFNC2(LRPROT,.HL)
+3 SET LRCS=$EXTRACT(HL("ECH"))
SET LRMSGNM=1
SET LRMSGSZ=0
+4 SET LRMSGDF=$SELECT(+$PIECE($GET(^LAB(69.4,LRPROT,0)),U,3)>0:+$PIECE($GET(^LAB(69.4,LRPROT,0)),U,3),1:30000)
+5 DO EN
IF LRMSGSZ
DO MOVE
DO SEND
+6 FOR LRTND="ETI","TST","HEP"
if $DATA(^TMP($JOB,LRTND))
DO TOTAL
+7 DO SEND
DO ALERT
End DoDot:1
+8 DO REPORT^LREPIRP
+9 KILL ^TMP("HLS",$JOB)
+10 KILL LRMSGDF,LRMSGNM,LRMSGSZ,%,%X
+11 QUIT
ALERT ;Send a Alert if desired.
+1 KILL XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
+2 if +$GET(LRRTYPE)=1
QUIT
+3 SET X="NOW"
SET %DT="SRT"
DO ^%DT
DO DD^%DT
+4 SET XQAMSG=$PIECE(^LAB(69.4,LRPROT,0),U,5)_" Was processed at "_Y
+5 ;GET THE DUZ'S FOR ALERTS
+6 SET LRIEN=0
FOR
SET LRIEN=$ORDER(^LAB(69.4,LRPROT,1,LRIEN))
if +LRIEN'>0
QUIT
Begin DoDot:1
+7 SET LRDATA=$GET(^LAB(69.4,LRPROT,1,LRIEN,0))
+8 IF $PIECE(LRDATA,";",2)["VA(200"
SET XQA($PIECE(LRDATA,";",1))=""
+9 IF $PIECE(LRDATA,";",2)["XMB(3.8"
Begin DoDot:2
+10 ;Q:'$D(^XMB(3.8,LRMG))
SET LRMG=$PIECE(LRDATA,";",1)
+11 SET LRMGN=$$GET1^DIQ(69.4,LRMG,1)
if LRMGN=""
QUIT
+12 SET X=LRMGN
SET XMDUZ=DUZ
DO INST^XMA21
+13 ;S LRDUZ=0 F S LRDUZ=$O(^XMB(3.8,LRMG,1,"B",LRDUZ)) Q:+LRDUZ'>0 S XQA(LRDUZ)=""
End DoDot:2
End DoDot:1
+14 if '$DATA(XQA)
QUIT
+15 DO SETUP^XQALERT
+16 QUIT
SEND ;SEND THE HL7 MESSAGE
+1 DO HEAD
+2 NEW HLP
+3 SET HLP("NAMESPACE")="LR"
+4 DO GENERATE^HLMA(LRPROT,"GM",1,.HLRST,"",.HLP)
+5 SET LRMSGNM=LRMSGNM+1
SET LRMSGSZ=0
+6 KILL ^TMP("HLS",$JOB)
+7 QUIT
EN ;ENTRY TO BUILD A MESSAGE
+1 SET (LRCNT,LRPID)=1
SET DFN=0
+2 FOR
SET DFN=$ORDER(^TMP($JOB,LRPROT,DFN))
if +DFN'>0
QUIT
Begin DoDot:1
+3 IF LRMSGSZ>5000
DO MOVE
DO SEND
+4 if $EXTRACT($PIECE(^DPT(DFN,0),U,9),1,5)="00000"
QUIT
+5 DO PID^LREPI3
+6 SET LRPV1=1
SET LRENDT=0
SET LRPFG=""
SET LREFG=0
SET LRPVVV=0
+7 FOR
SET LRENDT=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT))
SET LRPFG=""
if +LRENDT'>0!(LREFG)
QUIT
Begin DoDot:2
+8 DO PV1
+9 IF $DATA(^TMP("LREPISRCH",$JOB,DFN))
IF LRPROT=LRPROTX
DO RXNT^LREPIPH
+10 SET LRPATH=0
SET LRNTE=1
SET LRPVVV=1
+11 FOR
SET LRPATH=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH))
if +LRPATH'>0!(LREFG)
QUIT
Begin DoDot:3
+12 if LRPFG'=LRPATH
DO NTE^LREPI3
+13 SET LRPFG=LRPATH
SET LROBR=1
SET LRINVD=0
+14 FOR
SET LRINVD=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH,LRINVD))
if +LRINVD'>0!(LREFG)
QUIT
Begin DoDot:4
+15 SET LRND=""
+16 FOR
SET LRND=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND))
if LRND=""!(LREFG)
QUIT
Begin DoDot:5
+17 SET LRDFN=$$LRDFN^LR7OR1(DFN)
if 'LRDFN
QUIT
+18 SET LREFG=+$PIECE($GET(^LAB(69.5,LRPATH,0)),U,6)
+19 if LRND'="PTF"
SET LROBR=$$EN^LREPI1(LRDFN,LRND,LRINVD,LROBR)+1
+20 if LRND="PTF"
DO DG1^LREPI3
+21 DO MOVE
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
TOTAL ;Report the total counts -> "ETI" or "TST" or "HEP"
+1 ; \/
+2 SET LRITN=0
FOR
SET LRITN=$ORDER(^TMP($JOB,LRTND,LRITN))
if +LRITN'>0
QUIT
Begin DoDot:1
+3 SET (LRNLT,LRTNM)=""
+4 IF LRTND="TST"
Begin DoDot:2
+5 IF '$DATA(^TMP($JOB,"TPROT",LRITN,LRPROT))
QUIT
+6 SET LRTNM=$PIECE($GET(^LAB(60,LRITN,0)),U,1)
+7 SET LRNL=$GET(^LAB(60,LRITN,64))
if +LRNL'>0
QUIT
+8 if '$DATA(^LAM(LRNL,0))
QUIT
+9 SET LRNLT=$PIECE(^LAM(LRNL,0),U,2)
End DoDot:2
+10 IF LRTND="ETI"
Begin DoDot:2
+11 IF '$DATA(^TMP($JOB,"EPROT",LRITN))
QUIT
+12 SET LRTNM=$PIECE($GET(^LAB(61.2,LRITN,0)),U,1)
+13 SET LRNL=$GET(^LAB(61.2,LRITN,64))
if +LRNL'>0
QUIT
+14 if '$DATA(^LAM(LRNL,0))
QUIT
+15 SET LRNLT=$PIECE(^LAM(LRNL,0),U,2)
End DoDot:2
+16 IF LRTND="STOT"
Begin DoDot:2
+17 IF '$DATA(^TMP($JOB,"SPROT",LRITN,LRPROT))
QUIT
+18 SET LRTNM=""
+19 SET LRNL=LRITN
+20 SET LRNLT=""
End DoDot:2
+21 IF LRTND="HEP"
Begin DoDot:2
+22 IF '$DATA(^TMP($JOB,"HEP",LRITN))
QUIT
+23 SET LRNLT=""
+24 IF LRITN=1
SET LRTNM="1-Declined Assessment for Hepatitis C"
+25 IF LRITN=2
SET LRTNM="2-No Risk Factors for Hepatitis C"
+26 IF LRITN=3
SET LRTNM="3-Previously Assessed for Hepatitis C"
+27 IF LRITN=4
SET LRTNM="4-Risk Factors for Hepatitis C"
+28 IF LRITN=5
SET LRTNM="5-Positive Test for Hepatitis C antibody"
+29 IF LRITN=6
SET LRTNM="6-Negative Test for Hepatitis C antibody"
+30 IF LRITN=7
SET LRTNM="7- Hepatitis C diagnosis (ICD based)"
End DoDot:2
+31 KILL LRDATA
+32 IF '$GET(LRTNM)
DO NAME
+33 SET LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_LRTNM_LRCS_+^TMP($JOB,LRTND,LRITN)
+34 SET LRCNT=LRCNT+1
+35 SET ^TMP("HLS",$JOB,LRCNT)=$$UP^XLFSTR(LRDATA)
+36 SET ^TMP("LREPIREP",$JOB,LRCNT)=$$UP^XLFSTR(LRDATA)
+37 KILL LRDATA
+38 SET (LRPCNT,LRPTOT)=0
+39 FOR
SET LRPCNT=$ORDER(^TMP($JOB,LRTND,LRITN,LRPCNT))
if +LRPCNT'>0
QUIT
SET LRPTOT=LRPTOT+1
+40 if LRPTOT'>0
QUIT
+41 IF '$GET(LRTNM)
DO NAME
+42 ;+^TMP($J,LRPCNT,LRITN)
SET LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_"PATIENTS WITH "_LRTNM_LRCS_LRPTOT
+43 SET LRCNT=LRCNT+1
+44 SET ^TMP("HLS",$JOB,LRCNT)=$$UP^XLFSTR(LRDATA)
+45 SET ^TMP("LREPIREP",$JOB,LRCNT)=$$UP^XLFSTR(LRDATA)
End DoDot:1
+46 QUIT
NAME ;
+1 if LRTND'="TST"
QUIT
+2 SET LRTNM=$PIECE($GET(^LAB(60,LRITN,0)),U,1)
+3 SET LRNL=$GET(^LAB(60,LRITN,64))
if +LRNL'>0
QUIT
+4 if '$DATA(^LAM(LRNL,0))
QUIT
+5 SET LRNLT=$PIECE(^LAM(LRNL,0),U,2)
+6 ;
+7 QUIT
HEAD ;ENTER A NTE FOR REPORT HEADER
+1 KILL LRDATA
+2 SET LRDATA="NTE"_HLFS_HLFS_$SELECT(LRRTYPE:"R",1:"")_LRCS
+3 IF $GET(LR31799Z)=1
SET LRDATA=LRDATA_"*** H E P A T I T I S C MARCH 17 1999 ***"
+4 SET LRDATA=LRDATA_"REPORTING DATE FROM "_$$HLDATE^HLFNC(LRRPS)
+5 SET LRDATA=LRDATA_" TO "_$$HLDATE^HLFNC(LRRPE)
+6 SET LRDATA=LRDATA_LRCS_LRMSGNM
+7 IF LRPROTX=LRPROT
SET LRDATA=LRDATA_LRCS_LRCS_"V3"
+8 IF '$ORDER(^TMP("HLS",$JOB,1))
SET LRDATA=LRDATA_LRCS_"N"
+9 SET ^TMP("HLS",$JOB,1)=$$UP^XLFSTR(LRDATA)
SET LRMSGSZ=LRMSGSZ+$LENGTH(LRDATA)
+10 SET ^TMP("LREPIREP",$JOB,1)=$$UP^XLFSTR(LRDATA)
+11 KILL LRDATA
+12 QUIT
MOVE SET LRMOVE=0
+1 FOR
SET LRMOVE=$ORDER(^TMP("HL7",$JOB,LRMOVE))
if +LRMOVE'>0
QUIT
Begin DoDot:1
+2 SET LRCNT=LRCNT+1
+3 SET ^TMP("HLS",$JOB,LRCNT)=^TMP("HL7",$JOB,LRMOVE)
+4 SET ^TMP("LREPIREP",$JOB,LRCNT)=^TMP("HL7",$JOB,LRMOVE)
+5 SET LRMSGSZ=LRMSGSZ+$LENGTH(^TMP("HL7",$JOB,LRMOVE))
End DoDot:1
+6 KILL ^TMP("HL7",$JOB),LRMOVE
+7 QUIT
+8 ;
PV1 ;
+1 ;I $O(^TMP($J,LRPROT,DFN,LRENDT,""))!('$D(^TMP("LREPISRCH",$J,DFN)))!($P(LRNDTDA,"^",3))="UPDT" D PV1^LREPI3 S LRPVVV=1
+2 IF LRPV1>1
IF $ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH))=""
IF $PIECE($GET(^TMP($JOB,LRPROT,DFN,LRENDT)),"^",3)'="UPDT"
QUIT
+3 IF $PIECE($GET(^TMP($JOB,LRPROT,DFN,LRENDT)),"^",3)="UPDT"
DO PV1^LREPI3
SET LRPVVV=1
QUIT
+4 IF $ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,""))]""
DO PV1^LREPI3
SET LRPVVV=1
QUIT
+5 IF '$DATA(^TMP("LREPISRCH",$JOB,DFN))
DO PV1^LREPI3
SET LRPVVV=1
QUIT
