- ECXPRO ;ALB/GTS - Prosthetics Extract for DSS ;2/27/19 15:42
- ;;3.0;DSS EXTRACTS;**9,13,15,21,24,33,39,46,71,92,105,120,127,132,136,144,149,154,161,166,169,170,174,184**;Dec 22, 1997;Build 124
- BEG ;entry point from option
- D SETUP I ECFILE="" Q
- D:+ECINST>0 ^ECXTRAC D ^ECXKILL
- Q
- ;
- START ;start package specific extract
- ;
- ; Input
- ; ECSD1 - FM formatted Beginning Date (Set by ECXTRAC)
- ; ECED - FM formatted End Date (Set by ECXTRAC)
- ; ECSDN - Externally formatted Start Date (Set by ECXTRAC)
- ; ECEDN - Externally formatted End Date (Set by ECXTRAC)
- ; EC - IEN from file #727 (Set by ECXTRAC)
- ; ECXYM - Year and Month of extract (YYYYMM)
- ; ECXINST - IEN for division in file #4
- ; ECINST - Station number of selected division
- ;
- N ECXLNE,ECXCT,ECXDACT,ECX0,ECXLB,ECXED1,ECINSTSV,ECXLNSTR,ECXP
- N ECXICD10P,ECXICD101,ECXICD102,ECXICD103,ECXICD104
- N DIC,DR,DA,DIQ,CPTCODE,ECXNPRFI
- N ECXESC,ECXCLST,ECXECL,ECXUI,ECXASIH ;144,166,170
- N ECXNCOST,ECXNLLC,ECXNLMC ;174
- N ECXNMPI,EXSIGI ;184
- D ECXBUL^ECXPRO2(.ECXLNE,ECSDN,ECEDN,EC)
- S QFLG=0,ECXLNSTR=ECXLNE,ECXED1=ECED+.9999,ECXCT=ECSD1
- F S ECXCT=$O(^RMPR(660,"CT",ECXCT)) Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1) D
- .S ECXDACT=0
- .F S ECXDACT=$O(^RMPR(660,"CT",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1) D
- ..;* initialize variables
- ..S (ECXDFN,ECXPNM,ECXSSN,ECXSEX,ECXSTAT,ECXDATE,ECXTYPE,ECXSRCE)=""
- ..S (ECXHCPCS,ECXPHCPC,ECXRQST,ECXRCST,ECXFORM,ECXCTAMT,ECXLLC)=""
- ..S (ECXLMC,ECXGRPR,ECXBILST,ECXQTY,ECXFELOC,ECXFEKEY,ECXA,ECXLH,ECXLC,ECXMC)=""
- ..S (ECPTTM,ECPTPR,ECXAST,ECXRST,ECXEST,ECXELIG,ECXVET,ECXZIP,ECXVNS,ECXCLST)="" ;144
- ..S (ECXDOB,ECXDSSD,ECXICD9,ECXICD10P,ECXAOL,ECXHNCI,ECXSHADI,ECXETH,ECXRC1,ECXMST)=""
- ..S (ECXNCOST,ECXNLLC,ECXNLMC)="" ;174
- ..F I=1:1:4 S @("ECXICD9"_I)=""
- ..F I=1:1:4 S @("ECXICD10"_I)=""
- ..Q:'$D(^RMPR(660,ECXDACT,0))
- ..S ECX0=^RMPR(660,ECXDACT,0),ECXLB=$G(^RMPR(660,ECXDACT,"LB"))
- ..K ECXP S DIC="^RMPR(660,",DR=".02;11;45",DA=ECXDACT,DIQ(0)="EI"
- ..S DIQ="ECXP" D EN^DIQ1
- ..S ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
- ..S ECXDFN=$G(ECXP(660,ECXDACT,.02,"I"))
- ..S ECXFORM=$G(ECXP(660,ECXDACT,11,"E"))_U_$G(ECXP(660,ECXDACT,11,"I"))
- ..S ECXLH=$G(ECXP(660,ECXDACT,45,"I"))
- ..S ECXUI=$$GET1^DIQ(660,ECXDACT,78) ;166 get unit of issue
- ..Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXCT)
- ..S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)
- ..I 'OK S ECXERR=1 K ECXPAT Q
- ..;OEF/OIF data
- ..S ECXOEF=ECXPAT("ECXOEF")
- ..S ECXOEFDT=ECXPAT("ECXOEFDT")
- ..S ECXVNS=ECXPAT("VIETNAM") ; 144 VIETNAM STATUS
- ..S ECXCLST=ECXPAT("CL STAT") ;144 Camp Lejeune Status
- ..S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND
- ..S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC
- ..S ECXNMPI=ECXPAT("MPI") ;184
- ..S ECXSIGI=ECXPAT("SIGI") ;184
- ..Q:'$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,ECXFORM)
- ..D PROSINFO^ECXPRO1(ECXDACT,ECXLB,ECX0,ECXFORM)
- ..S CPTCODE=$E(ECXHCPCS,1,5)
- ..;nppd entry date
- ..S ECXNPPDT=$$ECXDATE^ECXUTL($P(ECX0,U,1),ECXYM)
- ..;
- ..;Get production division ;p-46
- ..N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;p-46
- ..;- Observation patient indicator (YES/NO)
- ..S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
- ..;
- ..;- CNH status (YES/NO)
- ..S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN)
- ..;
- ..;get encounter classifications
- ..S (ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR,ECXSHAD,ECXESC,ECXECL)="" ;144
- ..S ECXVISIT=$$GET1^DIQ(660,ECXDACT,8.12,"I") I ECXVISIT'="" D
- ...D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q
- ...S ECXAO=$G(ECXVIST("AO")),ECXECE=$G(ECXVIST("PGE")),ECXSHAD=$G(ECXVIST("SHAD"))
- ...S ECXHNC=$G(ECXVIST("HNC")),ECXMIL=$G(ECXVIST("MST")),ECXIR=$G(ECXVIST("IR"))
- ...S ECXESC=ECXVIST("ENCSC"),ECXECL=ECXVIST("ENCCL") ;144
- ..; - Head and Neck Cancer Indicator
- ..S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
- ..;
- ..; - Proj 112/SHAD Indicator
- ..S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
- ..;
- ..; ******* - PATCH 127, ADD PATCAT CODE ********
- ..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
- ..; - set national patient record flag if exist
- ..D NPRF^ECXUTL5
- ..;
- ..;- If no encounter number don't file record
- ..S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,) Q:ECXENC=""
- ..I $G(ECXASIH) S ECXA="A" ;170
- ..I ECXFORM["-3" F ECXLAB="LAB","ORD" D
- ...S ECINSTSV=ECXRQST I ECINSTSV="" S ECINSTSV=ECXPDIV ;166,169 tjl
- ...D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
- ...Q:ECXFELOC="" D FILE
- ..I ECXFORM'["-3" S ECXLAB="NONL" D
- ...S ECINSTSV=ECXSTAT2 I ECINSTSV="" S ECINSTSV=ECXPDIV ;166,169 tjl
- ...D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
- ...Q:ECXFELOC="" D FILE
- ;* Send the Exception message
- I ECXLNSTR<ECXLNE DO
- .K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
- .S XMDUZ=.5
- .S XMSUB=ECINST_" - Prosthetics DSS Exception Message",XMN=0
- .S XMTEXT="^TMP(""ECX-PRO EXC"",$J,"
- .D ^XMD
- K ^TMP("ECX-PRO EXC",$J),XMDUZ,XMSUB,XMTEXT,XMY,XMN
- Q
- ;
- FILE ;file extract record
- ;node0
- ;facility^dfn (ECXDFN)^ssn (ECXSSN)^name (ECXPNM)^in/out (ECXA)^
- ;day^feeder location^
- ;feeder key^qty^Placehold pc team^Placehold pc provider^hcpcs^Placeholder (ECXICD9)^
- ;Placeholder (ECXICD91)^Placeholder (ECXICD92)^Placeholder (ECXICD93)^
- ;Placeholder (ECXICD94)^agent orange^radiation^env contam^eligibility^
- ;PLACEHOLD cost^PLACEHOLD lab labor cost^PLACEHOLD lab matl cost^billing status^
- ;vet^transaction type^req station^rec station^file#661.1 ien
- ;node1
- ;zip^dob^sex^amis grouper^placeholder^mpi^placeholder ECXDSSD^
- ;Placehold pc prov person class^race^pow status^pow loc^
- ;PLACEHOLD sharing agree payor^PLACEHOLD sharing agree ins^mst status^
- ;enroll loc^state^county^Placehold assoc pc provider^
- ;Placehold assoc pc prov person class^placeholder
- ;dom (ECXDOM)^purple heart indicator (ECXPHI)^
- ;enrollment Category (ECXCAT)^enrollment status (ECXSTAT)^
- ;enrollment priority (ECXPRIOR)^purple heart ind (ECXPHI)^
- ;period of serv (ECXPOS)^observ pat ind (ECXOBS)^encounter num (ECXENC)^
- ;ao loc (ECXAOL)^CNH status (ECXCNH)^production division ECXPDIV^
- ;head & neck canc. ind. (ECXHNCI)^Placehold ethnicity (ECXETH)^Placehold race1 (ECXRC1)^
- ;PLACEHOLD DSS IP #^enrollment priority (ECXPRIOR)_enrollment sub-
- ;group (ECXSBGRP)^user enrollee (ECXUESTA)^patient type ECXPTYPE
- ;^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^PLACEHOLD enc cv
- ;eligible ECXCVENC^national patient record flag ECXNPRFI^
- ;emergency response indicator(FEMA) ECXERI^PLACEHOLD agent orange indicator ECXAO
- ;^PLACEHOLD environ contam ECXECE^PLACEHOLD head/neck cancer ECXHNC^PLACEHOLD encntr mst ECXMIL^
- ;PLACEHOLD radiation ECXIR
- ;NODE2
- ;OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^
- ;nppd code ECXNPPDC^nppd entry date ECXNPPDT
- ;Placehold assoc pc provider npi ECASNPI^Placehold primary care provider npi ECPTNPI^
- ;country ECXCNTRY^shad indicator ECXSHADI^PLACEHOLD shad encounter ECXSHAD^
- ;labor hours ECXLH^
- ;PATCAT^EXCPATCAT^
- ;primary ICD-10 code (currently null)ECXICD10P^Secondary ICD-10 Code #1 (currently null)ECXICD101^
- ;Secondary ICD-10 Code #2 (currently null)ECXICD102^Secondary ICD-10 Code #3 (currently null)ECXICD103^
- ;Secondary ICD-10 Code #4 (currently null)ECXICD104^PLACEHOLD Encounter SC ECXEXC^Vietnam Status ECXVNS^Camp Lejeune Status ECXCLST^PLACEHOLD Encounter Camp Lejeune ECXECL^
- ;Combat Service Indicator (ECXSVCI)^Combat Service Location (ECXSVCL)^
- ;Form Requested On (ECXFORM)^Unit of Issue (ECXUI)
- ;New Cost of Transaction (ECXNCOST)^New Lab Labor Cost (ECXNLLC)^New Lab Material Cost (ECXNLMC)^ ;174
- ;New MPI (ECXNMPI)^Self Idenfied Gender (ECXSIGI) ;184
- N DA,DIK
- S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
- I ECXLOGIC>2018 S (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)="" ;170 Fields will now be null
- I ECXLOGIC>2019 D ;174 Section added for FY20 updates
- .I $G(ECXTYPE)=5,$G(ECXUI)="MO" S ECXUI="DY",ECXQTY=$$RJ^XLFSTR(+$G(ECXQTY)*30,8,0) ;If item is a monthly rental, convert unit of issue to days and quantity to 30 times the original
- .S (ECXCTAMT,ECXLLC,ECXLMC,ECXCVENC,ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR,ECXSHAD,ECXESC,ECXECL)=""
- S ECODE=EC7_U_EC23_U_ECINSTSV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U ;169 tjl
- S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXFELOC_U
- S ECODE=ECODE_ECXFEKEY_U_ECXQTY_U_ECPTTM_U_ECPTPR_U_ECXHCPCS_U
- S ECODE=ECODE_ECXICD9_U_ECXICD91_U_ECXICD92_U_ECXICD93_U_ECXICD94_U
- S ECODE=ECODE_ECXAST_U_ECXRST_U_ECXEST_U_ECXELIG_U_ECXCTAMT_U_ECXLLC_U
- S ECODE=ECODE_ECXLMC_U_ECXBILST_U_ECXVET_U_ECXTYPE_U_ECXRQST_U_ECXRCST_U
- S ECODE=ECODE_ECXPHCPC_U
- I ECXLOGIC>2022 S ECXMPI="" ;184 - Field retired: MPI
- S ECODE1=ECXZIP_U_ECXDOB_U_ECXSEX_U_ECXGRPR_U_U_ECXMPI_U
- S ECODE1=ECODE1_ECXDSSD_U_ECCLAS_U_ECXRACE_U_ECXPST_U_ECXPLOC_U
- S ECODE1=ECODE1_U_U_ECXMST_U_ECXENRL_U_ECXSTATE_U
- S ECODE1=ECODE1_ECXCNTY_U_ECASPR_U_ECCLAS2_U_U_ECXDOM_U
- S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U
- S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXCNH_U_ECXPDIV_U
- S ECODE1=ECODE1_ECXHNCI_U_ECXETH_U_ECXRC1_U
- I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U
- I ECXLOGIC>2007 S ECODE2=ECXOEF_U_ECXOEFDT_U_ECXNPPDC_U_ECXNPPDT_U_ECASNPI_U_ECPTNPI
- I ECXLOGIC>2009 S ECODE2=ECODE2_U_ECXCNTRY
- I ECXLOGIC>2010 S ECODE2=ECODE2_U_ECXSHADI_U_ECXSHAD_U_ECXLH_U_ECXPATCAT
- I ECXLOGIC>2012 S ECODE2=ECODE2_U_ECXICD10P_U_ECXICD101_U_ECXICD102_U_ECXICD103_U_ECXICD104
- I ECXLOGIC>2013 S ECODE2=ECODE2_U_ECXESC_U_ECXVNS_U_ECXCLST_U_ECXECL ;144
- I ECXLOGIC>2014 S ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL ;149
- I ECXLOGIC>2015 S ECODE2=ECODE2_U_$P(ECXFORM,U,2) ;154
- I ECXLOGIC>2017 S ECODE2=ECODE2_U_$G(ECXUI) ;166
- I ECXLOGIC>2019 S ECODE2=ECODE2_U_ECXNCOST_U_ECXNLLC_U_ECXNLMC ;174
- I ECXLOGIC>2022 S ECODE2=ECODE2_U_ECXNMPI_U_ECXSIGI ;184
- S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1
- S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
- I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
- Q
- ;
- SETUP ;Set required input for ECXTRAC
- S ECHEAD="PRO"
- D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
- S ECINST=$$PDIV^ECXPUTL
- Q
- ;
- ;**Note: LOCAL and QUE are carry over from protocols set by other
- ; routines.
- LOCAL ;to extract nightly for local use not to be transmitted to TSI
- ;QUEUE with 1D frequency
- D SETUP,^ECXTLOCL,^ECXKILL 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[HECXPRO 10739 printed Jan 18, 2025@02:54:44 Page 2
- ECXPRO ;ALB/GTS - Prosthetics Extract for DSS ;2/27/19 15:42
- +1 ;;3.0;DSS EXTRACTS;**9,13,15,21,24,33,39,46,71,92,105,120,127,132,136,144,149,154,161,166,169,170,174,184**;Dec 22, 1997;Build 124
- BEG ;entry point from option
- +1 DO SETUP
- IF ECFILE=""
- QUIT
- +2 if +ECINST>0
- DO ^ECXTRAC
- DO ^ECXKILL
- +3 QUIT
- +4 ;
- START ;start package specific extract
- +1 ;
- +2 ; Input
- +3 ; ECSD1 - FM formatted Beginning Date (Set by ECXTRAC)
- +4 ; ECED - FM formatted End Date (Set by ECXTRAC)
- +5 ; ECSDN - Externally formatted Start Date (Set by ECXTRAC)
- +6 ; ECEDN - Externally formatted End Date (Set by ECXTRAC)
- +7 ; EC - IEN from file #727 (Set by ECXTRAC)
- +8 ; ECXYM - Year and Month of extract (YYYYMM)
- +9 ; ECXINST - IEN for division in file #4
- +10 ; ECINST - Station number of selected division
- +11 ;
- +12 NEW ECXLNE,ECXCT,ECXDACT,ECX0,ECXLB,ECXED1,ECINSTSV,ECXLNSTR,ECXP
- +13 NEW ECXICD10P,ECXICD101,ECXICD102,ECXICD103,ECXICD104
- +14 NEW DIC,DR,DA,DIQ,CPTCODE,ECXNPRFI
- +15 ;144,166,170
- NEW ECXESC,ECXCLST,ECXECL,ECXUI,ECXASIH
- +16 ;174
- NEW ECXNCOST,ECXNLLC,ECXNLMC
- +17 ;184
- NEW ECXNMPI,EXSIGI
- +18 DO ECXBUL^ECXPRO2(.ECXLNE,ECSDN,ECEDN,EC)
- +19 SET QFLG=0
- SET ECXLNSTR=ECXLNE
- SET ECXED1=ECED+.9999
- SET ECXCT=ECSD1
- +20 FOR
- SET ECXCT=$ORDER(^RMPR(660,"CT",ECXCT))
- if (ECXCT>ECXED1)!('ECXCT)!(QFLG=1)
- QUIT
- Begin DoDot:1
- +21 SET ECXDACT=0
- +22 FOR
- SET ECXDACT=$ORDER(^RMPR(660,"CT",ECXCT,ECXDACT))
- if ('ECXDACT)!(QFLG=1)
- QUIT
- Begin DoDot:2
- +23 ;* initialize variables
- +24 SET (ECXDFN,ECXPNM,ECXSSN,ECXSEX,ECXSTAT,ECXDATE,ECXTYPE,ECXSRCE)=""
- +25 SET (ECXHCPCS,ECXPHCPC,ECXRQST,ECXRCST,ECXFORM,ECXCTAMT,ECXLLC)=""
- +26 SET (ECXLMC,ECXGRPR,ECXBILST,ECXQTY,ECXFELOC,ECXFEKEY,ECXA,ECXLH,ECXLC,ECXMC)=""
- +27 ;144
- SET (ECPTTM,ECPTPR,ECXAST,ECXRST,ECXEST,ECXELIG,ECXVET,ECXZIP,ECXVNS,ECXCLST)=""
- +28 SET (ECXDOB,ECXDSSD,ECXICD9,ECXICD10P,ECXAOL,ECXHNCI,ECXSHADI,ECXETH,ECXRC1,ECXMST)=""
- +29 ;174
- SET (ECXNCOST,ECXNLLC,ECXNLMC)=""
- +30 FOR I=1:1:4
- SET @("ECXICD9"_I)=""
- +31 FOR I=1:1:4
- SET @("ECXICD10"_I)=""
- +32 if '$DATA(^RMPR(660,ECXDACT,0))
- QUIT
- +33 SET ECX0=^RMPR(660,ECXDACT,0)
- SET ECXLB=$GET(^RMPR(660,ECXDACT,"LB"))
- +34 KILL ECXP
- SET DIC="^RMPR(660,"
- SET DR=".02;11;45"
- SET DA=ECXDACT
- SET DIQ(0)="EI"
- +35 SET DIQ="ECXP"
- DO EN^DIQ1
- +36 SET ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
- +37 SET ECXDFN=$GET(ECXP(660,ECXDACT,.02,"I"))
- +38 SET ECXFORM=$GET(ECXP(660,ECXDACT,11,"E"))_U_$GET(ECXP(660,ECXDACT,11,"I"))
- +39 SET ECXLH=$GET(ECXP(660,ECXDACT,45,"I"))
- +40 ;166 get unit of issue
- SET ECXUI=$$GET1^DIQ(660,ECXDACT,78)
- +41 if '$$PATDEM^ECXUTL2(ECXDFN,ECXCT)
- QUIT
- +42 SET OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)
- +43 IF 'OK
- SET ECXERR=1
- KILL ECXPAT
- QUIT
- +44 ;OEF/OIF data
- +45 SET ECXOEF=ECXPAT("ECXOEF")
- +46 SET ECXOEFDT=ECXPAT("ECXOEFDT")
- +47 ; 144 VIETNAM STATUS
- SET ECXVNS=ECXPAT("VIETNAM")
- +48 ;144 Camp Lejeune Status
- SET ECXCLST=ECXPAT("CL STAT")
- +49 ;149 COMBAT SVC IND
- SET ECXSVCI=ECXPAT("COMBSVCI")
- +50 ;149 COMBAT SVC LOC
- SET ECXSVCL=ECXPAT("COMBSVCL")
- +51 ;184
- SET ECXNMPI=ECXPAT("MPI")
- +52 ;184
- SET ECXSIGI=ECXPAT("SIGI")
- +53 if '$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,ECXFORM)
- QUIT
- +54 DO PROSINFO^ECXPRO1(ECXDACT,ECXLB,ECX0,ECXFORM)
- +55 SET CPTCODE=$EXTRACT(ECXHCPCS,1,5)
- +56 ;nppd entry date
- +57 SET ECXNPPDT=$$ECXDATE^ECXUTL($PIECE(ECX0,U,1),ECXYM)
- +58 ;
- +59 ;Get production division ;p-46
- +60 ;p-46
- NEW ECXPDIV
- SET ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV)
- +61 ;- Observation patient indicator (YES/NO)
- +62 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
- +63 ;
- +64 ;- CNH status (YES/NO)
- +65 SET ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN)
- +66 ;
- +67 ;get encounter classifications
- +68 ;144
- SET (ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR,ECXSHAD,ECXESC,ECXECL)=""
- +69 SET ECXVISIT=$$GET1^DIQ(660,ECXDACT,8.12,"I")
- IF ECXVISIT'=""
- Begin DoDot:3
- +70 DO VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR)
- IF ECXERR
- KILL ECXERR
- QUIT
- +71 SET ECXAO=$GET(ECXVIST("AO"))
- SET ECXECE=$GET(ECXVIST("PGE"))
- SET ECXSHAD=$GET(ECXVIST("SHAD"))
- +72 SET ECXHNC=$GET(ECXVIST("HNC"))
- SET ECXMIL=$GET(ECXVIST("MST"))
- SET ECXIR=$GET(ECXVIST("IR"))
- +73 ;144
- SET ECXESC=ECXVIST("ENCSC")
- SET ECXECL=ECXVIST("ENCCL")
- End DoDot:3
- +74 ; - Head and Neck Cancer Indicator
- +75 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
- +76 ;
- +77 ; - Proj 112/SHAD Indicator
- +78 SET ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
- +79 ;
- +80 ; ******* - PATCH 127, ADD PATCAT CODE ********
- +81 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
- +82 ; - set national patient record flag if exist
- +83 DO NPRF^ECXUTL5
- +84 ;
- +85 ;- If no encounter number don't file record
- +86 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,)
- if ECXENC=""
- QUIT
- +87 ;170
- IF $GET(ECXASIH)
- SET ECXA="A"
- +88 IF ECXFORM["-3"
- FOR ECXLAB="LAB","ORD"
- Begin DoDot:3
- +89 ;166,169 tjl
- SET ECINSTSV=ECXRQST
- IF ECINSTSV=""
- SET ECINSTSV=ECXPDIV
- +90 DO FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
- +91 if ECXFELOC=""
- QUIT
- DO FILE
- End DoDot:3
- +92 IF ECXFORM'["-3"
- SET ECXLAB="NONL"
- Begin DoDot:3
- +93 ;166,169 tjl
- SET ECINSTSV=ECXSTAT2
- IF ECINSTSV=""
- SET ECINSTSV=ECXPDIV
- +94 DO FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
- +95 if ECXFELOC=""
- QUIT
- DO FILE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +96 ;* Send the Exception message
- +97 IF ECXLNSTR<ECXLNE
- Begin DoDot:1
- +98 KILL XMY
- SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
- +99 SET XMDUZ=.5
- +100 SET XMSUB=ECINST_" - Prosthetics DSS Exception Message"
- SET XMN=0
- +101 SET XMTEXT="^TMP(""ECX-PRO EXC"",$J,"
- +102 DO ^XMD
- End DoDot:1
- +103 KILL ^TMP("ECX-PRO EXC",$JOB),XMDUZ,XMSUB,XMTEXT,XMY,XMN
- +104 QUIT
- +105 ;
- FILE ;file extract record
- +1 ;node0
- +2 ;facility^dfn (ECXDFN)^ssn (ECXSSN)^name (ECXPNM)^in/out (ECXA)^
- +3 ;day^feeder location^
- +4 ;feeder key^qty^Placehold pc team^Placehold pc provider^hcpcs^Placeholder (ECXICD9)^
- +5 ;Placeholder (ECXICD91)^Placeholder (ECXICD92)^Placeholder (ECXICD93)^
- +6 ;Placeholder (ECXICD94)^agent orange^radiation^env contam^eligibility^
- +7 ;PLACEHOLD cost^PLACEHOLD lab labor cost^PLACEHOLD lab matl cost^billing status^
- +8 ;vet^transaction type^req station^rec station^file#661.1 ien
- +9 ;node1
- +10 ;zip^dob^sex^amis grouper^placeholder^mpi^placeholder ECXDSSD^
- +11 ;Placehold pc prov person class^race^pow status^pow loc^
- +12 ;PLACEHOLD sharing agree payor^PLACEHOLD sharing agree ins^mst status^
- +13 ;enroll loc^state^county^Placehold assoc pc provider^
- +14 ;Placehold assoc pc prov person class^placeholder
- +15 ;dom (ECXDOM)^purple heart indicator (ECXPHI)^
- +16 ;enrollment Category (ECXCAT)^enrollment status (ECXSTAT)^
- +17 ;enrollment priority (ECXPRIOR)^purple heart ind (ECXPHI)^
- +18 ;period of serv (ECXPOS)^observ pat ind (ECXOBS)^encounter num (ECXENC)^
- +19 ;ao loc (ECXAOL)^CNH status (ECXCNH)^production division ECXPDIV^
- +20 ;head & neck canc. ind. (ECXHNCI)^Placehold ethnicity (ECXETH)^Placehold race1 (ECXRC1)^
- +21 ;PLACEHOLD DSS IP #^enrollment priority (ECXPRIOR)_enrollment sub-
- +22 ;group (ECXSBGRP)^user enrollee (ECXUESTA)^patient type ECXPTYPE
- +23 ;^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^PLACEHOLD enc cv
- +24 ;eligible ECXCVENC^national patient record flag ECXNPRFI^
- +25 ;emergency response indicator(FEMA) ECXERI^PLACEHOLD agent orange indicator ECXAO
- +26 ;^PLACEHOLD environ contam ECXECE^PLACEHOLD head/neck cancer ECXHNC^PLACEHOLD encntr mst ECXMIL^
- +27 ;PLACEHOLD radiation ECXIR
- +28 ;NODE2
- +29 ;OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^
- +30 ;nppd code ECXNPPDC^nppd entry date ECXNPPDT
- +31 ;Placehold assoc pc provider npi ECASNPI^Placehold primary care provider npi ECPTNPI^
- +32 ;country ECXCNTRY^shad indicator ECXSHADI^PLACEHOLD shad encounter ECXSHAD^
- +33 ;labor hours ECXLH^
- +34 ;PATCAT^EXCPATCAT^
- +35 ;primary ICD-10 code (currently null)ECXICD10P^Secondary ICD-10 Code #1 (currently null)ECXICD101^
- +36 ;Secondary ICD-10 Code #2 (currently null)ECXICD102^Secondary ICD-10 Code #3 (currently null)ECXICD103^
- +37 ;Secondary ICD-10 Code #4 (currently null)ECXICD104^PLACEHOLD Encounter SC ECXEXC^Vietnam Status ECXVNS^Camp Lejeune Status ECXCLST^PLACEHOLD Encounter Camp Lejeune ECXECL^
- +38 ;Combat Service Indicator (ECXSVCI)^Combat Service Location (ECXSVCL)^
- +39 ;Form Requested On (ECXFORM)^Unit of Issue (ECXUI)
- +40 ;New Cost of Transaction (ECXNCOST)^New Lab Labor Cost (ECXNLLC)^New Lab Material Cost (ECXNLMC)^ ;174
- +41 ;New MPI (ECXNMPI)^Self Idenfied Gender (ECXSIGI) ;184
- +42 NEW DA,DIK
- +43 SET EC7=$ORDER(^ECX(ECFILE,999999999),-1)
- SET EC7=EC7+1
- +44 ;170 Fields will now be null
- IF ECXLOGIC>2018
- SET (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)=""
- +45 ;174 Section added for FY20 updates
- IF ECXLOGIC>2019
- Begin DoDot:1
- +46 ;If item is a monthly rental, convert unit of issue to days and quantity to 30 times the original
- IF $GET(ECXTYPE)=5
- IF $GET(ECXUI)="MO"
- SET ECXUI="DY"
- SET ECXQTY=$$RJ^XLFSTR(+$GET(ECXQTY)*30,8,0)
- +47 SET (ECXCTAMT,ECXLLC,ECXLMC,ECXCVENC,ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR,ECXSHAD,ECXESC,ECXECL)=""
- End DoDot:1
- +48 ;169 tjl
- SET ECODE=EC7_U_EC23_U_ECINSTSV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
- +49 SET ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXFELOC_U
- +50 SET ECODE=ECODE_ECXFEKEY_U_ECXQTY_U_ECPTTM_U_ECPTPR_U_ECXHCPCS_U
- +51 SET ECODE=ECODE_ECXICD9_U_ECXICD91_U_ECXICD92_U_ECXICD93_U_ECXICD94_U
- +52 SET ECODE=ECODE_ECXAST_U_ECXRST_U_ECXEST_U_ECXELIG_U_ECXCTAMT_U_ECXLLC_U
- +53 SET ECODE=ECODE_ECXLMC_U_ECXBILST_U_ECXVET_U_ECXTYPE_U_ECXRQST_U_ECXRCST_U
- +54 SET ECODE=ECODE_ECXPHCPC_U
- +55 ;184 - Field retired: MPI
- IF ECXLOGIC>2022
- SET ECXMPI=""
- +56 SET ECODE1=ECXZIP_U_ECXDOB_U_ECXSEX_U_ECXGRPR_U_U_ECXMPI_U
- +57 SET ECODE1=ECODE1_ECXDSSD_U_ECCLAS_U_ECXRACE_U_ECXPST_U_ECXPLOC_U
- +58 SET ECODE1=ECODE1_U_U_ECXMST_U_ECXENRL_U_ECXSTATE_U
- +59 SET ECODE1=ECODE1_ECXCNTY_U_ECASPR_U_ECCLAS2_U_U_ECXDOM_U
- +60 SET ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$SELECT(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U
- +61 SET ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXCNH_U_ECXPDIV_U
- +62 SET ECODE1=ECODE1_ECXHNCI_U_ECXETH_U_ECXRC1_U
- +63 IF ECXLOGIC>2004
- SET ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- +64 IF ECXLOGIC>2006
- SET ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U
- +65 IF ECXLOGIC>2007
- SET ECODE2=ECXOEF_U_ECXOEFDT_U_ECXNPPDC_U_ECXNPPDT_U_ECASNPI_U_ECPTNPI
- +66 IF ECXLOGIC>2009
- SET ECODE2=ECODE2_U_ECXCNTRY
- +67 IF ECXLOGIC>2010
- SET ECODE2=ECODE2_U_ECXSHADI_U_ECXSHAD_U_ECXLH_U_ECXPATCAT
- +68 IF ECXLOGIC>2012
- SET ECODE2=ECODE2_U_ECXICD10P_U_ECXICD101_U_ECXICD102_U_ECXICD103_U_ECXICD104
- +69 ;144
- IF ECXLOGIC>2013
- SET ECODE2=ECODE2_U_ECXESC_U_ECXVNS_U_ECXCLST_U_ECXECL
- +70 ;149
- IF ECXLOGIC>2014
- SET ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL
- +71 ;154
- IF ECXLOGIC>2015
- SET ECODE2=ECODE2_U_$PIECE(ECXFORM,U,2)
- +72 ;166
- IF ECXLOGIC>2017
- SET ECODE2=ECODE2_U_$GET(ECXUI)
- +73 ;174
- IF ECXLOGIC>2019
- SET ECODE2=ECODE2_U_ECXNCOST_U_ECXNLLC_U_ECXNLMC
- +74 ;184
- IF ECXLOGIC>2022
- SET ECODE2=ECODE2_U_ECXNMPI_U_ECXSIGI
- +75 SET ^ECX(ECFILE,EC7,0)=ECODE
- SET ^ECX(ECFILE,EC7,1)=ECODE1
- SET ^ECX(ECFILE,EC7,2)=$GET(ECODE2)
- SET ECRN=ECRN+1
- +76 SET DA=EC7
- SET DIK="^ECX("_ECFILE_","
- DO IX1^DIK
- KILL DIK,DA
- +77 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET QFLG=1
- +78 QUIT
- +79 ;
- SETUP ;Set required input for ECXTRAC
- +1 SET ECHEAD="PRO"
- +2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
- +3 SET ECINST=$$PDIV^ECXPUTL
- +4 QUIT
- +5 ;
- +6 ;**Note: LOCAL and QUE are carry over from protocols set by other
- +7 ; routines.
- LOCAL ;to extract nightly for local use not to be transmitted to TSI
- +1 ;QUEUE with 1D frequency
- +2 DO SETUP
- DO ^ECXTLOCL
- DO ^ECXKILL
- QUIT
- +3 ;
- QUE ; entry point for the background requeuing handled by ECXTAUTO
- +1 DO SETUP
- DO QUE^ECXTAUTO
- DO ^ECXKILL
- QUIT