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  Sep 23, 2025@19:29:08                                                                                                                                                                                                      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