source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LREPIRP2.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1LREPIRP2 ;DALOI/CKA-EMERGING PATHOGENS HL7 REPORT CONVERSION ;5/14/2003
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ; Reference to ^DIC(21 supported by IA #913
4 Q
5 ;NTE findings of 1,3,4,5,6,8, or 10
6 ;Read through the TMP($,"RPT"
7 ;Save in ^XTMP("LREPIREP"_date,path,dfn,"PID")
8 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#)
9 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#)
10 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#,"OBX",#)
11 ;save PID, PV1, OBR, and OBX data in ^XTMP.
12 Q
13PID ;PATIENT INFO
14 S NM=$P(LRTMP,HLFS,6),SSN=$P(LRTMP,HLFS,20)
15 S SSN=$E(SSN,6,9)
16 S DOB=$$CDT($P(LRTMP,HLFS,8)),NM=$P(NM,LRCS,2)_" "_$P(NM,LRCS,1)
17 S SX=$P(LRTMP,HLFS,9),AD=$P($P(LRTMP,HLFS,12),LRCS,1)
18 S ZP=$P($P(LRTMP,HLFS,12),LRCS,2),POS=$P(LRTMP,HLFS,28),POSN=""
19 I POS'="",$D(^DIC(21,"D",POS)) S POS=$O(^DIC(21,"D",POS,""))
20 S:POS'="" POSN=$P($G(^DIC(21,POS,0)),U,1)
21 S MSG=NM_$E(LRSP,1,30-$L(NM))_SSN_$E(LRSP,1,7-$L(SSN))_DOB_$E(LRSP,1,11-$L(DOB))_SX_$E(LRSP,1,3-$L(SX))
22 S:POSN'="" MSG=MSG_" "_POSN
23 S MSG=MSG_" "_AD_" "_ZP
24 S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PID")=MSG
25 K NM,DOB,SX,POS,AD,ZP,POSN
26 Q
27PV1 ;PATIENT VISIT ENCOUNTER
28 S TYPE=$P(LRTMP,HLFS,3)
29 S ENC=$S(TYPE="O":"Accession ",1:"Admission ")_"Date: "
30 S TYPE=$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
31 S MSG=TYPE_" "_ENC_$$CDT($P(LRTMP,HLFS,45))
32 I TYPE="Inpatient" D
33 .S MSG=MSG_" Discharge Date: "_$S($P(LRTMP,HLFS,46)="":"",1:$$CDT($P(LRTMP,HLFS,46)))
34 .S MSG=MSG_" Discharge Disposition: "_$P($P(LRTMP,HLFS,37),LRCS,2)
35 S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1)=MSG
36 K TYPE
37 Q
38CDT(DATE) ;CONVERTS THE DATE AND TIME
39 S X=$E(DATE,5,6)_"-"_$E(DATE,7,8)_"-"_$E(DATE,1,4)
40 S:$E(DATE,9,12)'="" X=X_"@"_$E(DATE,9,12)
41 S:X="--" X=""
42 Q X
43OBR ;OBSERVATION REPORTING
44 S TST=$P(LRTMP,HLFS,5),TSTNM=$P(TST,LRCS,2),MSG=""
45 S:TSTNM="" TSTNM=$P(TST,LRCS,5)
46 S TOP=$P($P(LRTMP,HLFS,16),LRCS,3)
47 S ENTRY=$P($P(LRTMP,HLFS,27),LRCS,2)
48 S:+ENTRY MSG="ORG # "_ENTRY_" "
49 S MSG=MSG_$$CDT($P(LRTMP,HLFS,8))_" "
50 S LRACCDT=$$CDT($P(LRTMP,HLFS,8))
51 S:$P(LRTMP,HLFS,19)'="" MSG=MSG_$P(LRTMP,HLFS,19)_" "
52 S MSG=MSG_TSTNM_" "_TOP
53 S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR)=MSG
54 K TST,TSTNM,TOP,ENTRY
55 Q
56OBX ;RESULTS
57 I $P(LRTMP,HLFS,3)="ST" D
58 .S TST=$P(LRTMP,HLFS,4),TSTNM=$P(TST,LRCS,2)
59 .S:TSTNM="" TSTNM=$P(TST,LRCS,5)
60 .S OV=$P(LRTMP,HLFS,6)
61 I $P(LRTMP,HLFS,3)="CE" D
62 .S TSTNM=""
63 .S OV=$P($P(LRTMP,HLFS,6),LRCS,2)
64 S MSG="",ENTRY=$P(LRTMP,HLFS,5) S:+ENTRY MSG=ENTRY_" "
65 S MSG=MSG_TSTNM_$E(LRSP,1,30-$L(TSTNM))
66 S FD=$$CDT($P(LRTMP,HLFS,15)),RR=$P(LRTMP,HLFS,8)
67 S UN=$P(LRTMP,HLFS,7),AF=""
68 S MSG=" "_MSG_FD_" "_OV_$E(LRSP,1,10-$L(OV))_UN_$E(LRSP,1,10-$L(UN))_RR
69 S MSG=MSG_$E(LRSP,1,(40-$L(MSG)))_$P(LRTMP,HLFS,9)
70 S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX)=MSG
71 Q
Note: See TracBrowser for help on using the repository browser.