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

LREPI2.m

Go to the documentation of this file. 
  1. LREPI2 ;VA/DALOI/SED-EMERGING PATHOGENS HL7 BUILD ; 17-Oct-2014 09:22 ; MKK
  1.  ;;5.2;LAB SERVICE;**132,157,175,242,1018,260,281,320,1030,1034**;NOV 01, 1997;Build 88
  1.  ;
  1.  ;Reference to ^DPT(DFN,0),U,9) supported by IA # 10035
  1. START ;START WITH THE PROTOCOL USED
  1.  S LRPROT=0 F  S LRPROT=$O(^TMP($J,LRPROT)) Q:+LRPROT'>0  D
  1.  . D INIT^HLFNC2(LRPROT,.HL)
  1.  . S LRCS=$E(HL("ECH")),LRMSGNM=1,LRMSGSZ=0
  1.  . S LRMSGDF=$S(+$P($G(^LAB(69.4,LRPROT,0)),U,3)>0:+$P($G(^LAB(69.4,LRPROT,0)),U,3),1:30000)
  1.  . D EN I LRMSGSZ D MOVE,SEND
  1.  . F LRTND="ETI","TST","HEP" D:$D(^TMP($J,LRTND)) TOTAL
  1.  . D SEND,ALERT
  1.  D REPORT^LREPIRP
  1.  K ^TMP("HLS",$J)
  1.  K LRMSGDF,LRMSGNM,LRMSGSZ,%,%X
  1.  Q
  1. ALERT ;Send a Alert if desired.
  1.  K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQADATA,XQAFLAG
  1.  Q:+$G(LRRTYPE)=1
  1.  S X="NOW",%DT="SRT" D ^%DT,DD^%DT
  1.  S XQAMSG=$P(^LAB(69.4,LRPROT,0),U,5)_" Was processed at "_Y
  1.  ;GET THE DUZ'S FOR ALERTS
  1.  S LRIEN=0 F  S LRIEN=$O(^LAB(69.4,LRPROT,1,LRIEN)) Q:+LRIEN'>0  D
  1.  .S LRDATA=$G(^LAB(69.4,LRPROT,1,LRIEN,0))
  1.  .I $P(LRDATA,";",2)["VA(200" S XQA($P(LRDATA,";",1))=""
  1.  .I $P(LRDATA,";",2)["XMB(3.8" D
  1.  ..S LRMG=$P(LRDATA,";",1) ;Q:'$D(^XMB(3.8,LRMG))
  1.  ..S LRMGN=$$GET1^DIQ(69.4,LRMG,1) Q:LRMGN=""
  1.  ..S X=LRMGN,XMDUZ=DUZ D INST^XMA21
  1.  ..;S LRDUZ=0 F  S LRDUZ=$O(^XMB(3.8,LRMG,1,"B",LRDUZ)) Q:+LRDUZ'>0  S XQA(LRDUZ)=""
  1.  Q:'$D(XQA)
  1.  D SETUP^XQALERT
  1.  Q
  1. SEND ;SEND THE HL7 MESSAGE
  1.  D HEAD
  1.  N HLP
  1.  S HLP("NAMESPACE")="LR"
  1.  D GENERATE^HLMA(LRPROT,"GM",1,.HLRST,"",.HLP)
  1.  S LRMSGNM=LRMSGNM+1,LRMSGSZ=0
  1.  K ^TMP("HLS",$J)
  1.  Q
  1. EN ;ENTRY TO BUILD A MESSAGE
  1.  S (LRCNT,LRPID)=1,DFN=0
  1.  F  S DFN=$O(^TMP($J,LRPROT,DFN)) Q:+DFN'>0  D
  1.  .I LRMSGSZ>5000 D MOVE,SEND
  1.  .Q:$E($P(^DPT(DFN,0),U,9),1,5)="00000"
  1.  .D PID^LREPI3
  1.  .S LRPV1=1,LRENDT=0,LRPFG="",LREFG=0,LRPVVV=0
  1.  .F  S LRENDT=$O(^TMP($J,LRPROT,DFN,LRENDT)) S LRPFG="" Q:+LRENDT'>0!(LREFG)  D
  1.  ..D PV1
  1.  ..I $D(^TMP("LREPISRCH",$J,DFN)),LRPROT=LRPROTX D RXNT^LREPIPH
  1.  ..S LRPATH=0,LRNTE=1,LRPVVV=1
  1.  ..F  S LRPATH=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH)) Q:+LRPATH'>0!(LREFG)  D
  1.  ...D:LRPFG'=LRPATH NTE^LREPI3
  1.  ...S LRPFG=LRPATH,LROBR=1,LRINVD=0
  1.  ...F  S LRINVD=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD)) Q:+LRINVD'>0!(LREFG)  D
  1.  ....S LRND=""
  1.  ....F  S LRND=$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH,LRINVD,LRND)) Q:LRND=""!(LREFG)  D
  1.  .....S LRDFN=$$LRDFN^LR7OR1(DFN) Q:'LRDFN
  1.  .....S LREFG=+$P($G(^LAB(69.5,LRPATH,0)),U,6)
  1.  .....S:LRND'="PTF" LROBR=$$EN^LREPI1(LRDFN,LRND,LRINVD,LROBR)+1
  1.  .....D:LRND="PTF" DG1^LREPI3
  1.  .....D MOVE
  1.  Q
  1. TOTAL ;Report the total counts  ->    "ETI" or "TST" or "HEP"
  1.  ;                                \/
  1.  S LRITN=0 F  S LRITN=$O(^TMP($J,LRTND,LRITN)) Q:+LRITN'>0  D
  1.  .S (LRNLT,LRTNM)=""
  1.  .I LRTND="TST" D
  1.  ..I '$D(^TMP($J,"TPROT",LRITN,LRPROT)) QUIT
  1.  ..S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
  1.  ..S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
  1.  ..Q:'$D(^LAM(LRNL,0))
  1.  ..S LRNLT=$P(^LAM(LRNL,0),U,2)
  1.  .I LRTND="ETI" D
  1.  ..I '$D(^TMP($J,"EPROT",LRITN)) QUIT
  1.  ..S LRTNM=$P($G(^LAB(61.2,LRITN,0)),U,1)
  1.  ..S LRNL=$G(^LAB(61.2,LRITN,64)) Q:+LRNL'>0
  1.  ..Q:'$D(^LAM(LRNL,0))
  1.  ..S LRNLT=$P(^LAM(LRNL,0),U,2)
  1.  .I LRTND="STOT" D
  1.  ..I '$D(^TMP($J,"SPROT",LRITN,LRPROT)) QUIT
  1.  ..S LRTNM=""
  1.  ..S LRNL=LRITN
  1.  ..S LRNLT=""
  1.  .I LRTND="HEP" D
  1.  ..I '$D(^TMP($J,"HEP",LRITN)) QUIT
  1.  ..S LRNLT=""
  1.  ..I LRITN=1 S LRTNM="1-Declined Assessment for Hepatitis C"
  1.  ..I LRITN=2 S LRTNM="2-No Risk Factors for Hepatitis C"
  1.  ..I LRITN=3 S LRTNM="3-Previously Assessed for Hepatitis C"
  1.  ..I LRITN=4 S LRTNM="4-Risk Factors for Hepatitis C"
  1.  ..I LRITN=5 S LRTNM="5-Positive Test for Hepatitis C antibody"
  1.  ..I LRITN=6 S LRTNM="6-Negative Test for Hepatitis C antibody"
  1.  ..;I LRITN=7 S LRTNM="7- Hepatitis C diagnosis (ICD-9 based)"
  1.  ..I LRITN=7 S LRTNM="7- Hepatitis C diagnosis (ICD based)"     ; IHS/MSC/MKK - LR*5.2*1034
  1.  .K LRDATA
  1.  .I '$G(LRTNM) D NAME
  1.  .S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_LRTNM_LRCS_+^TMP($J,LRTND,LRITN)
  1.  .S LRCNT=LRCNT+1
  1.  .S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
  1.  .S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
  1.  .K LRDATA
  1.  .S (LRPCNT,LRPTOT)=0
  1.  .F  S LRPCNT=$O(^TMP($J,LRTND,LRITN,LRPCNT)) Q:+LRPCNT'>0  S LRPTOT=LRPTOT+1
  1.  .Q:LRPTOT'>0
  1.  .I '$G(LRTNM) D NAME
  1.  .S LRDATA="NTE"_HLFS_HLFS_"T"_LRCS_LRNLT_LRCS_"PATIENTS WITH "_LRTNM_LRCS_LRPTOT ;+^TMP($J,LRPCNT,LRITN)
  1.  .S LRCNT=LRCNT+1
  1.  .S ^TMP("HLS",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
  1.  .S ^TMP("LREPIREP",$J,LRCNT)=$$UP^XLFSTR(LRDATA)
  1.  Q
  1. NAME ;
  1.  Q:LRTND'="TST"
  1.  S LRTNM=$P($G(^LAB(60,LRITN,0)),U,1)
  1.  S LRNL=$G(^LAB(60,LRITN,64)) Q:+LRNL'>0
  1.  Q:'$D(^LAM(LRNL,0))
  1.  S LRNLT=$P(^LAM(LRNL,0),U,2)
  1.  ;
  1.  QUIT
  1.  K LRDATA
  1.  S LRDATA="NTE"_HLFS_HLFS_$S(LRRTYPE:"R",1:"")_LRCS
  1.  I $G(LR31799Z)=1 S LRDATA=LRDATA_"*** H E P A T I T I S  C  MARCH 17 1999 ***"
  1.  S LRDATA=LRDATA_"REPORTING DATE FROM "_$$HLDATE^HLFNC(LRRPS)
  1.  S LRDATA=LRDATA_" TO "_$$HLDATE^HLFNC(LRRPE)
  1.  S LRDATA=LRDATA_LRCS_LRMSGNM
  1.  I LRPROTX=LRPROT S LRDATA=LRDATA_LRCS_LRCS_"V3"
  1.  I '$O(^TMP("HLS",$J,1)) S LRDATA=LRDATA_LRCS_"N"
  1.  S ^TMP("HLS",$J,1)=$$UP^XLFSTR(LRDATA),LRMSGSZ=LRMSGSZ+$L(LRDATA)
  1.  S ^TMP("LREPIREP",$J,1)=$$UP^XLFSTR(LRDATA)
  1.  K LRDATA
  1.  Q
  1. MOVE S LRMOVE=0
  1.  F  S LRMOVE=$O(^TMP("HL7",$J,LRMOVE)) Q:+LRMOVE'>0  D
  1.  .S LRCNT=LRCNT+1
  1.  .S ^TMP("HLS",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
  1.  .S ^TMP("LREPIREP",$J,LRCNT)=^TMP("HL7",$J,LRMOVE)
  1.  .S LRMSGSZ=LRMSGSZ+$L(^TMP("HL7",$J,LRMOVE))
  1.  K ^TMP("HL7",$J),LRMOVE
  1.  Q
  1.  ;
  1. PV1 ;
  1.  ;I $O(^TMP($J,LRPROT,DFN,LRENDT,""))!('$D(^TMP("LREPISRCH",$J,DFN)))!($P(LRNDTDA,"^",3))="UPDT" D PV1^LREPI3 S LRPVVV=1
  1.  I LRPV1>1,$O(^TMP($J,LRPROT,DFN,LRENDT,LRPATH))="",$P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)'="UPDT" Q
  1.  I $P($G(^TMP($J,LRPROT,DFN,LRENDT)),"^",3)="UPDT" D PV1^LREPI3 S LRPVVV=1 Q
  1.  I $O(^TMP($J,LRPROT,DFN,LRENDT,""))]"" D PV1^LREPI3 S LRPVVV=1 Q
  1.  I '$D(^TMP("LREPISRCH",$J,DFN)) D PV1^LREPI3 S LRPVVV=1 Q
  1.  Q       ; IHS/MSC/MKK - LR*5.2*1034