Routine: LREPIRS3

LREPIRS3 ;DALOI/CKA - EMERGING PATHOGENS LOCAL REPORT-GENERATE SPSHT ;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

SPSHT ;

 S X1=DT,X2=180 D C^%DTC

 S ^XTMP("LREPILOCALSPSHT"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$S($D(DUZ):DUZ,1:"UNKNOWN")

HDG1 ;

 S LRHDG="",LRLC=1,LRX=0

 I $D(LRSEG("PID")) S LRX("PID")=LRX,LRHDG="|"_LRX("PID")_"| |"

 I $D(LRSEG("PID",1)) S LRHDG=LRHDG_"PID|"

 I $D(LRSEG("PID",2)) S LRHDG=LRHDG_"SSN|"

 I $D(LRSEG("PID",3)) S LRHDG=LRHDG_"MPI|"

 I $D(LRSEG("PID",4)) S LRHDG=LRHDG_"Patient Name|"

 I $D(LRSEG("PID",5)) S LRHDG=LRHDG_"Date of Birth|"

 I $D(LRSEG("PID",6)) S LRHDG=LRHDG_"Sex|"

 I $D(LRSEG("PID",7)) S LRHDG=LRHDG_"Race|"

 I $D(LRSEG("PID",8)) S LRHDG=LRHDG_"Homeless|"

 I $D(LRSEG("PID",9)) S LRHDG=LRHDG_"State|"

 I $D(LRSEG("PID",10)) S LRHDG=LRHDG_"Zip|"

 I $D(LRSEG("PID",11)) S LRHDG=LRHDG_"County|"

 I $D(LRSEG("PID",12)) S LRHDG=LRHDG_"Ethnicity|"

 I $D(LRSEG("PID",13)) S LRHDG=LRHDG_"POS|"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 I $D(LRSEG("PV1")) S LRX=LRX+1,LRX("PV1")=LRX,LRHDG="|"_LRX_"| |"

 I $D(LRSEG("PV1",1)) S LRHDG=LRHDG_"PV1|"

 I $D(LRSEG("PV1",2)) S LRHDG=LRHDG_"Patient Class|"

 I $D(LRSEG("PV1",3)) S LRHDG=LRHDG_"Hospital Location|"

 I $D(LRSEG("PV1",4)) S LRHDG=LRHDG_"Discharge Disposition|"

 I $D(LRSEG("PV1",5)) S LRHDG=LRHDG_"Facility|"

 I $D(LRSEG("PV1",6)) S LRHDG=LRHDG_"Admit Date/Time|"

 I $D(LRSEG("PV1",7)) S LRHDG=LRHDG_"Discharge Date/Time|"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 I $D(LRSEG("DG1")) S LRX=LRX+1,LRX("DG1")=LRX,LRHDG="|"_LRX_"| |"

 I $D(LRSEG("DG1",1)) S LRHDG=LRHDG_"DG1|"

 I $D(LRSEG("DG1",2)) S LRHDG=LRHDG_"Diagnosis Code|"

 I $D(LRSEG("DG1",3)) S LRHDG=LRHDG_"Diagnosis|"

 I $D(LRSEG("DG1",4)) S LRHDG=LRHDG_"Admission Date|"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 I $D(LRSEG("NTE")) S LRX=LRX+1,LRX("NTE")=LRX,LRHDG="|"_LRX_"| |"

 I $D(LRSEG("NTE",1)) S LRHDG=LRHDG_"NTE|"

 I $D(LRSEG("NTE",2)) S LRHDG=LRHDG_"Comment|"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 I $D(LRSEG("OBR")) S LRX=LRX+1,LRX("OBR")=LRX,LRHDG="|"_LRX_"| |"

 I $D(LRSEG("OBR",1)) S LRHDG=LRHDG_"OBR|"

 I $D(LRSEG("OBR",2)) S LRHDG=LRHDG_"Test Name|"

 I $D(LRSEG("OBR",3)) S LRHDG=LRHDG_"Accession Date/Time|"

 I $D(LRSEG("OBR",4)) S LRHDG=LRHDG_"Specimen|"

 I $D(LRSEG("OBR",5)) S LRHDG=LRHDG_"Accession Number|"

 I LRHDG'="" S LRHDG=LRHDG_"OBR SUBID"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 I $D(LRSEG("OBX")) S LRX=LRX+1,LRX("OBX")=LRX,LRHDG="|"_LRX_"| |"

 I $D(LRSEG("OBX",1)) S LRHDG=LRHDG_"OBX|"

 I $D(LRSEG("OBX",2)) S LRHDG=LRHDG_"Value Type|"

 I $D(LRSEG("OBX",3)) S LRHDG=LRHDG_"Test Name|"

 I $D(LRSEG("OBX",4)) S LRHDG=LRHDG_"LOINC Code|"

 I $D(LRSEG("OBX",5)) S LRHDG=LRHDG_"LOINC Name|"

 I $D(LRSEG("OBX",6)) S LRHDG=LRHDG_"Test Result|"

 I $D(LRSEG("OBX",7)) S LRHDG=LRHDG_"Units|"

 I $D(LRSEG("OBX",8)) S LRHDG=LRHDG_"Flags or Interp|"

 I $D(LRSEG("OBX",9)) S LRHDG=LRHDG_"Verified Date/Time|"

 I LRHDG'="" S LRHDG=LRHDG_"OBX SUBID"

 I LRHDG]"" S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG S LRHDG="" S LRLC=LRLC+1

 S MSG=0,LRSPSHT="",LRPID="",LROBR=""

 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 ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT,LRLC=LRLC+1

 .I $P(LRMSGLIN,"|")="PID" D

 ..S LRSPSHT="********************************************************************************"

 ..I $D(LRSEG("PID")) S LRPID=$P(LRMSGLIN,HLFS,2),LRSPSHT=LRPID_"|"_LRX("PID")_"| | |"

 ..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)_"|"

 ..I $D(LRSEG("PID",4)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,6)_"|"

 ..I $D(LRSEG("PID",5)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($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)_"|"

 ..I $D(LRSEG("PID",9)) S LRSPSHT=LRSPSHT_$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)_"|"

 ..I $D(LRSEG("PID",12)) S LRSPSHT=LRSPSHT_$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_"|"

 .K LRPOS,LRPOSN,LRPOSNAM

 .I $P(LRMSGLIN,"|")="PV1" D

 ..I $D(LRSEG("PV1")) S LRSPSHT=LRPID_"|"_LRX("PV1")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"

 ..I $D(LRSEG("PV1",2)) D

 ...S TYPE=$P(LRMSGLIN,HLFS,3)

 ...S LRSPSHT=LRSPSHT_$S(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")_"|"

 ...K TYPE

 ..I $D(LRSEG("PV1",3)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,4)_"|"

 ..I $D(LRSEG("PV1",4)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,37),LRCS,2)_"|"

 ..I $D(LRSEG("PV1",5)) S LRSPSHT=LRSPSHT_$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 $P(LRMSGLIN,"|")="NTE" D

 ..I $D(LRSEG("NTE")) S LRSPSHT=LRPID_"|"_LRX("NTE")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"

 ..I $D(LRSEG("NTE",2)) S LRSPSHT=LRSPSHT_$P(LRMSGLIN,HLFS,3)_"|"

 .I $P(LRMSGLIN,"|")="OBR" D

 ..I $D(LRSEG("OBR")) S LROBR=$P(LRMSGLIN,HLFS,2),LRSPSHT=LRPID_"|"_LRX("OBR")_"|"_LROBR_"| |"

 ..I $D(LRSEG("OBR",2)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,5),LRCS,2)_"|"

 ..I $D(LRSEG("OBR",3)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P(LRMSGLIN,HLFS,8))_"|"

 ..I $D(LRSEG("OBR",4)) S LRSPSHT=LRSPSHT_$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 $P(LRMSGLIN,"|")="OBX" D

 ..I $D(LRSEG("OBX")) S LRSPSHT=LRPID_"|"_LRX("OBX")_"|"_LROBR_"|"_$P(LRMSGLIN,HLFS,2)_"|"

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

 ...S TSTNM=$P($P(LRMSGLIN,HLFS,4),LRCS,2)

 ...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",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)

 ..K TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV

 .I $P(LRMSGLIN,"|")="DG1" D

 ..I $D(LRSEG("DG1")) S LRSPSHT=LRPID_"|"_LRX("DG1")_"|"_$P(LRMSGLIN,HLFS,2)_"| |"

 ..I $D(LRSEG("DG1",2)) S LRSPSHT=LRSPSHT_$S($P($P(LRMSGLIN,HLFS,4),LRCS,3)["I10":"ICD10  ",1:"ICD9   ")_$P($P(LRMSGLIN,HLFS,4),LRCS,1)_"|"

 ..I $D(LRSEG("DG1",3)) S LRSPSHT=LRSPSHT_$P($P(LRMSGLIN,HLFS,4),LRCS,2)_"|"

 ..I $D(LRSEG("DG1",4)) S LRSPSHT=LRSPSHT_$$CDT^LREPIRP($P($P(LRMSGLIN,HLFS,5),LRCS))_"|"

 .S ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT,LRLC=LRLC+1

 K MSGLIN,LRSEG,LRZ

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRS3   8062     printed  Feb 18, 2025@23:40:28                                                                                                                                                                                                    Page 2

LREPIRS3  ;DALOI/CKA - EMERGING PATHOGENS LOCAL REPORT-GENERATE SPSHT ;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

SPSHT     ;

 +1        SET X1=DT

           SET X2=180

           DO C^%DTC

 +2        SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,0)=X_"^"_DT_"^EPI Local Report generation^"_$SELECT($DATA(DUZ):DUZ,1:"UNKNOWN")

HDG1      ;

 +1        SET LRHDG=""

           SET LRLC=1

           SET LRX=0

 +2        IF $DATA(LRSEG("PID"))

               SET LRX("PID")=LRX

               SET LRHDG="|"_LRX("PID")_"| |"

 +3        IF $DATA(LRSEG("PID",1))

               SET LRHDG=LRHDG_"PID|"

 +4        IF $DATA(LRSEG("PID",2))

               SET LRHDG=LRHDG_"SSN|"

 +5        IF $DATA(LRSEG("PID",3))

               SET LRHDG=LRHDG_"MPI|"

 +6        IF $DATA(LRSEG("PID",4))

               SET LRHDG=LRHDG_"Patient Name|"

 +7        IF $DATA(LRSEG("PID",5))

               SET LRHDG=LRHDG_"Date of Birth|"

 +8        IF $DATA(LRSEG("PID",6))

               SET LRHDG=LRHDG_"Sex|"

 +9        IF $DATA(LRSEG("PID",7))

               SET LRHDG=LRHDG_"Race|"

 +10       IF $DATA(LRSEG("PID",8))

               SET LRHDG=LRHDG_"Homeless|"

 +11       IF $DATA(LRSEG("PID",9))

               SET LRHDG=LRHDG_"State|"

 +12       IF $DATA(LRSEG("PID",10))

               SET LRHDG=LRHDG_"Zip|"

 +13       IF $DATA(LRSEG("PID",11))

               SET LRHDG=LRHDG_"County|"

 +14       IF $DATA(LRSEG("PID",12))

               SET LRHDG=LRHDG_"Ethnicity|"

 +15       IF $DATA(LRSEG("PID",13))

               SET LRHDG=LRHDG_"POS|"

 +16       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +17       IF $DATA(LRSEG("PV1"))

               SET LRX=LRX+1

               SET LRX("PV1")=LRX

               SET LRHDG="|"_LRX_"| |"

 +18       IF $DATA(LRSEG("PV1",1))

               SET LRHDG=LRHDG_"PV1|"

 +19       IF $DATA(LRSEG("PV1",2))

               SET LRHDG=LRHDG_"Patient Class|"

 +20       IF $DATA(LRSEG("PV1",3))

               SET LRHDG=LRHDG_"Hospital Location|"

 +21       IF $DATA(LRSEG("PV1",4))

               SET LRHDG=LRHDG_"Discharge Disposition|"

 +22       IF $DATA(LRSEG("PV1",5))

               SET LRHDG=LRHDG_"Facility|"

 +23       IF $DATA(LRSEG("PV1",6))

               SET LRHDG=LRHDG_"Admit Date/Time|"

 +24       IF $DATA(LRSEG("PV1",7))

               SET LRHDG=LRHDG_"Discharge Date/Time|"

 +25       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +26       IF $DATA(LRSEG("DG1"))

               SET LRX=LRX+1

               SET LRX("DG1")=LRX

               SET LRHDG="|"_LRX_"| |"

 +27       IF $DATA(LRSEG("DG1",1))

               SET LRHDG=LRHDG_"DG1|"

 +28       IF $DATA(LRSEG("DG1",2))

               SET LRHDG=LRHDG_"Diagnosis Code|"

 +29       IF $DATA(LRSEG("DG1",3))

               SET LRHDG=LRHDG_"Diagnosis|"

 +30       IF $DATA(LRSEG("DG1",4))

               SET LRHDG=LRHDG_"Admission Date|"

 +31       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +32       IF $DATA(LRSEG("NTE"))

               SET LRX=LRX+1

               SET LRX("NTE")=LRX

               SET LRHDG="|"_LRX_"| |"

 +33       IF $DATA(LRSEG("NTE",1))

               SET LRHDG=LRHDG_"NTE|"

 +34       IF $DATA(LRSEG("NTE",2))

               SET LRHDG=LRHDG_"Comment|"

 +35       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +36       IF $DATA(LRSEG("OBR"))

               SET LRX=LRX+1

               SET LRX("OBR")=LRX

               SET LRHDG="|"_LRX_"| |"

 +37       IF $DATA(LRSEG("OBR",1))

               SET LRHDG=LRHDG_"OBR|"

 +38       IF $DATA(LRSEG("OBR",2))

               SET LRHDG=LRHDG_"Test Name|"

 +39       IF $DATA(LRSEG("OBR",3))

               SET LRHDG=LRHDG_"Accession Date/Time|"

 +40       IF $DATA(LRSEG("OBR",4))

               SET LRHDG=LRHDG_"Specimen|"

 +41       IF $DATA(LRSEG("OBR",5))

               SET LRHDG=LRHDG_"Accession Number|"

 +42       IF LRHDG'=""

               SET LRHDG=LRHDG_"OBR SUBID"

 +43       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +44       IF $DATA(LRSEG("OBX"))

               SET LRX=LRX+1

               SET LRX("OBX")=LRX

               SET LRHDG="|"_LRX_"| |"

 +45       IF $DATA(LRSEG("OBX",1))

               SET LRHDG=LRHDG_"OBX|"

 +46       IF $DATA(LRSEG("OBX",2))

               SET LRHDG=LRHDG_"Value Type|"

 +47       IF $DATA(LRSEG("OBX",3))

               SET LRHDG=LRHDG_"Test Name|"

 +48       IF $DATA(LRSEG("OBX",4))

               SET LRHDG=LRHDG_"LOINC Code|"

 +49       IF $DATA(LRSEG("OBX",5))

               SET LRHDG=LRHDG_"LOINC Name|"

 +50       IF $DATA(LRSEG("OBX",6))

               SET LRHDG=LRHDG_"Test Result|"

 +51       IF $DATA(LRSEG("OBX",7))

               SET LRHDG=LRHDG_"Units|"

 +52       IF $DATA(LRSEG("OBX",8))

               SET LRHDG=LRHDG_"Flags or Interp|"

 +53       IF $DATA(LRSEG("OBX",9))

               SET LRHDG=LRHDG_"Verified Date/Time|"

 +54       IF LRHDG'=""

               SET LRHDG=LRHDG_"OBX SUBID"

 +55       IF LRHDG]""

               SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRHDG

               SET LRHDG=""

               SET LRLC=LRLC+1

 +56       SET MSG=0

           SET LRSPSHT=""

           SET LRPID=""

           SET LROBR=""

 +57       FOR

               SET MSG=$ORDER(^TMP("HLS",$JOB,MSG))

               if 'MSG

                   QUIT

               SET LRMSGLIN=^(MSG)

               Begin DoDot:1

 +58               SET LRSPSHT=""

 +59               if $PIECE(LRMSGLIN,"|")=""

                       QUIT

 +60               if '$DATA(LRSEG($PIECE(LRMSGLIN,"|")))

                       QUIT

 +61               IF $PIECE(LRMSGLIN,"|")="PID"

                       Begin DoDot:2

 +62                       SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT

                           SET LRLC=LRLC+1

                       End DoDot:2

 +63               IF $PIECE(LRMSGLIN,"|")="PID"

                       Begin DoDot:2

 +64                       SET LRSPSHT="********************************************************************************"

 +65                       IF $DATA(LRSEG("PID"))

                               SET LRPID=$PIECE(LRMSGLIN,HLFS,2)

                               SET LRSPSHT=LRPID_"|"_LRX("PID")_"| | |"

 +66                       IF $DATA(LRSEG("PID",2))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,20)_"|"

 +67                       IF $DATA(LRSEG("PID",3))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,4)_"|"

 +68                       IF $DATA(LRSEG("PID",4))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,6)_"|"

 +69                       IF $DATA(LRSEG("PID",5))

                               SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,8))_"|"

 +70                       IF $DATA(LRSEG("PID",6))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,9)_"|"

 +71                       IF $DATA(LRSEG("PID",7))

                               Begin DoDot:3

 +72                               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

 +73                               IF LRY>2

                                       SET LRSPSHT=LRSPSHT_"MULTIPLE|"

 +74                              IF '$TEST

                                       SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,11),LRCS,2)_"|"

                               End DoDot:3

                               KILL LRZ,LRY

 +75                       IF $DATA(LRSEG("PID",8))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,1)_"|"

 +76                       IF $DATA(LRSEG("PID",9))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,4),U,2)_"|"

 +77                       IF $DATA(LRSEG("PID",10))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,5)_"|"

 +78                       IF $DATA(LRSEG("PID",11))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE($PIECE(LRMSGLIN,HLFS,12),LRCS,9),U,2)_"|"

 +79                       IF $DATA(LRSEG("PID",12))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,23),LRCS,2)_"|"

 +80                       IF $DATA(LRSEG("PID",13))

                               Begin DoDot:3

 +81                               SET LRPOS=$PIECE(LRMSGLIN,HLFS,28)

 +82                               if LRPOS=""

                                       QUIT

 +83                               SET LRPOSN=0

 +84                               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

 +85                               SET LRSPSHT=LRSPSHT_LRPOSNAM_"|"

                               End DoDot:3

                               IF LRPOS=""

                                   SET LRSPSHT=LRSPSHT_"||"

                       End DoDot:2

 +86               KILL LRPOS,LRPOSN,LRPOSNAM

 +87               IF $PIECE(LRMSGLIN,"|")="PV1"

                       Begin DoDot:2

 +88                       IF $DATA(LRSEG("PV1"))

                               SET LRSPSHT=LRPID_"|"_LRX("PV1")_"|"_$PIECE(LRMSGLIN,HLFS,2)_"| |"

 +89                       IF $DATA(LRSEG("PV1",2))

                               Begin DoDot:3

 +90                               SET TYPE=$PIECE(LRMSGLIN,HLFS,3)

 +91                               SET LRSPSHT=LRSPSHT_$SELECT(TYPE="U":"Update",TYPE="I":"Inpatient",1:"Outpatient")_"|"

 +92                               KILL TYPE

                               End DoDot:3

 +93                       IF $DATA(LRSEG("PV1",3))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,4)_"|"

 +94                       IF $DATA(LRSEG("PV1",4))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,37),LRCS,2)_"|"

 +95                       IF $DATA(LRSEG("PV1",5))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,40)_"|"

 +96                       IF $DATA(LRSEG("PV1",6))

                               SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,45))_"|"

 +97                       IF $DATA(LRSEG("PV1",7))

                               SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,46))_"|"

                       End DoDot:2

 +98               IF $PIECE(LRMSGLIN,"|")="NTE"

                       Begin DoDot:2

 +99                       IF $DATA(LRSEG("NTE"))

                               SET LRSPSHT=LRPID_"|"_LRX("NTE")_"|"_$PIECE(LRMSGLIN,HLFS,2)_"| |"

 +100                      IF $DATA(LRSEG("NTE",2))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,3)_"|"

                       End DoDot:2

 +101              IF $PIECE(LRMSGLIN,"|")="OBR"

                       Begin DoDot:2

 +102                      IF $DATA(LRSEG("OBR"))

                               SET LROBR=$PIECE(LRMSGLIN,HLFS,2)

                               SET LRSPSHT=LRPID_"|"_LRX("OBR")_"|"_LROBR_"| |"

 +103                      IF $DATA(LRSEG("OBR",2))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,5),LRCS,2)_"|"

 +104                      IF $DATA(LRSEG("OBR",3))

                               SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,8))_"|"

 +105                      IF $DATA(LRSEG("OBR",4))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,16),LRCS,3)_"|"

 +106                      IF $DATA(LRSEG("OBR",5))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,19)_"|"

 +107                      SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,27),LRCS,2)

                       End DoDot:2

 +108              IF $PIECE(LRMSGLIN,"|")="OBX"

                       Begin DoDot:2

 +109                      IF $DATA(LRSEG("OBX"))

                               SET LRSPSHT=LRPID_"|"_LRX("OBX")_"|"_LROBR_"|"_$PIECE(LRMSGLIN,HLFS,2)_"|"

 +110                      IF $PIECE(LRMSGLIN,HLFS,3)="ST"

                               Begin DoDot:3

 +111                              SET TSTNM=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,2)

 +112                              SET OV=$PIECE(LRMSGLIN,HLFS,6)

                               End DoDot:3

 +113                      IF $PIECE(LRMSGLIN,HLFS,3)="CE"

                               Begin DoDot:3

 +114                              SET TSTNM=""

 +115                              SET OV=$PIECE($PIECE(LRMSGLIN,HLFS,6),LRCS,2)

                               End DoDot:3

 +116                      SET FD=$$CDT^LREPIRP($PIECE(LRMSGLIN,HLFS,15))

                           SET RR=$PIECE(LRMSGLIN,HLFS,9)

 +117                      SET UN=$PIECE(LRMSGLIN,HLFS,7)

 +118                      IF $PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,9)="LOINC"

                               Begin DoDot:3

 +119                              SET LOINC=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,7)

                                   SET LOINCN=$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,8)

                               End DoDot:3

 +120                      IF $DATA(LRSEG("OBX",2))

                               SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,3)_"|"

 +121                      IF $DATA(LRSEG("OBX",3))

                               SET LRSPSHT=LRSPSHT_TSTNM_"|"

 +122                      IF $DATA(LRSEG("OBX",4))

                               SET LRSPSHT=LRSPSHT_$GET(LOINC)_"|"

 +123                      IF $DATA(LRSEG("OBX",5))

                               SET LRSPSHT=LRSPSHT_$GET(LOINCN)_"|"

 +124                      IF $DATA(LRSEG("OBX",6))

                               SET LRSPSHT=LRSPSHT_OV_"|"

 +125                      IF $DATA(LRSEG("OBX",7))

                               SET LRSPSHT=LRSPSHT_UN_"|"

 +126                      IF $DATA(LRSEG("OBX",8))

                               SET LRSPSHT=LRSPSHT_RR_"|"

 +127                      IF $DATA(LRSEG("OBX",9))

                               SET LRSPSHT=LRSPSHT_FD_"|"

 +128                      SET LRSPSHT=LRSPSHT_$PIECE(LRMSGLIN,HLFS,5)

 +129                      KILL TST,TSTNM,LOINC,LOINCN,ENTRY,UN,RR,FD,OV

                       End DoDot:2

 +130              IF $PIECE(LRMSGLIN,"|")="DG1"

                       Begin DoDot:2

 +131                      IF $DATA(LRSEG("DG1"))

                               SET LRSPSHT=LRPID_"|"_LRX("DG1")_"|"_$PIECE(LRMSGLIN,HLFS,2)_"| |"

 +132                      IF $DATA(LRSEG("DG1",2))

                               SET LRSPSHT=LRSPSHT_$SELECT($PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,3)["I10":"ICD10  ",1:"ICD9   ")_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,1)_"|"

 +133                      IF $DATA(LRSEG("DG1",3))

                               SET LRSPSHT=LRSPSHT_$PIECE($PIECE(LRMSGLIN,HLFS,4),LRCS,2)_"|"

 +134                      IF $DATA(LRSEG("DG1",4))

                               SET LRSPSHT=LRSPSHT_$$CDT^LREPIRP($PIECE($PIECE(LRMSGLIN,HLFS,5),LRCS))_"|"

                       End DoDot:2

 +135              SET ^XTMP("LREPILOCALSPSHT"_LRLRDT,LRLC)=LRSPSHT

                   SET LRLC=LRLC+1

               End DoDot:1

 +136      KILL MSGLIN,LRSEG,LRZ

 +137      QUIT

LREPIRS3.m