| [613] | 1 | ECXLABO ;BIR/MAM,DMA,CML-Lab Extract for DSS (Old Version - W/O LMIP Codes); [ 11/22/96 5:28 PM ]
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**11**;Dec 22, 1997
|
|---|
| 3 | V ;;2.0T11;DSS EXTRACTS;**24**;DEC 18,1996
|
|---|
| 4 | ;This routine was originally called ECXLAB1, as called from the DSS menu. Now ECXLAB1 is the driver routine to call ECXLABO (old format) or ECXLABN (new format)
|
|---|
| 5 | D SETUP,^ECXTRAC
|
|---|
| 6 | END D ^ECXKILL
|
|---|
| 7 | Q
|
|---|
| 8 | START ; entry when queued
|
|---|
| 9 | S QFLG=0
|
|---|
| 10 | S ECED=ECED+.3
|
|---|
| 11 | K ECXDD D FIELD^DID(69.01,7,,"SPECIFIER","ECXDD") S ECPROF=$E(+$P(ECXDD("SPECIFIER"),"P",2)) K ECXDD ; provider points to
|
|---|
| 12 | S ECD=ECSD1 F S ECD=$O(^LRO(69,ECD)),ECLRN=0 Q:'ECD Q:ECD>ECED F S ECLRN=$O(^LRO(69,ECD,1,ECLRN)) Q:'ECLRN I $D(^(ECLRN,0)) S EC1=^(0),ECDOC=ECPROF_$P(EC1,"^",6),ECLOC=$P(EC1,"^",9),EC=$G(^LR(+EC1,0)) I EC]"" D Q:QFLG
|
|---|
| 13 | .S ECDT=$P(EC1,"^",5),ECTM=$$ECXTIME^ECXUTL(ECDT)
|
|---|
| 14 | .S (ECNA,ECSN,ECMN,ECTREAT,ECPTTM,ECPTPR)="",ECA=1
|
|---|
| 15 | .S ECF=$P(EC,"^",2),ECIFN=$P(EC,"^",3)
|
|---|
| 16 | .I ECF=2,$D(^DPT(ECIFN,0)) D
|
|---|
| 17 | ..S EC0=^(0),ECNA=$E($P($P(EC0,"^"),",")_" ",1,4),ECSN=$P(EC0,"^",9) K VAIP S VAIP("D")=ECD,DFN=ECIFN D IN5^VADPT S ECMN=VAIP(1) I ECMN S ECA=3,ECTREAT=$P($G(^DIC(45.7,+VAIP(8),0)),"^",2)
|
|---|
| 18 | ..S ECPTTM=+$$OUTPTTM^ECXUTL3(DFN,ECDT)
|
|---|
| 19 | ..S:ECPTTM=0 ECPTTM=""
|
|---|
| 20 | ..S ECPTPR=+$$OUTPTPR^ECXUTL3(DFN,ECDT)
|
|---|
| 21 | ..S:ECPTPR=0 ECPTPR=""
|
|---|
| 22 | .K VAIP,VAERR
|
|---|
| 23 | .I ECF=67 S ECSN="000123456",ECNA="RFRL"
|
|---|
| 24 | .I ECF=67.1 S ECSN=888888888,ECNA="RSCH"
|
|---|
| 25 | .I ECNA]"" S J=0 F S J=$O(^LRO(69,ECD,1,ECLRN,2,J)) Q:'J S EC=$G(^(J,0)) I EC]"" S ECT=$P(EC,"^"),ECURG=$P(EC,"^",2),EC=+$P(EC,"^",4),ECACA=EC_"^"_$P($G(^LRO(68,EC,0)),"^",11) I EC D
|
|---|
| 26 | ..S ECODE=ECINST_"^"_ECIFN_"^"_ECSN_"^"_ECNA_"^"_ECA_"^"_$$ECXDATE^ECXUTL(ECD,ECXYM)_"^"_ECACA_"^"_ECT_"^"_ECURG_"^"_ECTREAT_"^"_ECLOC_"^"_ECDOC_"^"_ECMN_"^"_ECF_"^"_ECTM_"^^"_ECPTTM_"^"_ECPTPR_"^"
|
|---|
| 27 | ..;inst^patient (or thing) number^SSN (or equivalent)^name^in/out^day^accession area^abbreviation^test^urgency^treating spec^location^provider and file^
|
|---|
| 28 | ..;movement number^file^time^workload code^primary care team^primary care provider
|
|---|
| 29 | ..;(ECACA=acc area^abbreviation)
|
|---|
| 30 | ..S EC7=-$O(^ECX(ECFILE,"AINV","")) F S EC7=EC7+1 Q:'$D(^ECX(ECFILE,EC7))
|
|---|
| 31 | ..S ^ECX(ECFILE,EC7,0)=EC7_"^"_EC23_"^"_ECODE,ECRN=ECRN+1 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX^DIK K DIK,DA
|
|---|
| 32 | .I $D(ZTQUEUED),(ECRN>499),'(ECRN#500),$$S^%ZTLOAD S QFLG=1
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SETUP S ECPACK="Laboratory",ECPIECE=1,ECRTN="START^ECXLABO",ECGRP="LAB",ECHEAD="LAB",ECFILE=727.813,ECVER=3
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 40 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
|---|
