209 lines
9.3 KiB
Mathematica
209 lines
9.3 KiB
Mathematica
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
|