Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXPRO

ECXPRO.m

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