- LREPI2A ;DALOI/CKA - EMERGING PATHOGENS HL7 BUILD ;03 Jul 2013 4:27 PM
- ;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
- ;
- START ;START
- S LRPROT=0 F S LRPROT=$O(^TMP($J,LRPROT)) Q:+LRPROT'>0 D
- .D INIT^HLFNC2(LRPROT,.HL)
- .S LRMSGNM=1,LRMSGSZ=0,LRCS=$E(HL("ECH"))
- .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,MOVE
- .F LRTND="ETI","TST","HEP" D:$D(^TMP($J,LRTND)) TOTAL
- .D EN,MOVE,SEND
- .D ALERT
- K LRDUZ,LRMSGDF,%,%X
- Q
- SEND ;BUILD MESSAGE BUT DON'T SEND
- D HEAD
- I LRREP=2 D SPSHT^LREPIRS3 S ^XTMP("LREPILOCALSPSHT"_LRLRDT,"DONE")=1
- I LRREP=1 D REPORT^LREPIRS1 S ^XTMP("LREPILOCALREP"_LRLRDT,"DONE")=1
- K ^TMP("HLS",$J)
- K LRLC,LRHDGLC,HLFS,LRSEG,LRSPSHT,MSG,LRPID,LROBR,LRX
- Q
- ALERT ;Send a Alert if desired.
- K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
- S X="NOW",%DT="SRT" D ^%DT,DD^%DT
- S XQAMSG="The local report/spreadsheet finished generating at "_Y
- S XQA(LRDUZ)=""
- Q:'$D(XQA)
- D SETUP^XQALERT
- 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
- .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)
- .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)
- 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
- 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)
- 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)
- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI2A 4875 printed Feb 18, 2025@23:40:05 Page 2
- LREPI2A ;DALOI/CKA - EMERGING PATHOGENS HL7 BUILD ;03 Jul 2013 4:27 PM
- +1 ;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
- +2 ;
- START ;START
- +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 LRMSGNM=1
- SET LRMSGSZ=0
- SET LRCS=$EXTRACT(HL("ECH"))
- +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
- DO MOVE
- +6 FOR LRTND="ETI","TST","HEP"
- if $DATA(^TMP($JOB,LRTND))
- DO TOTAL
- +7 DO EN
- DO MOVE
- DO SEND
- +8 DO ALERT
- End DoDot:1
- +9 KILL LRDUZ,LRMSGDF,%,%X
- +10 QUIT
- SEND ;BUILD MESSAGE BUT DON'T SEND
- +1 DO HEAD
- +2 IF LRREP=2
- DO SPSHT^LREPIRS3
- SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,"DONE")=1
- +3 IF LRREP=1
- DO REPORT^LREPIRS1
- SET ^XTMP("LREPILOCALREP"_LRLRDT,"DONE")=1
- +4 KILL ^TMP("HLS",$JOB)
- +5 KILL LRLC,LRHDGLC,HLFS,LRSEG,LRSPSHT,MSG,LRPID,LROBR,LRX
- +6 QUIT
- ALERT ;Send a Alert if desired.
- +1 KILL XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
- +2 SET X="NOW"
- SET %DT="SRT"
- DO ^%DT
- DO DD^%DT
- +3 SET XQAMSG="The local report/spreadsheet finished generating at "_Y
- +4 SET XQA(LRDUZ)=""
- +5 if '$DATA(XQA)
- QUIT
- +6 DO SETUP^XQALERT
- +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 DO PID^LREPI3
- +4 SET LRPV1=1
- SET LRENDT=0
- SET LRPFG=""
- SET LREFG=0
- SET LRPVVV=0
- +5 FOR
- SET LRENDT=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT))
- SET LRPFG=""
- if +LRENDT'>0!(LREFG)
- QUIT
- Begin DoDot:2
- +6 DO PV1
- +7 IF $DATA(^TMP("LREPISRCH",$JOB,DFN))
- IF LRPROT=LRPROTX
- DO RXNT^LREPIPH
- +8 SET LRPATH=0
- SET LRNTE=1
- SET LRPVVV=1
- +9 FOR
- SET LRPATH=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH))
- if +LRPATH'>0!(LREFG)
- QUIT
- Begin DoDot:3
- +10 if LRPFG'=LRPATH
- DO NTE^LREPI3
- +11 SET LRPFG=LRPATH
- SET LROBR=1
- SET LRINVD=0
- +12 FOR
- SET LRINVD=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH,LRINVD))
- if +LRINVD'>0!(LREFG)
- QUIT
- Begin DoDot:4
- +13 SET LRND=""
- +14 FOR
- SET LRND=$ORDER(^TMP($JOB,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND))
- if LRND=""!(LREFG)
- QUIT
- Begin DoDot:5
- +15 SET LRDFN=$$LRDFN^LR7OR1(DFN)
- if 'LRDFN
- QUIT
- +16 SET LREFG=+$PIECE($GET(^LAB(69.5,LRPATH,0)),U,6)
- +17 if LRND'="PTF"
- SET LROBR=$$EN^LREPI1(LRDFN,LRND,LRINVD,LROBR)+1
- +18 if LRND="PTF"
- DO DG1^LREPI3
- +19 DO MOVE
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 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 KILL LRDATA
- +37 SET (LRPCNT,LRPTOT)=0
- +38 FOR
- SET LRPCNT=$ORDER(^TMP($JOB,LRTND,LRITN,LRPCNT))
- if +LRPCNT'>0
- QUIT
- SET LRPTOT=LRPTOT+1
- +39 if LRPTOT'>0
- QUIT
- +40 IF '$GET(LRTNM)
- DO NAME
- +41 ;+^TMP($J,LRPCNT,LRITN)
- SET LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_"PATIENTS WITH "_LRTNM_LRCS_LRPTOT
- +42 SET LRCNT=LRCNT+1
- +43 SET ^TMP("HLS",$JOB,LRCNT)=$$UP^XLFSTR(LRDATA)
- End DoDot:1
- +44 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
- +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)
- +10 KILL LRDATA
- +11 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)
- End DoDot:1
- +4 KILL ^TMP("HL7",$JOB),LRMOVE
- +5 QUIT
- +6 ;
- 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
- +6 QUIT