LREPIRP2 ;DALOI/CKA-EMERGING PATHOGENS HL7 REPORT CONVERSION ;5/14/2003
;;5.2;LAB SERVICE;**281**;Sep 27, 1994
; Reference to ^DIC(21 supported by IA #913
Q
;NTE findings of 1,3,4,5,6,8, or 10
;Read through the TMP($,"RPT"
;Save in ^XTMP("LREPIREP"_date,path,dfn,"PID")
; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#)
; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#)
; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#,"OBX",#)
;save PID, PV1, OBR, and OBX data in ^XTMP.
Q
PID ;PATIENT INFO
S NM=$P(LRTMP,HLFS,6),SSN=$P(LRTMP,HLFS,20)
S SSN=$E(SSN,6,9)
S DOB=$$CDT($P(LRTMP,HLFS,8)),NM=$P(NM,LRCS,2)_" "_$P(NM,LRCS,1)
S SX=$P(LRTMP,HLFS,9),AD=$P($P(LRTMP,HLFS,12),LRCS,1)
S ZP=$P($P(LRTMP,HLFS,12),LRCS,2),POS=$P(LRTMP,HLFS,28),POSN=""
I POS'="",$D(^DIC(21,"D",POS)) S POS=$O(^DIC(21,"D",POS,""))
S:POS'="" POSN=$P($G(^DIC(21,POS,0)),U,1)
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))
S:POSN'="" MSG=MSG_" "_POSN
S MSG=MSG_" "_AD_" "_ZP
S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PID")=MSG
K NM,DOB,SX,POS,AD,ZP,POSN
Q
PV1 ;PATIENT VISIT ENCOUNTER
S TYPE=$P(LRTMP,HLFS,3)
S ENC=$S(TYPE="O":"Accession ",1:"Admission ")_"Date: "
S TYPE=$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
S MSG=TYPE_" "_ENC_$$CDT($P(LRTMP,HLFS,45))
I TYPE="Inpatient" D
.S MSG=MSG_" Discharge Date: "_$S($P(LRTMP,HLFS,46)="":"",1:$$CDT($P(LRTMP,HLFS,46)))
.S MSG=MSG_" Discharge Disposition: "_$P($P(LRTMP,HLFS,37),LRCS,2)
S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1)=MSG
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
OBR ;OBSERVATION REPORTING
S TST=$P(LRTMP,HLFS,5),TSTNM=$P(TST,LRCS,2),MSG=""
S:TSTNM="" TSTNM=$P(TST,LRCS,5)
S TOP=$P($P(LRTMP,HLFS,16),LRCS,3)
S ENTRY=$P($P(LRTMP,HLFS,27),LRCS,2)
S:+ENTRY MSG="ORG # "_ENTRY_" "
S MSG=MSG_$$CDT($P(LRTMP,HLFS,8))_" "
S LRACCDT=$$CDT($P(LRTMP,HLFS,8))
S:$P(LRTMP,HLFS,19)'="" MSG=MSG_$P(LRTMP,HLFS,19)_" "
S MSG=MSG_TSTNM_" "_TOP
S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR)=MSG
K TST,TSTNM,TOP,ENTRY
Q
OBX ;RESULTS
I $P(LRTMP,HLFS,3)="ST" D
.S TST=$P(LRTMP,HLFS,4),TSTNM=$P(TST,LRCS,2)
.S:TSTNM="" TSTNM=$P(TST,LRCS,5)
.S OV=$P(LRTMP,HLFS,6)
I $P(LRTMP,HLFS,3)="CE" D
.S TSTNM=""
.S OV=$P($P(LRTMP,HLFS,6),LRCS,2)
S MSG="",ENTRY=$P(LRTMP,HLFS,5) S:+ENTRY MSG=ENTRY_" "
S MSG=MSG_TSTNM_$E(LRSP,1,30-$L(TSTNM))
S FD=$$CDT($P(LRTMP,HLFS,15)),RR=$P(LRTMP,HLFS,8)
S UN=$P(LRTMP,HLFS,7),AF=""
S MSG=" "_MSG_FD_" "_OV_$E(LRSP,1,10-$L(OV))_UN_$E(LRSP,1,10-$L(UN))_RR
S MSG=MSG_$E(LRSP,1,(40-$L(MSG)))_$P(LRTMP,HLFS,9)
S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX)=MSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRP2 2901 printed Nov 22, 2024@17:24:29 Page 2
LREPIRP2 ;DALOI/CKA-EMERGING PATHOGENS HL7 REPORT CONVERSION ;5/14/2003
+1 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
+2 ; Reference to ^DIC(21 supported by IA #913
+3 QUIT
+4 ;NTE findings of 1,3,4,5,6,8, or 10
+5 ;Read through the TMP($,"RPT"
+6 ;Save in ^XTMP("LREPIREP"_date,path,dfn,"PID")
+7 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#)
+8 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#)
+9 ; ^XTMP("LREPIREP"_date,path,dfn,"PV1",#,"OBR",#,"OBX",#)
+10 ;save PID, PV1, OBR, and OBX data in ^XTMP.
+11 QUIT
PID ;PATIENT INFO
+1 SET NM=$PIECE(LRTMP,HLFS,6)
SET SSN=$PIECE(LRTMP,HLFS,20)
+2 SET SSN=$EXTRACT(SSN,6,9)
+3 SET DOB=$$CDT($PIECE(LRTMP,HLFS,8))
SET NM=$PIECE(NM,LRCS,2)_" "_$PIECE(NM,LRCS,1)
+4 SET SX=$PIECE(LRTMP,HLFS,9)
SET AD=$PIECE($PIECE(LRTMP,HLFS,12),LRCS,1)
+5 SET ZP=$PIECE($PIECE(LRTMP,HLFS,12),LRCS,2)
SET POS=$PIECE(LRTMP,HLFS,28)
SET POSN=""
+6 IF POS'=""
IF $DATA(^DIC(21,"D",POS))
SET POS=$ORDER(^DIC(21,"D",POS,""))
+7 if POS'=""
SET POSN=$PIECE($GET(^DIC(21,POS,0)),U,1)
+8 SET MSG=NM_$EXTRACT(LRSP,1,30-$LENGTH(NM))_SSN_$EXTRACT(LRSP,1,7-$LENGTH(SSN))_DOB_$EXTRACT(LRSP,1,11-$LENGTH(DOB))_SX_$EXTRACT(LRSP,1,3-$LENGTH(SX))
+9 if POSN'=""
SET MSG=MSG_" "_POSN
+10 SET MSG=MSG_" "_AD_" "_ZP
+11 SET ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PID")=MSG
+12 KILL NM,DOB,SX,POS,AD,ZP,POSN
+13 QUIT
PV1 ;PATIENT VISIT ENCOUNTER
+1 SET TYPE=$PIECE(LRTMP,HLFS,3)
+2 SET ENC=$SELECT(TYPE="O":"Accession ",1:"Admission ")_"Date: "
+3 SET TYPE=$SELECT(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
+4 SET MSG=TYPE_" "_ENC_$$CDT($PIECE(LRTMP,HLFS,45))
+5 IF TYPE="Inpatient"
Begin DoDot:1
+6 SET MSG=MSG_" Discharge Date: "_$SELECT($PIECE(LRTMP,HLFS,46)="":"",1:$$CDT($PIECE(LRTMP,HLFS,46)))
+7 SET MSG=MSG_" Discharge Disposition: "_$PIECE($PIECE(LRTMP,HLFS,37),LRCS,2)
End DoDot:1
+8 SET ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1)=MSG
+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
OBR ;OBSERVATION REPORTING
+1 SET TST=$PIECE(LRTMP,HLFS,5)
SET TSTNM=$PIECE(TST,LRCS,2)
SET MSG=""
+2 if TSTNM=""
SET TSTNM=$PIECE(TST,LRCS,5)
+3 SET TOP=$PIECE($PIECE(LRTMP,HLFS,16),LRCS,3)
+4 SET ENTRY=$PIECE($PIECE(LRTMP,HLFS,27),LRCS,2)
+5 if +ENTRY
SET MSG="ORG # "_ENTRY_" "
+6 SET MSG=MSG_$$CDT($PIECE(LRTMP,HLFS,8))_" "
+7 SET LRACCDT=$$CDT($PIECE(LRTMP,HLFS,8))
+8 if $PIECE(LRTMP,HLFS,19)'=""
SET MSG=MSG_$PIECE(LRTMP,HLFS,19)_" "
+9 SET MSG=MSG_TSTNM_" "_TOP
+10 SET ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR)=MSG
+11 KILL TST,TSTNM,TOP,ENTRY
+12 QUIT
OBX ;RESULTS
+1 IF $PIECE(LRTMP,HLFS,3)="ST"
Begin DoDot:1
+2 SET TST=$PIECE(LRTMP,HLFS,4)
SET TSTNM=$PIECE(TST,LRCS,2)
+3 if TSTNM=""
SET TSTNM=$PIECE(TST,LRCS,5)
+4 SET OV=$PIECE(LRTMP,HLFS,6)
End DoDot:1
+5 IF $PIECE(LRTMP,HLFS,3)="CE"
Begin DoDot:1
+6 SET TSTNM=""
+7 SET OV=$PIECE($PIECE(LRTMP,HLFS,6),LRCS,2)
End DoDot:1
+8 SET MSG=""
SET ENTRY=$PIECE(LRTMP,HLFS,5)
if +ENTRY
SET MSG=ENTRY_" "
+9 SET MSG=MSG_TSTNM_$EXTRACT(LRSP,1,30-$LENGTH(TSTNM))
+10 SET FD=$$CDT($PIECE(LRTMP,HLFS,15))
SET RR=$PIECE(LRTMP,HLFS,8)
+11 SET UN=$PIECE(LRTMP,HLFS,7)
SET AF=""
+12 SET MSG=" "_MSG_FD_" "_OV_$EXTRACT(LRSP,1,10-$LENGTH(OV))_UN_$EXTRACT(LRSP,1,10-$LENGTH(UN))_RR
+13 SET MSG=MSG_$EXTRACT(LRSP,1,(40-$LENGTH(MSG)))_$PIECE(LRTMP,HLFS,9)
+14 SET ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,"PV1",LRPV1,"OBR",LROBR,"OBX",LROBX)=MSG
+15 QUIT
