Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LREPIRS3

LREPIRS3.m

Go to the documentation of this file.
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
 Q
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
 Q