ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 8/17/07 9:52am
;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92,105,120,127**;Dec 22, 1997;Build 36
;
BEG ;entry point from option
D SETUP I ECFILE="" Q
D ^ECXTRAC,^ECXKILL
Q
;
START ;entry point from tasked job
S QFLG=0
;get first record #
S EC7=$O(^ECX(ECFILE,999999999),-1)
;call mh/dss api for extract record creation
;variables ecfile,ecxym,ecinst,ecsd,eced passed in by taskmanager
S ECXSEQ=EC7,ECXECX=$P(EC23,U,2),ECXERR=0
;call mh api to create extract records
S X="YSDSS" X ^%ZOSF("TEST") I '$T S QFLG=1 Q
D UPD^YSDSS(ECFILE,.ECXSEQ,ECXYM,ECXECX,ECINST,ECSD,ECED,.ECXERR)
Q:ECXERR
Q:QFLG
;if no error, continue
D UPDATE
Q
;
UPDATE ;add non-mh data to each record created by mh api
N ECXADT,JJ,ECXNPRFI
S EC7=EC7+1
F JJ=EC7:1:ECXSEQ Q:QFLG D
.Q:'$D(^ECX(ECFILE,JJ,0))
.S ECXDFN=$P(^ECX(ECFILE,JJ,0),U,5),ECXDATE=$P(^ECX(ECFILE,JJ,0),U,9),ECXPRV=$P(^ECX(ECFILE,JJ,0),U,18)
.S ECXSCNUM=$P(^ECX(ECFILE,JJ,0),U,23),ECXSCNAM=$P(^ECX(ECFILE,JJ,0),U,24)
.D PAT(ECXDFN,ECXDATE)
.S (ECXPRCLS,ECPRNPI,ECXDIV,ECXPDIV)="" I ECXPRV D PROV(.ECXPRV,ECXDATE)
.S ECXDSSI=""
.I ECXLOGIC>2003 D
..I "^18^23^24^41^65^94^108^"[("^"_ECXTS_"^") S ECXDSSI=$$TSMAP^ECXUTL4(ECXTS)
.;
.;- Observation patient indicator (YES/NO)
.S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXDSSI)
.;
.;- set national patient record flag if exist
.D NPRF^ECXUTL5
.;
.;- If no encounter number don't file record
.S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,) Q:ECXENC=""
.S ECD=ECXDATE,ECXDATE=$$ECXDATE^ECXUTL(ECXDATE,ECXYM)
.;adjust scale name & scale number
.S ECXSCNAM=$E(ECXSCNAM,1,10)
.I ECXSCNUM]"",ECXSCNUM'=+ECXSCNUM S ECXSCNUM=+$E(ECXSCNUM,2,99)
.N ECXDEPT S ECXDEPT="" ;dss department use postponed S ECXDEPT=$$MTL^ECXDEPT(ECXDIV,ECXSCNAM,ECINST) ;p-46 line added
.;Set division to external value if extract is for FY05 or higher
.D FILE
Q
;
PAT(ECXDFN,ECXDATE) ;determine in/outpatient status, demographics, primary care
N OK
S (ECXADT,ECXPNM,ECXSSN,ECXMPI)=""
K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;3;5;",.ECXPAT)
S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI")
S ECXDOB=ECXPAT("DOB")
;agent orange status
S ECXAST=ECXPAT("AO STAT")
;- Purple Heart Indicator, Period of Service, Agent Orange Location
S ECXPHI=$G(ECXPAT("PHI")),ECXPOS=ECXPAT("POS"),ECXAOL=ECXPAT("AOL")
I $$ENROLLM^ECXUTL2(ECXDFN)
;Combat Veteran Status
S X3=$$CVEDT^ECXUTL5(ECXDFN,$S($G(ECD):ECD,$G(ECXDATE):ECXDATE,1:DT))
; - Head and Neck Cancer Indicator
S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
; - Race and Ethnicity
S ECXETH=ECXPAT("ETHNIC")
S ECXRC1=ECXPAT("RACE1")
;get primary care data
S X=$$PRIMARY^ECXUTL2(ECXDFN,ECXDATE),ECPTTM=$P(X,U)
S ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
;get inpatient data
S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXDOM=$P(X,U,10),ECXTS=$P(X,U,3)
S ECXA=$P(X,U),(ECXADT,ECXADMDT)=$P($P(X,U,4),"."),ECXDCDT=$P($P(X,U,6),".")
S ECXWPRV=$P(X,U,7),ECXATT=$P(X,U,8)
S ECWPRNPI=$$NPI^XUSNPI("Individual_ID",ECXWPRV,ECXDATE)
S:+ECWPRNPI'>0 ECWPRNPI="" S ECWPRNPI=$P(ECWPRNPI,U)
S ECATTNPI=$$NPI^XUSNPI("Individual_ID",ECXATT,ECXDATE)
S:+ECATTNPI'>0 ECATTNPI="" S ECATTNPI=$P(ECATTNPI,U)
;Get ward provider and attending phy person classes
S ECXWPRPC=$P(X,U,11),ECXATTPC=$P(X,U,12)
I ECXADMDT S ECXADMDT=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)
I ECXDCDT S ECXDCDT=$$ECXDATE^ECXUTL(ECXDCDT,ECXYM)
Q
;
PROV(ECXPRV,ECXDATE) ;get provider data
N INST,DGIEN,ARR,DIC,DR,DA,DIQ
S ECXPRCLS=$$PRVCLASS^ECXUTL(ECXPRV,ECXDATE)
S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPRV,ECXDATE)
S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U)
;get division identifier using provider
S (ECXDIV,ECXPDIV)=""
S IEN=0 F D Q:'IEN Q:'INST Q:ECXDIV
.;get pointer to file #4 from provider record
.I '$D(^VA(200,ECXPRV,0)) Q
.S IEN=$O(^VA(200,ECXPRV,2,IEN))
.Q:'IEN
.S DIC="^VA(200,",DR="16",DA=ECXPRV
.S DR(200.02)=".01",DA(200.02)=IEN,DIQ="ARR",DIQ(0)="I"
.D EN^DIQ1
.S INST=$G(ARR(200.02,IEN,.01,"I"))
.Q:'INST
.;get production division
.S ECXPDIV=$$RADDIV^ECXDEPT(INST) ;p-46 line added
.;get medical center division
.S DGIEN=$O(^DG(40.8,"AD",INST,0)) I DGIEN D
..S ECXDIV=$P($G(^ECX(727.3,DGIEN,0)),U,2)
S ECXPRV="2"_ECXPRV
Q
;
FILE ;file record in #727.812
;node0
;facility^dfn^ssn ECXSSN^name ECXPNM^i/o status ECXA^
;day ECXDATE^division ECXDIV^admit date ECXADMDT^
;d/c date ECXDCDT^dss id ECXDSSI^pc team ECPTTM^pc provider ECPTPR^
;placeholder^pc prov person class ECCLAS^
;provider ECXPRV^placeholder^prov person class ECXPRCLS^
;test name ECXSCNAM(?)^test ien ECXSCNUM(?)^scale number^scale name^
;test score^scale score^attend phys^ward provider
;node1
;mpi^assoc pc provider^placeholder^
;assoc pc prov person class^asi class^asi special^asi encounter date^
;purple heart ind.^dom prrtp & saartp ind.^enrollment cat^
;enrollment stat^enrollment prior^period of serv.^obs. pat ind.^
;encounter num^agent orange loc^dob^production division^dss
;department ECXDEPT^head & neck canc. indi.^ethnicity^race1^^
;enrollment prior ECXPRIOR_enrollment subgroup
;ECXSBGRP^enrollee user ECXUESTA^division ECXDIV^patient type
;ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^
;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI
;attending phy person class ECXATTPC^ward provider person class
;ECXWPRPC^^agent orange status ECXAST^asso prov npi ECASNPI^att phy
;npi ECATTNPI^primary care prov npi ECPTNPI^provider npi ECPRNPI^ward
;provider npi ECWPRNPI
N DA,DIK,STR
I $P(^ECX(ECFILE,JJ,0),U,21)="ASI" S $P(^ECX(ECFILE,JJ,1),U,7)=ECXDATE
S $P(^ECX(ECFILE,JJ,0),U,6,9)=ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE
S STR=$S(ECXLOGIC<2005:ECXDIV,1:"")_U_ECXADMDT_U_ECXDCDT_U_ECXDSSI_U_ECPTTM_U_ECPTPR_U
S STR=STR_U_ECCLAS,$P(^ECX(ECFILE,JJ,0),U,10,17)=STR,STR=""
S $P(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_U_ECXPRCLS
S $P(^ECX(ECFILE,JJ,0),U,23,24)=ECXSCNUM_U_ECXSCNAM
S $P(^ECX(ECFILE,JJ,0),U,27,29)=ECXATT_U_ECXWPRV_U
I '$D(^ECX(ECFILE,JJ,1)) S ^ECX(727.812,JJ,1)="^^^^^"
S $P(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_U_ECCLAS2
S STR=ECXPHI_U_ECXDOM_U_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U
S STR=STR_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXDOB_U_ECXPDIV_U_ECXDEPT_U
S STR=STR_ECXHNCI_U_ECXETH_U_ECXRC1_U
I ECXLOGIC>2004 S STR=STR_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXDIV_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
I ECXLOGIC>2005 S STR=STR_U_ECXATTPC_U_ECXWPRPC
S $P(^ECX(ECFILE,JJ,1),U,8,22)=STR
I ECXLOGIC>2006 S $P(^ECX(ECFILE,JJ,1),U,34)=ECXAST_U
I ECXLOGIC>2007 S $P(^ECX(ECFILE,JJ,1),U,35)=ECASNPI_U_ECATTNPI_U_ECPTNPI_U D
. S ^ECX(ECFILE,JJ,2)=ECPRNPI_U_ECWPRNPI
S DA=JJ,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
S ECRN=ECRN+1
I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
Q
;
SETUP ;Set required input for ECXTRAC
S ECHEAD="MTL"
D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
Q
;
QUE ;Entry point for the background requeuing handled by ECXTAUTO.
D SETUP,QUE^ECXTAUTO,^ECXKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXMTL 7265 printed Nov 22, 2024@17:03:14 Page 2
ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 8/17/07 9:52am
+1 ;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92,105,120,127**;Dec 22, 1997;Build 36
+2 ;
BEG ;entry point from option
+1 DO SETUP
IF ECFILE=""
QUIT
+2 DO ^ECXTRAC
DO ^ECXKILL
+3 QUIT
+4 ;
START ;entry point from tasked job
+1 SET QFLG=0
+2 ;get first record #
+3 SET EC7=$ORDER(^ECX(ECFILE,999999999),-1)
+4 ;call mh/dss api for extract record creation
+5 ;variables ecfile,ecxym,ecinst,ecsd,eced passed in by taskmanager
+6 SET ECXSEQ=EC7
SET ECXECX=$PIECE(EC23,U,2)
SET ECXERR=0
+7 ;call mh api to create extract records
+8 SET X="YSDSS"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET QFLG=1
QUIT
+9 DO UPD^YSDSS(ECFILE,.ECXSEQ,ECXYM,ECXECX,ECINST,ECSD,ECED,.ECXERR)
+10 if ECXERR
QUIT
+11 if QFLG
QUIT
+12 ;if no error, continue
+13 DO UPDATE
+14 QUIT
+15 ;
UPDATE ;add non-mh data to each record created by mh api
+1 NEW ECXADT,JJ,ECXNPRFI
+2 SET EC7=EC7+1
+3 FOR JJ=EC7:1:ECXSEQ
if QFLG
QUIT
Begin DoDot:1
+4 if '$DATA(^ECX(ECFILE,JJ,0))
QUIT
+5 SET ECXDFN=$PIECE(^ECX(ECFILE,JJ,0),U,5)
SET ECXDATE=$PIECE(^ECX(ECFILE,JJ,0),U,9)
SET ECXPRV=$PIECE(^ECX(ECFILE,JJ,0),U,18)
+6 SET ECXSCNUM=$PIECE(^ECX(ECFILE,JJ,0),U,23)
SET ECXSCNAM=$PIECE(^ECX(ECFILE,JJ,0),U,24)
+7 DO PAT(ECXDFN,ECXDATE)
+8 SET (ECXPRCLS,ECPRNPI,ECXDIV,ECXPDIV)=""
IF ECXPRV
DO PROV(.ECXPRV,ECXDATE)
+9 SET ECXDSSI=""
+10 IF ECXLOGIC>2003
Begin DoDot:2
+11 IF "^18^23^24^41^65^94^108^"[("^"_ECXTS_"^")
SET ECXDSSI=$$TSMAP^ECXUTL4(ECXTS)
End DoDot:2
+12 ;
+13 ;- Observation patient indicator (YES/NO)
+14 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXDSSI)
+15 ;
+16 ;- set national patient record flag if exist
+17 DO NPRF^ECXUTL5
+18 ;
+19 ;- If no encounter number don't file record
+20 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,)
if ECXENC=""
QUIT
+21 SET ECD=ECXDATE
SET ECXDATE=$$ECXDATE^ECXUTL(ECXDATE,ECXYM)
+22 ;adjust scale name & scale number
+23 SET ECXSCNAM=$EXTRACT(ECXSCNAM,1,10)
+24 IF ECXSCNUM]""
IF ECXSCNUM'=+ECXSCNUM
SET ECXSCNUM=+$EXTRACT(ECXSCNUM,2,99)
+25 ;dss department use postponed S ECXDEPT=$$MTL^ECXDEPT(ECXDIV,ECXSCNAM,ECINST) ;p-46 line added
NEW ECXDEPT
SET ECXDEPT=""
+26 ;Set division to external value if extract is for FY05 or higher
+27 DO FILE
End DoDot:1
+28 QUIT
+29 ;
PAT(ECXDFN,ECXDATE) ;determine in/outpatient status, demographics, primary care
+1 NEW OK
+2 SET (ECXADT,ECXPNM,ECXSSN,ECXMPI)=""
+3 KILL ECXPAT
SET OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;3;5;",.ECXPAT)
+4 SET ECXPNM=ECXPAT("NAME")
SET ECXSSN=ECXPAT("SSN")
SET ECXMPI=ECXPAT("MPI")
+5 SET ECXDOB=ECXPAT("DOB")
+6 ;agent orange status
+7 SET ECXAST=ECXPAT("AO STAT")
+8 ;- Purple Heart Indicator, Period of Service, Agent Orange Location
+9 SET ECXPHI=$GET(ECXPAT("PHI"))
SET ECXPOS=ECXPAT("POS")
SET ECXAOL=ECXPAT("AOL")
+10 IF $$ENROLLM^ECXUTL2(ECXDFN)
+11 ;Combat Veteran Status
+12 SET X3=$$CVEDT^ECXUTL5(ECXDFN,$SELECT($GET(ECD):ECD,$GET(ECXDATE):ECXDATE,1:DT))
+13 ; - Head and Neck Cancer Indicator
+14 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
+15 ; - Race and Ethnicity
+16 SET ECXETH=ECXPAT("ETHNIC")
+17 SET ECXRC1=ECXPAT("RACE1")
+18 ;get primary care data
+19 SET X=$$PRIMARY^ECXUTL2(ECXDFN,ECXDATE)
SET ECPTTM=$PIECE(X,U)
+20 SET ECPTPR=$PIECE(X,U,2)
SET ECCLAS=$PIECE(X,U,3)
SET ECPTNPI=$PIECE(X,U,4)
+21 SET ECASPR=$PIECE(X,U,5)
SET ECCLAS2=$PIECE(X,U,6)
SET ECASNPI=$PIECE(X,U,7)
+22 ;get inpatient data
+23 SET X=$$INP^ECXUTL2(ECXDFN,ECXDATE)
SET ECXDOM=$PIECE(X,U,10)
SET ECXTS=$PIECE(X,U,3)
+24 SET ECXA=$PIECE(X,U)
SET (ECXADT,ECXADMDT)=$PIECE($PIECE(X,U,4),".")
SET ECXDCDT=$PIECE($PIECE(X,U,6),".")
+25 SET ECXWPRV=$PIECE(X,U,7)
SET ECXATT=$PIECE(X,U,8)
+26 SET ECWPRNPI=$$NPI^XUSNPI("Individual_ID",ECXWPRV,ECXDATE)
+27 if +ECWPRNPI'>0
SET ECWPRNPI=""
SET ECWPRNPI=$PIECE(ECWPRNPI,U)
+28 SET ECATTNPI=$$NPI^XUSNPI("Individual_ID",ECXATT,ECXDATE)
+29 if +ECATTNPI'>0
SET ECATTNPI=""
SET ECATTNPI=$PIECE(ECATTNPI,U)
+30 ;Get ward provider and attending phy person classes
+31 SET ECXWPRPC=$PIECE(X,U,11)
SET ECXATTPC=$PIECE(X,U,12)
+32 IF ECXADMDT
SET ECXADMDT=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)
+33 IF ECXDCDT
SET ECXDCDT=$$ECXDATE^ECXUTL(ECXDCDT,ECXYM)
+34 QUIT
+35 ;
PROV(ECXPRV,ECXDATE) ;get provider data
+1 NEW INST,DGIEN,ARR,DIC,DR,DA,DIQ
+2 SET ECXPRCLS=$$PRVCLASS^ECXUTL(ECXPRV,ECXDATE)
+3 SET ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPRV,ECXDATE)
+4 if +ECPRNPI'>0
SET ECPRNPI=""
SET ECPRNPI=$PIECE(ECPRNPI,U)
+5 ;get division identifier using provider
+6 SET (ECXDIV,ECXPDIV)=""
+7 SET IEN=0
FOR
Begin DoDot:1
+8 ;get pointer to file #4 from provider record
+9 IF '$DATA(^VA(200,ECXPRV,0))
QUIT
+10 SET IEN=$ORDER(^VA(200,ECXPRV,2,IEN))
+11 if 'IEN
QUIT
+12 SET DIC="^VA(200,"
SET DR="16"
SET DA=ECXPRV
+13 SET DR(200.02)=".01"
SET DA(200.02)=IEN
SET DIQ="ARR"
SET DIQ(0)="I"
+14 DO EN^DIQ1
+15 SET INST=$GET(ARR(200.02,IEN,.01,"I"))
+16 if 'INST
QUIT
+17 ;get production division
+18 ;p-46 line added
SET ECXPDIV=$$RADDIV^ECXDEPT(INST)
+19 ;get medical center division
+20 SET DGIEN=$ORDER(^DG(40.8,"AD",INST,0))
IF DGIEN
Begin DoDot:2
+21 SET ECXDIV=$PIECE($GET(^ECX(727.3,DGIEN,0)),U,2)
End DoDot:2
End DoDot:1
if 'IEN
QUIT
if 'INST
QUIT
if ECXDIV
QUIT
+22 SET ECXPRV="2"_ECXPRV
+23 QUIT
+24 ;
FILE ;file record in #727.812
+1 ;node0
+2 ;facility^dfn^ssn ECXSSN^name ECXPNM^i/o status ECXA^
+3 ;day ECXDATE^division ECXDIV^admit date ECXADMDT^
+4 ;d/c date ECXDCDT^dss id ECXDSSI^pc team ECPTTM^pc provider ECPTPR^
+5 ;placeholder^pc prov person class ECCLAS^
+6 ;provider ECXPRV^placeholder^prov person class ECXPRCLS^
+7 ;test name ECXSCNAM(?)^test ien ECXSCNUM(?)^scale number^scale name^
+8 ;test score^scale score^attend phys^ward provider
+9 ;node1
+10 ;mpi^assoc pc provider^placeholder^
+11 ;assoc pc prov person class^asi class^asi special^asi encounter date^
+12 ;purple heart ind.^dom prrtp & saartp ind.^enrollment cat^
+13 ;enrollment stat^enrollment prior^period of serv.^obs. pat ind.^
+14 ;encounter num^agent orange loc^dob^production division^dss
+15 ;department ECXDEPT^head & neck canc. indi.^ethnicity^race1^^
+16 ;enrollment prior ECXPRIOR_enrollment subgroup
+17 ;ECXSBGRP^enrollee user ECXUESTA^division ECXDIV^patient type
+18 ;ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^
+19 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI
+20 ;attending phy person class ECXATTPC^ward provider person class
+21 ;ECXWPRPC^^agent orange status ECXAST^asso prov npi ECASNPI^att phy
+22 ;npi ECATTNPI^primary care prov npi ECPTNPI^provider npi ECPRNPI^ward
+23 ;provider npi ECWPRNPI
+24 NEW DA,DIK,STR
+25 IF $PIECE(^ECX(ECFILE,JJ,0),U,21)="ASI"
SET $PIECE(^ECX(ECFILE,JJ,1),U,7)=ECXDATE
+26 SET $PIECE(^ECX(ECFILE,JJ,0),U,6,9)=ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE
+27 SET STR=$SELECT(ECXLOGIC<2005:ECXDIV,1:"")_U_ECXADMDT_U_ECXDCDT_U_ECXDSSI_U_ECPTTM_U_ECPTPR_U
+28 SET STR=STR_U_ECCLAS
SET $PIECE(^ECX(ECFILE,JJ,0),U,10,17)=STR
SET STR=""
+29 SET $PIECE(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_U_ECXPRCLS
+30 SET $PIECE(^ECX(ECFILE,JJ,0),U,23,24)=ECXSCNUM_U_ECXSCNAM
+31 SET $PIECE(^ECX(ECFILE,JJ,0),U,27,29)=ECXATT_U_ECXWPRV_U
+32 IF '$DATA(^ECX(ECFILE,JJ,1))
SET ^ECX(727.812,JJ,1)="^^^^^"
+33 SET $PIECE(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_U_ECCLAS2
+34 SET STR=ECXPHI_U_ECXDOM_U_ECXCAT_U_ECXSTAT_U_$SELECT(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U
+35 SET STR=STR_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXDOB_U_ECXPDIV_U_ECXDEPT_U
+36 SET STR=STR_ECXHNCI_U_ECXETH_U_ECXRC1_U
+37 IF ECXLOGIC>2004
SET STR=STR_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXDIV_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
+38 IF ECXLOGIC>2005
SET STR=STR_U_ECXATTPC_U_ECXWPRPC
+39 SET $PIECE(^ECX(ECFILE,JJ,1),U,8,22)=STR
+40 IF ECXLOGIC>2006
SET $PIECE(^ECX(ECFILE,JJ,1),U,34)=ECXAST_U
+41 IF ECXLOGIC>2007
SET $PIECE(^ECX(ECFILE,JJ,1),U,35)=ECASNPI_U_ECATTNPI_U_ECPTNPI_U
Begin DoDot:1
+42 SET ^ECX(ECFILE,JJ,2)=ECPRNPI_U_ECWPRNPI
End DoDot:1
+43 SET DA=JJ
SET DIK="^ECX("_ECFILE_","
DO IX1^DIK
KILL DIK,DA
+44 SET ECRN=ECRN+1
+45 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET QFLG=1
+46 QUIT
+47 ;
SETUP ;Set required input for ECXTRAC
+1 SET ECHEAD="MTL"
+2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
+3 QUIT
+4 ;
QUE ;Entry point for the background requeuing handled by ECXTAUTO.
+1 DO SETUP
DO QUE^ECXTAUTO
DO ^ECXKILL
+2 QUIT