- LREPIRS1 ;DALOI/CKA - EMERGING PATHOGENS LOCAL REPORT ;23 Apr 2013 4:34 PM
- ;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
- ; Reference to ^DIC(21 supported by IA #913
- Q
- REPORT ;
- S X1=DT,X2=180 D C^%DTC
- S LRSP=" "
- S ^XTMP("LREPILOCALREP"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$S($D(DUZ):DUZ,1:"UNKNOWN")
- S LRHDGLC=0 D SAVHDG^LREPIRS2
- S MSG=0,LRLC=1,LRSPSHT=""
- F S MSG=$O(^TMP("HLS",$J,MSG)) Q:'MSG S LRMSGLIN=^(MSG) D
- .S LRSPSHT=""
- .Q:$P(LRMSGLIN,"|")=""
- .Q:'$D(LRSEG($P(LRMSGLIN,"|")))
- .I $P(LRMSGLIN,"|")="PID" D
- ..S LRSPSHT="********************************************************************************"
- ..S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1
- .I $P(LRMSGLIN,"|")="PID" D
- ..I $D(LRSEG("PID",1)) S LRSPSHT=$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("PID",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,20)_" "
- ..I $D(LRSEG("PID",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,4) D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,16-($L($P($P(LRMSGLIN,HLFS,4),LRCS,4))))
- ..I $D(LRSEG("PID",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,6),LRCS)_","_$P($P(LRMSGLIN,HLFS,6),LRCS,2)_" "_$P($P(LRMSGLIN,HLFS,6),LRCS,3)_" " D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,29-($L($P(LRMSGLIN,HLFS,6))))
- ..I $D(LRSEG("PID",5)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8)) D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,9-($L($P(LRMSGLIN,HLFS,8))))
- ..I $D(LRSEG("PID",6)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,9)_" "
- ..I $D(LRSEG("PID",7)) D K LRZ,LRY
- ...S LRZ=0,DFN=$P($P(LRMSGLIN,HLFS,4),LRCS) F LRY=1:1 S LRZ=$O(^DPT(DFN,.02,LRZ)) Q:'LRZ
- ...I LRY>2 S LRSPSHT=LRSPSHT_"MULTIPLE "
- ...E S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,11),LRCS,2)_" "
- ..I $D(LRSEG("PID",8)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,1)_$E(LRSP,1,9-$L($P($P(LRMSGLIN,HLFS,12),LRCS,1)))
- ..I $D(LRSEG("PID",9)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,4),U,2)_" " D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,15-$L($P($P($P(LRMSGLIN,HLFS,12),LRCS,4),U,2)))
- ..I $D(LRSEG("PID",10)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,12),LRCS,5)_" "
- ..I $D(LRSEG("PID",11)) S LRSPSHT=LRSPSHT_$P($P($P(LRMSGLIN,HLFS,12),LRCS,9),U,2)_$E(LRSP,1,20-$L($P($P($P(LRMSGLIN,HLFS,12),LRCS,9),U,2)))
- ..I $D(LRSEG("PID",12)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,23),LRCS,2)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,23),LRCS,2)))
- ..I $D(LRSEG("PID",13)) D I LRPOS="" S LRSPSHT=LRSPSHT_" "
- ...S LRPOS=$P(LRMSGLIN,HLFS,28)
- ...Q:LRPOS=""
- ...S LRPOSN=0
- ...F S LRPOSN=$O(^DIC(21,LRPOSN)) Q:LRPOSN'>0 I $P($G(^DIC(21,LRPOSN,0)),U,3)=LRPOS S LRPOSNAM=$P(^(0),U) Q
- ...S LRSPSHT=LRSPSHT_LRPOSNAM_" "
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
- .K LRPOS,LRPOSN,LRPOSNAM
- .I $P(LRMSGLIN,"|")="PV1" D
- ..I $D(LRSEG("PV1",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("PV1",2)) D
- ...S TYPE=$P(LRMSGLIN,HLFS,3),TYPE=$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
- ...S LRSPSHT=LRSPSHT_TYPE_$E(LRSP,1,14-$L(TYPE))
- ...K TYPE
- ..I $D(LRSEG("PV1",3)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,4)_$E(LRSP,1,20-$L($P(LRMSGLIN,HLFS,4)))
- ..I $D(LRSEG("PV1",4)) S LRSPSHT=LRSPSHT_$S($P($P(LRMSGLIN,HLFS,37),LRCS,2)'="":$P($P(LRMSGLIN,HLFS,37),LRCS,2),1:"**No Facility**")_$E(LRSP,1,23-$L($P($P(LRMSGLIN,HLFS,37),LRCS,2)))
- ..I $D(LRSEG("PV1",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,40)_$E(LRSP,1,9-$L($P(LRMSGLIN,HLFS,40)))
- ..I $D(LRSEG("PV1",6)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,45))_" "
- ..I $D(LRSEG("PV1",7)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,46))
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
- .I $P(LRMSGLIN,"|")="NTE" D
- ..I $D(LRSEG("NTE",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,8-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("NTE",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_" "
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
- .I $P(LRMSGLIN,"|")="OBR" D
- ..I $D(LRSEG("OBR",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("OBR",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,5),LRCS,2)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,5),LRCS,2)))
- ..I $D(LRSEG("OBR",3)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))_$E(LRSP,1,17-$L($$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))))
- ..I $D(LRSEG("OBR",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,16),LRCS,3)_$E(LRSP,1,20-$L($P($P(LRMSGLIN,HLFS,16),LRCS,3)))
- ..I $D(LRSEG("OBR",5)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,19)
- ..S LRSPSHT=LRSPSHT_" "_$P($P(LRMSGLIN,HLFS,27),LRCS,2)
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
- .I $P(LRMSGLIN,"|")="OBX" D
- ..I $P(LRMSGLIN,HLFS,3)="ST" D
- ...S TST=$P(LRMSGLIN,HLFS,4),TSTNM=$P($P(TST,LRCS,2),LRCS)
- ...S OV=$P(LRMSGLIN,HLFS,6)
- ..I $P(LRMSGLIN,HLFS,3)="CE" D
- ...S TSTNM=""
- ...S OV=$P($P(LRMSGLIN,HLFS,6),LRCS,2)
- ..S FD=$$CDT^LREPIRP($P(LRMSGLIN,HLFS,15)),RR=$P(LRMSGLIN,HLFS,9)
- ..S UN=$P(LRMSGLIN,HLFS,7)
- ..I $P($P(LRMSGLIN,HLFS,4),LRCS,9)="LOINC" D
- ...S LOINC=$P($P(LRMSGLIN,HLFS,4),LRCS,7),LOINCN=$P($P(LRMSGLIN,HLFS,4),LRCS,8)
- ..I $D(LRSEG("OBX",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("OBX",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_" "
- ..I $D(LRSEG("OBX",3)) S LRSPSHT=LRSPSHT_TSTNM_" "
- ..I $D(LRSEG("OBX",4)) S LRSPSHT=LRSPSHT_$G(LOINC)_" "
- ..I $D(LRSEG("OBX",5)) S LRSPSHT=LRSPSHT_$G(LOINCN)_" "
- ..I $D(LRSEG("OBX",6)) S LRSPSHT=LRSPSHT_OV_" "
- ..I $D(LRSEG("OBX",7)) S LRSPSHT=LRSPSHT_UN_" "
- ..I $D(LRSEG("OBX",8)) S LRSPSHT=LRSPSHT_RR_" "
- ..I $D(LRSEG("OBX",9)) S LRSPSHT=LRSPSHT_FD_" "
- ..S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,5)
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1 S LRSPSHT=""
- ..K TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV
- .I $P(LRMSGLIN,"|")="DG1" D
- ..I $D(LRSEG("DG1",1)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,2)_$E(LRSP,1,7-$L($P(LRMSGLIN,HLFS,2)))
- ..I $D(LRSEG("DG1",2)) S LRICDSTR=$S($P($P(LRMSGLIN,HLFS,4),LRCS,3)["I10":"ICD10 ",1:"ICD9 "),LRSPSHT=LRSPSHT_LRICDSTR_$P($P(LRMSGLIN,HLFS,4),LRCS,1)_" " D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,14-$L(LRICDSTR_$P($P(LRMSGLIN,HLFS,4),LRCS,1)))
- ..I $D(LRSEG("DG1",3)) S LRSPSHT=LRSPSHT_$E($P($P(LRMSGLIN,HLFS,4),LRCS,2),1,37) D
- ...S LRSPSHT=LRSPSHT_$E(LRSP,1,39-$L($E($P($P(LRMSGLIN,HLFS,4),LRCS,2),1,37)))
- ..I $D(LRSEG("DG1",4)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,5))_" "
- ..I LRSPSHT'="" S ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT S LRLC=LRLC+1
- K MSGLIN,LRSEG,ENTRY,FD,HLFS,LOINC,LOINCN,LRCS,LRHDGLC,LRLC,LRMSGLIN
- K LRICDSTR,LRPOS,LRSP,LRSPSHT,MSG,OV,RR,TST,TSTNM,TYPE,UN,X,X1,X2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRS1 6783 printed Feb 18, 2025@23:40:26 Page 2
- LREPIRS1 ;DALOI/CKA - EMERGING PATHOGENS LOCAL REPORT ;23 Apr 2013 4:34 PM
- +1 ;;5.2;LAB SERVICE;**281,421**;Sep 27, 1994;Build 48
- +2 ; Reference to ^DIC(21 supported by IA #913
- +3 QUIT
- REPORT ;
- +1 SET X1=DT
- SET X2=180
- DO C^%DTC
- +2 SET LRSP=" "
- +3 SET ^XTMP("LREPILOCALREP"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$SELECT($DATA(DUZ):DUZ,1:"UNKNOWN")
- +4 SET LRHDGLC=0
- DO SAVHDG^LREPIRS2
- +5 SET MSG=0
- SET LRLC=1
- SET LRSPSHT=""
- +6 FOR
- SET MSG=$ORDER(^TMP("HLS",$JOB,MSG))
- if 'MSG
- QUIT
- SET LRMSGLIN=^(MSG)
- Begin DoDot:1
- +7 SET LRSPSHT=""
- +8 if $PIECE(LRMSGLIN,"|")=""
- QUIT
- +9 if '$DATA(LRSEG($PIECE(LRMSGLIN,"|")))
- QUIT
- +10 IF $PIECE(LRMSGLIN,"|")="PID"
- Begin DoDot:2
- +11 SET LRSPSHT="********************************************************************************"
- +12 SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- End DoDot:2
- +13 IF $PIECE(LRMSGLIN,"|")="PID"
- Begin DoDot:2
- +14 IF $DATA(LRSEG("PID",1))
- SET LRSPSHT=$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,7-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +15 IF $DATA(LRSEG("PID",2))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,20)_" "
- +16 IF $DATA(LRSEG("PID",3))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,4)
- Begin DoDot:3
- +17 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,16-($LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,4))))
- End DoDot:3
- +18 IF $DATA(LRSEG("PID",4))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,6),LRCS)_","_$PIECE($PIECE(LRMSGLIN,HLFS,6),LRCS,2)_" "_$PIECE($PIECE(LRMSGLIN,HLFS,6),LRCS,3)_" "
- Begin DoDot:3
- +19 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,29-($LENGTH($PIECE(LRMSGLIN,HLFS,6))))
- End DoDot:3
- +20 IF $DATA(LRSEG("PID",5))
- SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,8))
- Begin DoDot:3
- +21 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,9-($LENGTH($PIECE(LRMSGLIN,HLFS,8))))
- End DoDot:3
- +22 IF $DATA(LRSEG("PID",6))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,9)_" "
- +23 IF $DATA(LRSEG("PID",7))
- Begin DoDot:3
- +24 SET LRZ=0
- SET DFN=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS)
- FOR LRY=1:1
- SET LRZ=$ORDER(^DPT(DFN,.02,LRZ))
- if 'LRZ
- QUIT
- +25 IF LRY>2
- SET LRSPSHT=LRSPSHT_"MULTIPLE "
- +26 IF '$TEST
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,11),LRCS,2)_" "
- End DoDot:3
- KILL LRZ,LRY
- +27 IF $DATA(LRSEG("PID",8))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,1)_$EXTRACT(LRSP,1,9-$LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,1)))
- +28 IF $DATA(LRSEG("PID",9))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,4),U,2)_" "
- Begin DoDot:3
- +29 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,15-$LENGTH($PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,4),U,2)))
- End DoDot:3
- +30 IF $DATA(LRSEG("PID",10))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,5)_" "
- +31 IF $DATA(LRSEG("PID",11))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,9),U,2)_$EXTRACT(LRSP,1,20-$LENGTH($PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,9),U,2)))
- +32 IF $DATA(LRSEG("PID",12))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,23),LRCS,2)_$EXTRACT(LRSP,1,20-$LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,23),LRCS,2)))
- +33 IF $DATA(LRSEG("PID",13))
- Begin DoDot:3
- +34 SET LRPOS=$PIECE(LRMSGLIN,HLFS,28)
- +35 if LRPOS=""
- QUIT
- +36 SET LRPOSN=0
- +37 FOR
- SET LRPOSN=$ORDER(^DIC(21,LRPOSN))
- if LRPOSN'>0
- QUIT
- IF $PIECE($GET(^DIC(21,LRPOSN,0)),U,3)=LRPOS
- SET LRPOSNAM=$PIECE(^(0),U)
- QUIT
- +38 SET LRSPSHT=LRSPSHT_LRPOSNAM_" "
- End DoDot:3
- IF LRPOS=""
- SET LRSPSHT=LRSPSHT_" "
- +39 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- SET LRSPSHT=""
- End DoDot:2
- +40 KILL LRPOS,LRPOSN,LRPOSNAM
- +41 IF $PIECE(LRMSGLIN,"|")="PV1"
- Begin DoDot:2
- +42 IF $DATA(LRSEG("PV1",1))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,7-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +43 IF $DATA(LRSEG("PV1",2))
- Begin DoDot:3
- +44 SET TYPE=$PIECE(LRMSGLIN,HLFS,3)
- SET TYPE=$SELECT(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")
- +45 SET LRSPSHT=LRSPSHT_TYPE_$EXTRACT(LRSP,1,14-$LENGTH(TYPE))
- +46 KILL TYPE
- End DoDot:3
- +47 IF $DATA(LRSEG("PV1",3))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,4)_$EXTRACT(LRSP,1,20-$LENGTH($PIECE(LRMSGLIN,HLFS,4)))
- +48 IF $DATA(LRSEG("PV1",4))
- SET LRSPSHT=LRSPSHT_$SELECT($PIECE($PIECE(LRMSGLIN,HLFS,37),LRCS,2)'="":$PIECE($PIECE(LRMSGLIN,HLFS,37),LRCS,2),1:"**No Facility**")_$EXTRACT(LRSP,1,23-$LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,37),LRCS,2)))
- +49 IF $DATA(LRSEG("PV1",5))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,40)_$EXTRACT(LRSP,1,9-$LENGTH($PIECE(LRMSGLIN,HLFS,40)))
- +50 IF $DATA(LRSEG("PV1",6))
- SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,45))_" "
- +51 IF $DATA(LRSEG("PV1",7))
- SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,46))
- +52 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- SET LRSPSHT=""
- End DoDot:2
- +53 IF $PIECE(LRMSGLIN,"|")="NTE"
- Begin DoDot:2
- +54 IF $DATA(LRSEG("NTE",1))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,8-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +55 IF $DATA(LRSEG("NTE",2))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,3)_" "
- +56 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- SET LRSPSHT=""
- End DoDot:2
- +57 IF $PIECE(LRMSGLIN,"|")="OBR"
- Begin DoDot:2
- +58 IF $DATA(LRSEG("OBR",1))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,7-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +59 IF $DATA(LRSEG("OBR",2))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,5),LRCS,2)_$EXTRACT(LRSP,1,20-$LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,5),LRCS,2)))
- +60 IF $DATA(LRSEG("OBR",3))
- SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,8))_$EXTRACT(LRSP,1,17-$LENGTH($$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,8))))
- +61 IF $DATA(LRSEG("OBR",4))
- SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,16),LRCS,3)_$EXTRACT(LRSP,1,20-$LENGTH($PIECE($PIECE(LRMSGLIN,HLFS,16),LRCS,3)))
- +62 IF $DATA(LRSEG("OBR",5))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,19)
- +63 SET LRSPSHT=LRSPSHT_" "_$PIECE($PIECE(LRMSGLIN,HLFS,27),LRCS,2)
- +64 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- SET LRSPSHT=""
- End DoDot:2
- +65 IF $PIECE(LRMSGLIN,"|")="OBX"
- Begin DoDot:2
- +66 IF $PIECE(LRMSGLIN,HLFS,3)="ST"
- Begin DoDot:3
- +67 SET TST=$PIECE(LRMSGLIN,HLFS,4)
- SET TSTNM=$PIECE($PIECE(TST,LRCS,2),LRCS)
- +68 SET OV=$PIECE(LRMSGLIN,HLFS,6)
- End DoDot:3
- +69 IF $PIECE(LRMSGLIN,HLFS,3)="CE"
- Begin DoDot:3
- +70 SET TSTNM=""
- +71 SET OV=$PIECE($PIECE(LRMSGLIN,HLFS,6),LRCS,2)
- End DoDot:3
- +72 SET FD=$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,15))
- SET RR=$PIECE(LRMSGLIN,HLFS,9)
- +73 SET UN=$PIECE(LRMSGLIN,HLFS,7)
- +74 IF $PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,9)="LOINC"
- Begin DoDot:3
- +75 SET LOINC=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,7)
- SET LOINCN=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,8)
- End DoDot:3
- +76 IF $DATA(LRSEG("OBX",1))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,7-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +77 IF $DATA(LRSEG("OBX",2))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,3)_" "
- +78 IF $DATA(LRSEG("OBX",3))
- SET LRSPSHT=LRSPSHT_TSTNM_" "
- +79 IF $DATA(LRSEG("OBX",4))
- SET LRSPSHT=LRSPSHT_$GET(LOINC)_" "
- +80 IF $DATA(LRSEG("OBX",5))
- SET LRSPSHT=LRSPSHT_$GET(LOINCN)_" "
- +81 IF $DATA(LRSEG("OBX",6))
- SET LRSPSHT=LRSPSHT_OV_" "
- +82 IF $DATA(LRSEG("OBX",7))
- SET LRSPSHT=LRSPSHT_UN_" "
- +83 IF $DATA(LRSEG("OBX",8))
- SET LRSPSHT=LRSPSHT_RR_" "
- +84 IF $DATA(LRSEG("OBX",9))
- SET LRSPSHT=LRSPSHT_FD_" "
- +85 SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,5)
- +86 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- SET LRSPSHT=""
- +87 KILL TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV
- End DoDot:2
- +88 IF $PIECE(LRMSGLIN,"|")="DG1"
- Begin DoDot:2
- +89 IF $DATA(LRSEG("DG1",1))
- SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,2)_$EXTRACT(LRSP,1,7-$LENGTH($PIECE(LRMSGLIN,HLFS,2)))
- +90 IF $DATA(LRSEG("DG1",2))
- SET LRICDSTR=$SELECT($PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,3)["I10":"ICD10 ",1:"ICD9 ")
- SET LRSPSHT=LRSPSHT_LRICDSTR_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,1)_" "
- Begin DoDot:3
- +91 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,14-$LENGTH(LRICDSTR_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,1)))
- End DoDot:3
- +92 IF $DATA(LRSEG("DG1",3))
- SET LRSPSHT=LRSPSHT_$EXTRACT($PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,2),1,37)
- Begin DoDot:3
- +93 SET LRSPSHT=LRSPSHT_$EXTRACT(LRSP,1,39-$LENGTH($EXTRACT($PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,2),1,37)))
- End DoDot:3
- +94 IF $DATA(LRSEG("DG1",4))
- SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,5))_" "
- +95 IF LRSPSHT'=""
- SET ^XTMP("LREPILOCALREP"_LRLRDT,LRLC)=LRSPSHT
- SET LRLC=LRLC+1
- End DoDot:2
- End DoDot:1
- +96 KILL MSGLIN,LRSEG,ENTRY,FD,HLFS,LOINC,LOINCN,LRCS,LRHDGLC,LRLC,LRMSGLIN
- +97 KILL LRICDSTR,LRPOS,LRSP,LRSPSHT,MSG,OV,RR,TST,TSTNM,TYPE,UN,X,X1,X2
- +98 QUIT
