| 1 | ECXLABN ;ALB/JAP,BIR/CML-Lab Extract for DSS (New Format - With LMIP Codes) ; 10/23/07 3:01pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**1,11,8,13,28,24,30,31,32,33,39,42,46,70,71,80,92,107,105**;Dec 22, 1997;Build 70
|
|---|
| 3 | BEG ;entry point
|
|---|
| 4 | D SETUP I ECFILE="" Q
|
|---|
| 5 | D ^ECXTRAC,^ECXKILL
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | START ; entry when queued
|
|---|
| 9 | K ^LRO(64.03),^TMP($J,"ECXP")
|
|---|
| 10 | N ECDOCPC
|
|---|
| 11 | S LRSDT=ECSD,LREDT=ECED,QFLG=0
|
|---|
| 12 | D ^LRCAPDSS
|
|---|
| 13 | ;quit if no completion date for API compile
|
|---|
| 14 | I '$P($G(^LRO(64.03,1,1,1,0)),U,4) Q
|
|---|
| 15 | ;quit if tasked and user sends stop request
|
|---|
| 16 | I $D(ZTQUEUED),$$S^%ZTLOAD D Q
|
|---|
| 17 | .S QFLG=1
|
|---|
| 18 | .K ^LRO(64.03) S ^LRO(64.03,0)="WKLD LOG FILE^64.03^"
|
|---|
| 19 | ;otherwise, continue
|
|---|
| 20 | K ECXDD D FIELD^DID(64.03,1,,"SPECIFIER","ECXDD")
|
|---|
| 21 | S ECPROF=$E(+$P(ECXDD("SPECIFIER"),"P",2)),ECLRN=1 K ECXDD
|
|---|
| 22 | F S ECLRN=$O(^LRO(64.03,ECLRN)) Q:'ECLRN D Q:QFLG
|
|---|
| 23 | .Q:'$D(^LRO(64.03,ECLRN,0))
|
|---|
| 24 | .S EC1=^LRO(64.03,ECLRN,0),ECDOC=ECPROF_$P(EC1,U,2)
|
|---|
| 25 | .S ECDOCNPI=$$NPI^XUSNPI("Individual_ID",$P(EC1,U,2),$P(EC1,U,4))
|
|---|
| 26 | .S:+ECDOCNPI'>0 ECDOCNPI="" S ECDOCNPI=$P(ECDOCNPI,U)
|
|---|
| 27 | .S ECLOC=$P(EC1,U,15),EC=$P(EC1,U,3),ECDOCPC=$$PRVCLASS^ECXUTL($P(EC1,U,2),$P(EC1,U,4))
|
|---|
| 28 | .I EC]"" D GET
|
|---|
| 29 | K ^LRO(64.03),^TMP($J,"ECXP") S ^LRO(64.03,0)="WKLD LOG FILE^64.03^"
|
|---|
| 30 | K ECDOCNPI,ECXAGC,ECXL1,ECXL2
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | GET ;get data
|
|---|
| 34 | N X,ECXSTN,QFLAG
|
|---|
| 35 | S ECF=$S($P(EC,";",2)="DPT(":2,$P(EC,";",2)="LRT(67,":67,1:0) Q:'ECF
|
|---|
| 36 | S ECIFN=$P(EC,";"),QFLAG=0
|
|---|
| 37 | ;resolve ecloc
|
|---|
| 38 | S ECXL1=+$P(ECLOC,";",1),ECXL2=$P(ECLOC,";",2)
|
|---|
| 39 | I ECF=2 S ECLOC=$S(ECXL1>0:ECXL1,1:"") I ECXL2]"",ECXL2'="SC(" S ECLOC=""
|
|---|
| 40 | I ECF=67 D S ECLOC=ECXSTN
|
|---|
| 41 | .S (ECXSTN,ECXAGC)=""
|
|---|
| 42 | .I (ECXL2'="DIC(4,")!('$D(^DIC(4,ECXL1))) S ECXSTN="XXXXX",ECXAGC="XX" Q
|
|---|
| 43 | .S ECXSTN=$P(^DIC(4,ECXL1,"99"),U,1),ECXAGC=$E($P(^(99),U,5),1,2)
|
|---|
| 44 | .S:ECXSTN="" ECXSTN="ZZZZZ" S:ECXAGC="" ECXAGC="ZZ"
|
|---|
| 45 | S ECDT=$P(EC1,U,13),ECD=$P(ECDT,"."),ECTM=$$ECXTIME^ECXUTL(ECDT)
|
|---|
| 46 | S ECWKLD=$P(EC1,U,11),ECWK="" I $D(^LAM(ECWKLD,0)) S ECWK=$P(^(0),U,2)
|
|---|
| 47 | S (ECXADMDT,ECTREAT,ECNA,ECSN,ECMN,ECPTTM,ECPTPR,ECCLAS)="",ECA="O",ECXERR=0
|
|---|
| 48 | S (ECPTNPI,ECASPR,ECCLAS2,ECASNPI)=""
|
|---|
| 49 | ;get the patient data if record is in file #2
|
|---|
| 50 | I ECF=2 D PAT(ECIFN,ECDT,.ECXERR)
|
|---|
| 51 | Q:ECXERR
|
|---|
| 52 | ;get patient data if record is in file #67
|
|---|
| 53 | I ECF=67 S ECSN="000123456",ECNA="RFRL" I $D(^LRT(67,ECIFN,0)) D Q:QFLAG
|
|---|
| 54 | .S ECXMPI="",EC0=^LRT(67,ECIFN,0),ECNA=$E($P($P(EC0,U),",")_" ",1,4)
|
|---|
| 55 | .S ECSN=$P(EC0,U,9),ECXERI="" D
|
|---|
| 56 | ..S ECNA=$TR(ECNA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 57 | ..I ECSN="" S ECSN="000123456" Q
|
|---|
| 58 | ..S ECSN=$TR(ECSN," "),ECSN=$TR(ECSN,"-")
|
|---|
| 59 | ..I ($L(ECSN)<9)!($L(ECSN)>10) S ECSN="000123456" Q
|
|---|
| 60 | ..I $L(ECSN)=9,ECSN'?9N S ECSN="000123456" Q
|
|---|
| 61 | ..I $L(ECSN)=10,ECSN'?9N1"P" S ECSN="000123456"
|
|---|
| 62 | ..I '$$SSN^ECXUTL5(ECSN,ECF) S QFLAG=1
|
|---|
| 63 | ;
|
|---|
| 64 | ;- Only set treating spec (TS) to TS in file #64.03 if it does not exist
|
|---|
| 65 | I ECA="I",ECTREAT="" S ECTREAT=$P($G(^DIC(45.7,+$P(EC1,U,10),0)),U,2)
|
|---|
| 66 | S (ECXDOM,ECXDSSD)=""
|
|---|
| 67 | S X=$G(^ECX(727.831,+ECTREAT,0)) S:X'="" ECXDOM=$P(X,U,2)
|
|---|
| 68 | ;
|
|---|
| 69 | ;- Get ordering stop code and ordering date
|
|---|
| 70 | S ECXORDST=+$P(EC1,U,15),ECXORDST=$S(ECXORDST:$P($G(^ECX(728.44,ECXORDST,0)),U,2),1:"")
|
|---|
| 71 | S ECXORDDT=$S($P(EC1,U,14):$$ECXDATE^ECXUTL($P(EC1,U,14),ECXYM),1:"")
|
|---|
| 72 | ;
|
|---|
| 73 | ;- Get Production Division - ECXDIEN added p-80
|
|---|
| 74 | N ECXPDIV,ECXDIEN S ECXDIEN=$O(^DIC(4,"D",ECINST,"")),ECXPDIV=$$RADDIV^ECXDEPT(ECXDIEN) ;P-46
|
|---|
| 75 | K ECXDIEN
|
|---|
| 76 | ;
|
|---|
| 77 | ;- Observation patient indicator (YES/NO)
|
|---|
| 78 | S ECXOBS=$$OBSPAT^ECXUTL4(ECA,ECTREAT)
|
|---|
| 79 | ;
|
|---|
| 80 | ;- If no encounter number don't file record
|
|---|
| 81 | S ECXENC=$$ENCNUM^ECXUTL4(ECA,ECSN,ECXADMDT,ECD,ECTREAT,ECXOBS,ECHEAD,,) Q:ECXENC=""
|
|---|
| 82 | ;create extract record only if patient name and accession area exist
|
|---|
| 83 | I ECNA]"" S ECT=$P(EC1,U,8),ECURG=$P(EC1,U,9),EC=+$P(EC1,U,7) I EC D
|
|---|
| 84 | .S:ECF=2 ECACA=EC_U_$P($G(^LRO(68,EC,0)),U,11)
|
|---|
| 85 | .S:ECF=67 ECACA=ECXAGC_U_$P($G(^LRO(68,EC,0)),U,11)
|
|---|
| 86 | .D FILE
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | PAT(ECXDFN,ECXDATE,ECXERR) ;get/set patient data
|
|---|
| 90 | N X,OK,PT
|
|---|
| 91 | ;get data
|
|---|
| 92 | I $D(^TMP($J,"ECXP",ECXDFN)) D
|
|---|
| 93 | .S PT=^TMP($J,"ECXP",ECXDFN),ECNA=$P(PT,U)
|
|---|
| 94 | .S ECSN=$P(PT,U,2),ECXMPI=$P(PT,U,3),ECXERI=$P(PT,U,4)
|
|---|
| 95 | ;set data and save for later
|
|---|
| 96 | I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK
|
|---|
| 97 | .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECSD,"."),"1;3",.ECXPAT)
|
|---|
| 98 | .I 'OK S ECXERR=1 Q
|
|---|
| 99 | .S ECNA=ECXPAT("NAME"),ECSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI")
|
|---|
| 100 | .S ECXERI=ECXPAT("ERI")
|
|---|
| 101 | .S ^TMP($J,"ECXP",ECXDFN)=ECNA_U_ECSN_U_ECXMPI_U_ECXERI
|
|---|
| 102 | ;get date specific data
|
|---|
| 103 | S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECA=$P(X,U),ECMN=$P(X,U,2),ECTREAT=$P(X,U,3),ECXADMDT=$P(X,U,4)
|
|---|
| 104 | S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."),ECPROF)
|
|---|
| 105 | S ECPTTM=$P(X,U,1),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
|
|---|
| 106 | S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | FILE ;file record
|
|---|
| 110 | ;node0
|
|---|
| 111 | ;facility^patient number^SSN (or equivalent)^name^in/out ECA^
|
|---|
| 112 | ;day^accession area^abbreviation^test^urgency^treating spec^
|
|---|
| 113 | ;location^provider and file^
|
|---|
| 114 | ;movement number^file^time^workload code^primary care team^
|
|---|
| 115 | ;primary care provider
|
|---|
| 116 | ;node1
|
|---|
| 117 | ;mpi^dss dept^provider npi^pc provider npi^pc prov person class^
|
|---|
| 118 | ;assoc pc prov^assoc pc prov person class^assoc pc prov npi^
|
|---|
| 119 | ;dom ECXDOM^observ pat ind ECXOBS^encounter num ECXENC^
|
|---|
| 120 | ;ord stop code ECXORDST^ord date ECXORDDT^production division
|
|---|
| 121 | ;ECXPDIV^^ordering provider person class^emergency response indicator
|
|---|
| 122 | ;(FEMA) ECXERI^associate pc provider npi ECASNPI^primary care provider
|
|---|
| 123 | ;npi ECPTNPI^provider npi ECDOCNPI
|
|---|
| 124 | ;ECDOCPC
|
|---|
| 125 | N DA,DIK
|
|---|
| 126 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 127 | S ECODE=EC7_U_EC23_U_ECINST_U_ECIFN_U_ECSN_U_ECNA_U_ECA_U
|
|---|
| 128 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U_ECACA_U_ECT_U_ECURG_U
|
|---|
| 129 | ;convert specialty to PTF Code for transmission
|
|---|
| 130 | N ECXDATA
|
|---|
| 131 | S ECXDATA=$$TSDATA^DGACT(42.4,+ECTREAT,.ECXDATA)
|
|---|
| 132 | S ECTREAT=$G(ECXDATA(7))
|
|---|
| 133 | ;done
|
|---|
| 134 | S ECODE=ECODE_ECTREAT_U_ECLOC_U_ECDOC_U_ECMN_U_ECF_U_ECTM_U_ECWK_U
|
|---|
| 135 | S ECODE=ECODE_ECPTTM_U_ECPTPR_U
|
|---|
| 136 | ;(ECACA=acc area^abbreviation)
|
|---|
| 137 | S ECODE1=ECXMPI_U_ECXDSSD_U_U_U_ECCLAS_U_ECASPR_U
|
|---|
| 138 | S ECODE1=ECODE1_ECCLAS2_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U
|
|---|
| 139 | S ECODE1=ECODE1_ECXORDST_U_ECXORDDT_U_ECXPDIV_U
|
|---|
| 140 | I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECDOCPC
|
|---|
| 141 | I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI
|
|---|
| 142 | I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECASNPI_U_ECPTNPI_U_ECDOCNPI
|
|---|
| 143 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1
|
|---|
| 144 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 145 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
|
|---|
| 146 | Q
|
|---|
| 147 | ;
|
|---|
| 148 | SETUP ;Set required input for ECXTRAC
|
|---|
| 149 | S ECHEAD="LAB"
|
|---|
| 150 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 154 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
|---|
