LREPIRP2.m

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 ---LREPIRP2   2901     printed  Feb 18, 2025@23:40:18                                                                                                                                                                                                    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