- LREPIRP ;DALOI/CKA-EMERGING PATHOGENS VERIFICATION REPORT ;9/30/03
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRP 9704 printed Feb 18, 2025@23:40:16 Page 2
- LREPIRP ;DALOI/CKA-EMERGING PATHOGENS VERIFICATION REPORT ;9/30/03
- +1 ;;5.2;LAB SERVICE;**132,157,175,260,281,320**;Sep 27, 1994
- +2 ; Reference to ^ORD(101 supported by IA #872
- +3 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
