LREPIRP4.m

LREPIRP4 ;DALOI/CKA-EMERGING PATHOGENS HL7 REPORT CONVERSION ;5/13/03

 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994

 ; Reference to ^DIC(21 supported by IA #2504

 ;This routine builds the ^XTMP global for REF #s 2,15,16,17

 ;^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,#)

 Q

OBX ;RESULTS

 I $P(LRTMP,HLFS,3)="ST" D

 .S TST=$P(LRTMP,HLFS,4),TSTNM=$P(TST,LRCS,5)

 .;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 ENTRY=$P(LRTMP,HLFS,5)

 S FD=$$CDT($P(LRTMP,HLFS,15)),RR=$P(LRTMP,HLFS,8)

 S UN=$P(LRTMP,HLFS,7),AF=""

 S ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,LRCNT)=LRNAME_$E(LRSP,1,25-$L(LRNAME))_SSN_"   "_LRACCDT_$E(LRSP,1,16-$L(LRACCDT))_TSTNM_" "_OV

 S LRCNT=LRCNT+1

 Q

PV1 ;

 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))

 Q:$P(LRTMP,HLFS,46)=""

 S MSG="            Discharge Date  "_$$CDT($P(LRTMP,HLFS,46))

 S MSG=MSG_"  Discharge Disposition  "_$P($P(LRTMP,HLFS,37),LRCS,2)

 S ^TMP($J,"RPT",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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LREPIRP4   1341     printed  Dec 13, 2024@02:14:27                                                                                                                                                                                                    Page 2

LREPIRP4  ;DALOI/CKA-EMERGING PATHOGENS HL7 REPORT CONVERSION ;5/13/03

 +1       ;;5.2;LAB SERVICE;**281**;Sep 27, 1994

 +2       ; Reference to ^DIC(21 supported by IA #2504

 +3       ;This routine builds the ^XTMP global for REF #s 2,15,16,17

 +4       ;^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,#)

 +5        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,5)

 +3       ;S:TSTNM="" TSTNM=$P(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 ENTRY=$PIECE(LRTMP,HLFS,5)

 +9        SET FD=$$CDT($PIECE(LRTMP,HLFS,15))

           SET RR=$PIECE(LRTMP,HLFS,8)

 +10       SET UN=$PIECE(LRTMP,HLFS,7)

           SET AF=""

 +11       SET ^XTMP("LREPIREP"_LRDATE,LRTYPE,DFN,LRCNT)=LRNAME_$EXTRACT(LRSP,1,25-$LENGTH(LRNAME))_SSN_"   "_LRACCDT_$EXTRACT(LRSP,1,16-$LENGTH(LRACCDT))_TSTNM_" "_OV

 +12       SET LRCNT=LRCNT+1

 +13       QUIT 

PV1       ;

 +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 $PIECE(LRTMP,HLFS,46)=""

               QUIT 

 +6        SET MSG="            Discharge Date  "_$$CDT($PIECE(LRTMP,HLFS,46))

 +7        SET MSG=MSG_"  Discharge Disposition  "_$PIECE($PIECE(LRTMP,HLFS,37),LRCS,2)

 +8        SET ^TMP($JOB,"RPT",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