LREPIRP ;VA/DALOI/CKA-EMERGING PATHOGENS VERIFICATION REPORT ;9/30/03
;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
; Reference to ^ORD(101 supported by IA #872
Q
REPORT ;
D NOW^%DTC S LRDATE=%
S LRSP=" "
S (LRPV1CNT,LRDG1CNT,LROBRCNT,LROBXCNT,LRNTECNT,LRDSPCNT,LRZXECNT,LRTOTCNT)=0
S MSGCNT=1,HLFS=HL("FS")
;SORT DATA FOR REPORT
RPT S LRI=0
F S LRI=$O(^TMP("LREPIREP",$J,LRI)) Q:'LRI S LRTMP=^(LRI),SEG=$P(LRTMP,HLFS,1) I $L($T(@SEG)) D
PID .;PATIENT INFO
.I SEG="PID" D
..S DFN=$P($P(LRTMP,HLFS,4),"~")
..S ^TMP($J,"TMP",DFN,"PID")=LRTMP
PV1 .;PATIENT VISIT ENCOUNTER
.I SEG="PV1" D
..S (LRDG1CNT,LROBRCNT,LROBXCNT,LRNTECNT,LRDSPCNT,LRZXECNT)=0
..S LRPV1CNT=LRPV1CNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT)=LRTMP
DG1 .;DIAGNOSES
.I SEG="DG1" D
..S LRDG1CNT=LRDG1CNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"DG1",LRDG1CNT)=LRTMP
OBR .;OBSERVATION REPORTING
.I SEG="OBR" D
..S LROBXCNT=0
..S LROBRCNT=LROBRCNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT,"OBR",LROBRCNT)=LRTMP
OBX .;RESULTS
.I SEG="OBX" D
..S LROBXCNT=LROBXCNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT,"OBR",LROBRCNT,"OBX",LROBXCNT)=LRTMP
.I SEG="NTE",$D(DFN),$P($P(LRTMP,HLFS,3),LRCS,1)>0 D
..S LROBRCNT=0
..S LRNTECNT=LRNTECNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT)=LRTMP
ZXE .;ZXE
.I SEG="ZXE" D
..S LRZXECNT=LRZXECNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"ZXE",LRZXECNT)=LRTMP
DSP .;DSP
.I SEG="DSP" D
..S LRDSPCNT=LRDSPCNT+1
..S ^TMP($J,"TMP",DFN,"PID","PV1",LRPV1CNT,"DSP",LRDSPCNT)=LRTMP
TOTALS .;SAVE TOTALS IN NTE
.I SEG="NTE"&($P($P(LRTMP,HLFS,3),LRCS)="T") S LRDONE=0 D
..F LRNUM=1:1:7 I $P($P($P(LRTMP,HLFS,3),LRCS,3),"-")=LRNUM D
...S ^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM)=$P($P(LRTMP,HLFS,3),LRCS,4)
...S LRDONE=1
..Q:LRDONE
..S LRTOTCNT=LRTOTCNT+1
..S ^XTMP("LREPIREP"_LRDATE,"TOTAL1",LRTOTCNT)=LRTMP
K LRDONE
RESORT ;SAVE DATA BY NTE IN ^XTMP
S X1=DT,X2=180,LRUPDNUM=0 D C^%DTC
S ^XTMP("LREPIREP"_LRDATE,0)=X_"^"_DT_"^EPI Verification Report^"_$S($D(DUZ):DUZ,1:"UNKNOWN")
S DFN=0,LRCNT=1,LRZXECNT=1,LRDSPCNT=1
F S DFN=$O(^TMP($J,"TMP",DFN)) Q:'DFN D
.S LRPV1=0,LRDSP=0,LRZXE=0
.F S LRPV1=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1)) Q:'LRPV1 S LRPV1N=^(LRPV1) D
..S LRTMP=^TMP($J,"TMP",DFN,"PID")
..S LRNAME=$P(LRTMP,HLFS,6),SSN=$E($P(LRTMP,HLFS,20),6,9),LRADMDT=$$CDT^LREPIRP2($P(LRPV1N,HLFS,45)),LRDISDT=$$CDT^LREPIRP2($P(LRPV1N,HLFS,46))
..S TYPE=$P(LRPV1N,HLFS,3),TYPE=$S(TYPE="U":"U",TYPE="I":"Inpatient",1:"Outpatient")
..I TYPE="U" D
...S ^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM)=LRNAME_$E(LRSP,1,25-$L(LRNAME))_SSN_" "_LRADMDT_$E(LRSP,1,18-$L(LRADMDT))_LRDISDT
...S LRUPDNUM=LRUPDNUM+1
..F S LRDSP=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"DSP",LRDSP)) Q:'LRDSP S LRDSPN=^(LRDSP) D S LRDSPCNT=1
...S ^XTMP("LREPIREP"_LRDATE,"DSP",$P($P(LRDSPN,HLFS,4),LRCS,2),DFN,LRDSPCNT)=SSN_" "_LRNAME_$E(LRSP,1,25-$L(LRNAME))_TYPE_" "_$$CDT^LREPIRP2($P($P(LRDSPN,HLFS,4),LRCS))
...S LRDSPCNT=LRDSPCNT+1
..F S LRZXE=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"ZXE",LRZXE)) Q:'LRZXE S LRZXEN=^(LRZXE) D S LRZXECNT=LRZXECNT+1
...S ^XTMP("LREPIREP"_LRDATE,"ZXE",$P($P(LRZXEN,HLFS,3),LRCS),DFN,LRZXECNT)=SSN_" "_LRNAME_$E(LRSP,1,25-$L(LRNAME))_TYPE_" "_$$CDT^LREPIRP2($P(LRZXEN,HLFS,6))
...S LRZXECNT=LRZXECNT+1
..S LRNTE=0
..F S LRNTE=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE)) Q:'LRNTE D
...S LRTYPE=$P($P(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE),HLFS,3),LRCS,1)
...F LRNUM1=1,3,4,5,6,8,10,18,19,20,21,22,23 D:LRTYPE=LRNUM1
....S LRTMP=^TMP($J,"TMP",DFN,"PID")
....D PID^LREPIRP2
....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1)
....D PV1^LREPIRP2
....S LROBR=0
....F S LROBR=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)) Q:'LROBR D
.....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
.....D OBR^LREPIRP2
.....S LROBX=0
.....F S LROBX=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)) Q:'LROBX D
......S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
......D OBX^LREPIRP2
...F LRNUM1=11,12,13,14 D:LRTYPE=LRNUM1
....S LRTMP=^TMP($J,"TMP",DFN,"PID")
....D PID^LREPIRP2
....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1)
....D PV1^LREPIRP2
....S LRDG1=0
....F S LRDG1=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)) Q:'LRDG1 D
.....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)
.....D DG1^LREPIRP3
...F LRNUM1=7,9 D:LRTYPE=LRNUM1
....S LRTMP=^TMP($J,"TMP",DFN,"PID")
....D PID^LREPIRP2
....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1)
....D PV1^LREPIRP2
....S LRDG1=0
....F S LRDG1=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)) Q:'LRDG1 D
.....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)
.....D DG1^LREPIRP3
....S LROBR=0
....F S LROBR=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)) Q:'LROBR D
.....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
.....D OBR^LREPIRP2
.....S LROBX=0
.....F S LROBX=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)) Q:'LROBX D
......S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
......D OBX^LREPIRP2
...F LRNUM1=2,15,16,17 D:LRTYPE=LRNUM1
....S LROBR=0
....F S LROBR=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)) Q:'LROBR D
.....S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
.....S LRACCDT=$$CDT($P(LRTMP,HLFS,8))
.....S LROBX=0
.....F S LROBX=$O(^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)) Q:'LROBX D
......S LRTMP=^TMP($J,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
......D OBX^LREPIRP4 S LRACCDT=""
D HDG^LREPIRP3,HDGS^LREPIRP6
CALTOT ;CALCULATE TOTALS
;SAVE IN ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=# of Occurrences^# of persons with occurrences
S (LRPATH,LRDFN,LRPV1,LROBR,LRPATHCT,LRPERCNT)=0
F LRPATH=1,3:1:14,18:1:23 D S ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=LRPATHCT_U_LRPERCNT,LRPATHCT=0,LRPERCNT=0,LRDFN=0
.F S LRDFN=$O(^TMP($J,"TMP",LRDFN)) Q:LRDFN="" D
..S LRPV1=0,LRPV1NUM=1
..F S LRPV1=$O(^TMP($J,"TMP",LRDFN,"PID","PV1",LRPV1)) Q:LRPV1="" D
...S LRNTE=0
...F S LRNTE=$O(^TMP($J,"TMP",LRDFN,"PID","PV1",LRPV1,"NTE",LRNTE)) Q:LRNTE="" D
....S LRTYPE=$P($P(^TMP($J,"TMP",LRDFN,"PID","PV1",LRPV1,"NTE",LRNTE),HLFS,3),LRCS,1)
....Q:LRTYPE'=LRPATH
....I LRPV1NUM=1 S LRPERCNT=LRPERCNT+1
....S LRPATHCT=LRPATHCT+1
....S LRPV1NUM=LRPV1NUM+1
S (LRPATH,LRDFN,LRPATHCT,LRPERCNT)=0
F LRPATH=2,15,16,17 D S ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=LRPATHCT_U_LRPERCNT,LRPATHCT=0,LRPERCNT=0,LRDFN=0
.F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN)) Q:LRDFN="HDG"!(LRDFN="") D
..S LRPERCNT=LRPERCNT+1,LRCNT=0
..F S LRCNT=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRCNT)) Q:LRCNT="" D
...S LRPATHCT=LRPATHCT+1
S ^XTMP("LREPIREP"_LRDATE,"DONE")=1
MMMSG I $D(LRPREV) D
.S MSG="This report represents a second pass at aquiring data for the EPI from"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="the prior month on Mycobacterium tuberculosis due to the extended"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="period of time that may be expected with accessioning, growth, and"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="finally reporting of results. Since this is designed to aquire only"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="the remaining Mycobacterium tuberculosis data from the prior month,"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="most of the numbers present for this report will be zero. The"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="accompanying Summary Verification Report for the current month should"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="contain more complete number counts on the other EPI pathogens and"
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
.S MSG="data items for this current month."
.S ^TMP($J,"MSG",MSGCNT)=MSG,MSGCNT=MSGCNT+1,MSG=""
D MSH
S LRPROT=0,LRPROT=$O(^ORD(101,"B","LREPI",LRPROT))
S LRMGP=$P($G(^LAB(69.4,LRPROT,0)),U,2)
I +LRMGP'>0 W !,"NO MAILGROUP TO SEND MESSAGE!" G EXIT
S LRMGPN=$$GET1^DIQ(69.4,LRPROT,1)
S XMSUB="EPI Summary Verification Report"
I $D(LRPREV) S XMSUB=XMSUB_" for prior month -TB only"
S XMDUZ="POSTMASTER"
S XMY("G."_LRMGPN)="" ;$P(^XMB(3.8,LRMGP,0),U,1))=""
S XMTEXT="^TMP("_$J_",""MSG"","
D ^XMD
K LRMGP,LRMGPN
K ISITE
EXIT K LRACCDT,LRDSPN,LRSP,LRPREV,LRZXEN,XMDUZ,XMSUB,XMTEXT,XMY Q
MSH ;
D SUMHD1^LREPIRP1
D SUMMARY^LREPIRP5
D NOTE1^LREPIRP1
D SUMHD3^LREPIRP1
D PRTHEP^LREPIRP5
D NOTE2^LREPIRP1
D PRTTOT^LREPIRP5
D NOTE3^LREPIRP1
Q
NTE ;NOTE AND COMMENTS
;D NTE^LREPIRP4
S TYPE=$P($P(LRHL7,HLFS,3),LRCS,1),MSG=""
I TYPE="T" D
.S MSG="TOTAL "_$P($P(LRHL7,HLFS,3),LRCS,2)_" "
.S MSG=MSG_$P($P(LRHL7,HLFS,3),LRCS,3)_" "_$P($P(LRHL7,HLFS,3),LRCS,4)
I +TYPE>0 D
.;S:$G(^TMP($J,"MSG",(MSGCNT-1)))'="" ^TMP($J,"MSG",MSGCNT)="",MSGCNT=MSGCNT+1
.S MSG="********* "_TYPE_" "_$P($P(LRHL7,HLFS,3),LRCS,2)_" *********"
K TYPE
Q
CDT(DATE) ;CONVERTS THE DATE AND TIME
S X=$E(DATE,5,6)_"-"_$E(DATE,7,8)_"-"_$E(DATE,1,4)
S:$E(DATE,9,12)'="" X=X_"@"_$E(DATE,9,12)
S:X="--" X=""
Q X
PROCESS ;THIS IS THE HL7 PROCESSING ROUTINE ENTRY POINT TO PREVENT HL7 ERRORS
Q
LREPIRP ;VA/DALOI/CKA-EMERGING PATHOGENS VERIFICATION REPORT ;9/30/03
+1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
+2 ;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
+3 ; Reference to ^ORD(101 supported by IA #872
+4 QUIT
REPORT ;
+1 DO NOW^%DTC
SET LRDATE=%
+2 SET LRSP=" "
+3 SET (LRPV1CNT,LRDG1CNT,LROBRCNT,LROBXCNT,LRNTECNT,LRDSPCNT,LRZXECNT,LRTOTCNT)=0
+4 SET MSGCNT=1
SET HLFS=HL("FS")
+5 ;SORT DATA FOR REPORT
RPT SET LRI=0
+1 FOR
SET LRI=$ORDER(^TMP("LREPIREP",$JOB,LRI))
IF 'LRI
QUIT
SET LRTMP=^(LRI)
SET SEG=$PIECE(LRTMP,HLFS,1)
IF $LENGTH($TEXT(@SEG))
Begin DoDot:1
PID ;PATIENT INFO
+1 IF SEG="PID"
Begin DoDot:2
+2 SET DFN=$PIECE($PIECE(LRTMP,HLFS,4),"~")
+3 SET ^TMP($JOB,"TMP",DFN,"PID")=LRTMP
End DoDot:2
PV1 ;PATIENT VISIT ENCOUNTER
+1 IF SEG="PV1"
Begin DoDot:2
+2 SET (LRDG1CNT,LROBRCNT,LROBXCNT,LRNTECNT,LRDSPCNT,LRZXECNT)=0
+3 SET LRPV1CNT=LRPV1CNT+1
+4 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT)=LRTMP
End DoDot:2
DG1 ;DIAGNOSES
+1 IF SEG="DG1"
Begin DoDot:2
+2 SET LRDG1CNT=LRDG1CNT+1
+3 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"DG1",LRDG1CNT)=LRTMP
End DoDot:2
OBR ;OBSERVATION REPORTING
+1 IF SEG="OBR"
Begin DoDot:2
+2 SET LROBXCNT=0
+3 SET LROBRCNT=LROBRCNT+1
+4 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT,"OBR",LROBRCNT)=LRTMP
End DoDot:2
OBX ;RESULTS
+1 IF SEG="OBX"
Begin DoDot:2
+2 SET LROBXCNT=LROBXCNT+1
+3 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT,"OBR",LROBRCNT,"OBX",LROBXCNT)=LRTMP
End DoDot:2
+4 IF SEG="NTE"
IF $DATA(DFN)
IF $PIECE($PIECE(LRTMP,HLFS,3),LRCS,1)>0
Begin DoDot:2
+5 SET LROBRCNT=0
+6 SET LRNTECNT=LRNTECNT+1
+7 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"NTE",LRNTECNT)=LRTMP
End DoDot:2
ZXE ;ZXE
+1 IF SEG="ZXE"
Begin DoDot:2
+2 SET LRZXECNT=LRZXECNT+1
+3 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"ZXE",LRZXECNT)=LRTMP
End DoDot:2
DSP ;DSP
+1 IF SEG="DSP"
Begin DoDot:2
+2 SET LRDSPCNT=LRDSPCNT+1
+3 SET ^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1CNT,"DSP",LRDSPCNT)=LRTMP
End DoDot:2
TOTALS ;SAVE TOTALS IN NTE
+1 IF SEG="NTE"&($PIECE($PIECE(LRTMP,HLFS,3),LRCS)="T")
SET LRDONE=0
Begin DoDot:2
+2 FOR LRNUM=1:1:7
IF $PIECE($PIECE($PIECE(LRTMP,HLFS,3),LRCS,3),"-")=LRNUM
Begin DoDot:3
+3 SET ^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM)=$PIECE($PIECE(LRTMP,HLFS,3),LRCS,4)
+4 SET LRDONE=1
End DoDot:3
+5 IF LRDONE
QUIT
+6 SET LRTOTCNT=LRTOTCNT+1
+7 SET ^XTMP("LREPIREP"_LRDATE,"TOTAL1",LRTOTCNT)=LRTMP
End DoDot:2
End DoDot:1
+8 KILL LRDONE
RESORT ;SAVE DATA BY NTE IN ^XTMP
+1 SET X1=DT
SET X2=180
SET LRUPDNUM=0
DO C^%DTC
+2 SET ^XTMP("LREPIREP"_LRDATE,0)=X_"^"_DT_"^EPI Verification Report^"_$SELECT($DATA(DUZ):DUZ,1:"UNKNOWN")
+3 SET DFN=0
SET LRCNT=1
SET LRZXECNT=1
SET LRDSPCNT=1
+4 FOR
SET DFN=$ORDER(^TMP($JOB,"TMP",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+5 SET LRPV1=0
SET LRDSP=0
SET LRZXE=0
+6 FOR
SET LRPV1=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1))
IF 'LRPV1
QUIT
SET LRPV1N=^(LRPV1)
Begin DoDot:2
+7 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID")
+8 SET LRNAME=$PIECE(LRTMP,HLFS,6)
SET SSN=$EXTRACT($PIECE(LRTMP,HLFS,20),6,9)
SET LRADMDT=$$CDT^LREPIRP2($PIECE(LRPV1N,HLFS,45))
SET LRDISDT=$$CDT^LREPIRP2($PIECE(LRPV1N,HLFS,46))
+9 SET TYPE=$PIECE(LRPV1N,HLFS,3)
SET TYPE=$SELECT(TYPE="U":"U",TYPE="I":"Inpatient",1:"Outpatient")
+10 IF TYPE="U"
Begin DoDot:3
+11 SET ^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM)=LRNAME_$EXTRACT(LRSP,1,25-$LENGTH(LRNAME))_SSN_" "_LRADMDT_$EXTRACT(LRSP,1,18-$LENGTH(LRADMDT))_LRDISDT
+12 SET LRUPDNUM=LRUPDNUM+1
End DoDot:3
+13 FOR
SET LRDSP=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"DSP",LRDSP))
IF 'LRDSP
QUIT
SET LRDSPN=^(LRDSP)
Begin DoDot:3
+14 SET ^XTMP("LREPIREP"_LRDATE,"DSP",$PIECE($PIECE(LRDSPN,HLFS,4),LRCS,2),DFN,LRDSPCNT)=SSN_" "_LRNAME_$EXTRACT(LRSP,1,25-$LENGTH(LRNAME))_TYPE_" "_$$CDT^LREPIRP2($PIECE($PIECE(LRDSPN,HLFS,4),LRCS))
+15 SET LRDSPCNT=LRDSPCNT+1
End DoDot:3
SET LRDSPCNT=1
+16 FOR
SET LRZXE=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"ZXE",LRZXE))
IF 'LRZXE
QUIT
SET LRZXEN=^(LRZXE)
Begin DoDot:3
+17 SET ^XTMP("LREPIREP"_LRDATE,"ZXE",$PIECE($PIECE(LRZXEN,HLFS,3),LRCS),DFN,LRZXECNT)=SSN_" "_LRNAME_$EXTRACT(LRSP,1,25-$LENGTH(LRNAME))_TYPE_" "_$$CDT^LREPIRP2($PIECE(LRZXEN,HLFS,6))
+18 SET LRZXECNT=LRZXECNT+1
End DoDot:3
SET LRZXECNT=LRZXECNT+1
+19 SET LRNTE=0
+20 FOR
SET LRNTE=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE))
IF 'LRNTE
QUIT
Begin DoDot:3
+21 SET LRTYPE=$PIECE($PIECE(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE),HLFS,3),LRCS,1)
+22 FOR LRNUM1=1,3,4,5,6,8,10,18,19,20,21,22,23
IF LRTYPE=LRNUM1
Begin DoDot:4
+23 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID")
+24 DO PID^LREPIRP2
+25 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1)
+26 DO PV1^LREPIRP2
+27 SET LROBR=0
+28 FOR
SET LROBR=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR))
IF 'LROBR
QUIT
Begin DoDot:5
+29 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
+30 DO OBR^LREPIRP2
+31 SET LROBX=0
+32 FOR
SET LROBX=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX))
IF 'LROBX
QUIT
Begin DoDot:6
+33 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
+34 DO OBX^LREPIRP2
End DoDot:6
End DoDot:5
End DoDot:4
+35 FOR LRNUM1=11,12,13,14
IF LRTYPE=LRNUM1
Begin DoDot:4
+36 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID")
+37 DO PID^LREPIRP2
+38 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1)
+39 DO PV1^LREPIRP2
+40 SET LRDG1=0
+41 FOR
SET LRDG1=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1))
IF 'LRDG1
QUIT
Begin DoDot:5
+42 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)
+43 DO DG1^LREPIRP3
End DoDot:5
End DoDot:4
+44 FOR LRNUM1=7,9
IF LRTYPE=LRNUM1
Begin DoDot:4
+45 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID")
+46 DO PID^LREPIRP2
+47 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1)
+48 DO PV1^LREPIRP2
+49 SET LRDG1=0
+50 FOR
SET LRDG1=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1))
IF 'LRDG1
QUIT
Begin DoDot:5
+51 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"DG1",LRDG1)
+52 DO DG1^LREPIRP3
End DoDot:5
+53 SET LROBR=0
+54 FOR
SET LROBR=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR))
IF 'LROBR
QUIT
Begin DoDot:5
+55 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
+56 DO OBR^LREPIRP2
+57 SET LROBX=0
+58 FOR
SET LROBX=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX))
IF 'LROBX
QUIT
Begin DoDot:6
+59 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
+60 DO OBX^LREPIRP2
End DoDot:6
End DoDot:5
End DoDot:4
+61 FOR LRNUM1=2,15,16,17
IF LRTYPE=LRNUM1
Begin DoDot:4
+62 SET LROBR=0
+63 FOR
SET LROBR=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR))
IF 'LROBR
QUIT
Begin DoDot:5
+64 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR)
+65 SET LRACCDT=$$CDT($PIECE(LRTMP,HLFS,8))
+66 SET LROBX=0
+67 FOR
SET LROBX=$ORDER(^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX))
IF 'LROBX
QUIT
Begin DoDot:6
+68 SET LRTMP=^TMP($JOB,"TMP",DFN,"PID","PV1",LRPV1,"NTE",LRNTE,"OBR",LROBR,"OBX",LROBX)
+69 DO OBX^LREPIRP4
SET LRACCDT=""
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+70 DO HDG^LREPIRP3
DO HDGS^LREPIRP6
CALTOT ;CALCULATE TOTALS
+1 ;SAVE IN ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=# of Occurrences^# of persons with occurrences
+2 SET (LRPATH,LRDFN,LRPV1,LROBR,LRPATHCT,LRPERCNT)=0
+3 FOR LRPATH=1,3:1:14,18:1:23
Begin DoDot:1
+4 FOR
SET LRDFN=$ORDER(^TMP($JOB,"TMP",LRDFN))
IF LRDFN=""
QUIT
Begin DoDot:2
+5 SET LRPV1=0
SET LRPV1NUM=1
+6 FOR
SET LRPV1=$ORDER(^TMP($JOB,"TMP",LRDFN,"PID","PV1",LRPV1))
IF LRPV1=""
QUIT
Begin DoDot:3
+7 SET LRNTE=0
+8 FOR
SET LRNTE=$ORDER(^TMP($JOB,"TMP",LRDFN,"PID","PV1",LRPV1,"NTE",LRNTE))
IF LRNTE=""
QUIT
Begin DoDot:4
+9 SET LRTYPE=$PIECE($PIECE(^TMP($JOB,"TMP",LRDFN,"PID","PV1",LRPV1,"NTE",LRNTE),HLFS,3),LRCS,1)
+10 IF LRTYPE'=LRPATH
QUIT
+11 IF LRPV1NUM=1
SET LRPERCNT=LRPERCNT+1
+12 SET LRPATHCT=LRPATHCT+1
+13 SET LRPV1NUM=LRPV1NUM+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
SET ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=LRPATHCT_U_LRPERCNT
SET LRPATHCT=0
SET LRPERCNT=0
SET LRDFN=0
+14 SET (LRPATH,LRDFN,LRPATHCT,LRPERCNT)=0
+15 FOR LRPATH=2,15,16,17
Begin DoDot:1
+16 FOR
SET LRDFN=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN))
IF LRDFN="HDG"!(LRDFN="")
QUIT
Begin DoDot:2
+17 SET LRPERCNT=LRPERCNT+1
SET LRCNT=0
+18 FOR
SET LRCNT=$ORDER(^XTMP("LREPIREP"_LRDATE,LRPATH,LRDFN,LRCNT))
IF LRCNT=""
QUIT
Begin DoDot:3
+19 SET LRPATHCT=LRPATHCT+1
End DoDot:3
End DoDot:2
End DoDot:1
SET ^XTMP("LREPIREP"_LRDATE,"TOTAL",LRPATH)=LRPATHCT_U_LRPERCNT
SET LRPATHCT=0
SET LRPERCNT=0
SET LRDFN=0
+20 SET ^XTMP("LREPIREP"_LRDATE,"DONE")=1
MMMSG IF $DATA(LRPREV)
Begin DoDot:1
+1 SET MSG="This report represents a second pass at aquiring data for the EPI from"
+2 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+3 SET MSG="the prior month on Mycobacterium tuberculosis due to the extended"
+4 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+5 SET MSG="period of time that may be expected with accessioning, growth, and"
+6 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+7 SET MSG="finally reporting of results. Since this is designed to aquire only"
+8 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+9 SET MSG="the remaining Mycobacterium tuberculosis data from the prior month,"
+10 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+11 SET MSG="most of the numbers present for this report will be zero. The"
+12 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+13 SET MSG="accompanying Summary Verification Report for the current month should"
+14 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+15 SET MSG="contain more complete number counts on the other EPI pathogens and"
+16 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
+17 SET MSG="data items for this current month."
+18 SET ^TMP($JOB,"MSG",MSGCNT)=MSG
SET MSGCNT=MSGCNT+1
SET MSG=""
End DoDot:1
+19 DO MSH
+20 SET LRPROT=0
SET LRPROT=$ORDER(^ORD(101,"B","LREPI",LRPROT))
+21 SET LRMGP=$PIECE($GET(^LAB(69.4,LRPROT,0)),U,2)
+22 IF +LRMGP'>0
WRITE !,"NO MAILGROUP TO SEND MESSAGE!"
GOTO EXIT
+23 SET LRMGPN=$$GET1^DIQ(69.4,LRPROT,1)
+24 SET XMSUB="EPI Summary Verification Report"
+25 IF $DATA(LRPREV)
SET XMSUB=XMSUB_" for prior month -TB only"
+26 SET XMDUZ="POSTMASTER"
+27 ;$P(^XMB(3.8,LRMGP,0),U,1))=""
SET XMY("G."_LRMGPN)=""
+28 SET XMTEXT="^TMP("_$JOB_",""MSG"","
+29 DO ^XMD
+30 KILL LRMGP,LRMGPN
+31 KILL ISITE
EXIT KILL LRACCDT,LRDSPN,LRSP,LRPREV,LRZXEN,XMDUZ,XMSUB,XMTEXT,XMY
QUIT
MSH ;
+1 DO SUMHD1^LREPIRP1
+2 DO SUMMARY^LREPIRP5
+3 DO NOTE1^LREPIRP1
+4 DO SUMHD3^LREPIRP1
+5 DO PRTHEP^LREPIRP5
+6 DO NOTE2^LREPIRP1
+7 DO PRTTOT^LREPIRP5
+8 DO NOTE3^LREPIRP1
+9 QUIT
NTE ;NOTE AND COMMENTS
+1 ;D NTE^LREPIRP4
+2 SET TYPE=$PIECE($PIECE(LRHL7,HLFS,3),LRCS,1)
SET MSG=""
+3 IF TYPE="T"
Begin DoDot:1
+4 SET MSG="TOTAL "_$PIECE($PIECE(LRHL7,HLFS,3),LRCS,2)_" "
+5 SET MSG=MSG_$PIECE($PIECE(LRHL7,HLFS,3),LRCS,3)_" "_$PIECE($PIECE(LRHL7,HLFS,3),LRCS,4)
End DoDot:1
+6 IF +TYPE>0
Begin DoDot:1
+7 ;S:$G(^TMP($J,"MSG",(MSGCNT-1)))'="" ^TMP($J,"MSG",MSGCNT)="",MSGCNT=MSGCNT+1
+8 SET MSG="********* "_TYPE_" "_$PIECE($PIECE(LRHL7,HLFS,3),LRCS,2)_" *********"
End DoDot:1
+9 KILL TYPE
+10 QUIT
CDT(DATE) ;CONVERTS THE DATE AND TIME
+1 SET X=$EXTRACT(DATE,5,6)_"-"_$EXTRACT(DATE,7,8)_"-"_$EXTRACT(DATE,1,4)
+2 IF $EXTRACT(DATE,9,12)'=""
SET X=X_"@"_$EXTRACT(DATE,9,12)
+3 IF X="--"
SET X=""
+4 QUIT X
PROCESS ;THIS IS THE HL7 PROCESSING ROUTINE ENTRY POINT TO PREVENT HL7 ERRORS
+1 QUIT
