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 Apr 09, 2024@20:56:09 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
