| 1 | LREPI5 ;DALOI/SED-EMERGING PATHOGENS SEARCH ;10/31/02
|
|---|
| 2 | ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
|
|---|
| 3 | ; Reference to ^DGPT supported by IA #418
|
|---|
| 4 | ; Reference to ^ICD9 supported by IA #10082
|
|---|
| 5 | ; Reference to ^ORD supported by IA #872
|
|---|
| 6 | ; Reference to PATS^PXRMXX supported by IA #3134
|
|---|
| 7 | ; Reference to VADPT supported by IA #10061
|
|---|
| 8 | ; Reference to ^AUPNVPOV supported by IA #3094
|
|---|
| 9 | Q
|
|---|
| 10 | ;Called from LREPI
|
|---|
| 11 | PTF ;SEARCH DISCHARGE DATES; NEED ADDITIONAL LATER SPECS
|
|---|
| 12 | S STDT=(LRRPS-.0001),ENDT=(LRRPE+.9999)
|
|---|
| 13 | F S STDT=$O(^DGPT("ADS",STDT)) Q:+STDT'>0!(STDT>ENDT) D
|
|---|
| 14 | .S IFN=0 F S IFN=$O(^DGPT("ADS",STDT,IFN)) Q:+IFN'>0 D
|
|---|
| 15 | ..Q:$P($G(^DGPT(IFN,0)),U,6)'=3
|
|---|
| 16 | ..I $P($G(^DGPT(IFN,300)),U,3)=1 D
|
|---|
| 17 | ...S ICD9=$O(^ICD9("BA","482.80 ",0)) D ICD9
|
|---|
| 18 | ..I $D(^DGPT(IFN,70)) F LRI=10,11,16:1:24 D
|
|---|
| 19 | ...S ICD9=$P(^DGPT(IFN,70),U,LRI) D ICD9
|
|---|
| 20 | ..;SEARCH SUB FIELDS
|
|---|
| 21 | ..S LRMV=0 F S LRMV=$O(^DGPT(IFN,"M",LRMV)) Q:+LRMV'>0 D
|
|---|
| 22 | ...I $P($G(^DGPT(IFN,"M",LRMV,300)),U,3)=1 D
|
|---|
| 23 | ....S ICD9=$O(^ICD9("BA","482.80 ",0)) D ICD9
|
|---|
| 24 | ...I $D(^DGPT(IFN,"M",LRMV,0)) F LRI=5:1:9,11:1:15 D
|
|---|
| 25 | ....S ICD9=$P(^DGPT(IFN,"M",LRMV,0),U,LRI) D ICD9
|
|---|
| 26 | K IFN,LRMV,ICD9,LRI
|
|---|
| 27 | Q
|
|---|
| 28 | ICD9 ;CHECK ICD9 CODE AND SAVE
|
|---|
| 29 | Q:+ICD9'>0
|
|---|
| 30 | Q:'$D(^TMP($J,"ICD",+ICD9))
|
|---|
| 31 | S LRPROT=$G(LRPROT,999999) S ^TMP($J,"ICDPROT",+ICD9,LRPROT)=""
|
|---|
| 32 | S DFN=$P(^DGPT(IFN,0),U,1),ADMDT=$P(^DGPT(IFN,0),U,2)
|
|---|
| 33 | S LRPATH=0 F S LRPATH=$O(^TMP($J,"ICD",+ICD9,LRPATH)) Q:+LRPATH'>0 D SET
|
|---|
| 34 | Q
|
|---|
| 35 | SET ;SET THE TMP GLOBAL
|
|---|
| 36 | S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
|
|---|
| 37 | S LRCHK=0 D ADDCHK Q:LRCHK
|
|---|
| 38 | S:'$D(^TMP($J,LRPROT,DFN,ADMDT)) ^TMP($J,LRPROT,DFN,ADMDT)="I"_U_IFN
|
|---|
| 39 | S ^TMP($J,LRPROT,DFN,ADMDT,LRPATH,(9999999-ADMDT),"PTF")=IFN
|
|---|
| 40 | Q
|
|---|
| 41 | ADDCHK ;DO ADDITIONAL CHECKS HERE FOR AGE AND SEX SCREENING.
|
|---|
| 42 | ;
|
|---|
| 43 | I '$G(DFN) S DFN=$G(LRPAT)
|
|---|
| 44 | K VADM
|
|---|
| 45 | I $G(DFN) D DEM^VADPT
|
|---|
| 46 | ;
|
|---|
| 47 | I $P(^LAB(69.5,LRPATH,0),U,10)'="" D
|
|---|
| 48 | .S LRSEX=$P(^LAB(69.5,LRPATH,0),U,10)
|
|---|
| 49 | .I LRSEX="O"&$P(VADM(5),U,1)="M" S LRCHK=1 Q
|
|---|
| 50 | .I LRSEX="O"&$P(VADM(5),U,1)="F" S LRCHK=1 Q
|
|---|
| 51 | .I LRSEX'=$P(VADM(5),U,1) S LRCHK=1
|
|---|
| 52 | I $P(^LAB(69.5,LRPATH,0),U,11)'=""!$P(^LAB(69.5,LRPATH,0),U,12)'="" D
|
|---|
| 53 | .S LRBEF=$P(^LAB(69.5,LRPATH,0),U,11),LRAFT=$P(^LAB(69.5,LRPATH,0),U,12)
|
|---|
| 54 | .I LRBEF'=""&($P(VADM(3),U,1)>LRBEF) S LRCHK=1
|
|---|
| 55 | .I LRAFT'=""&($P(VADM(3),U,1)<LRAFT) S LRCHK=1
|
|---|
| 56 | K LRBEF,LRSEX,LRAFT,VADM
|
|---|
| 57 | Q
|
|---|
