- ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ;6/26/19 10:46
- ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107,105,120,127,144,149,154,161,166,170,174,178,181,184,187**;Dec 22, 1997;Build 163
- ;
- ; Reference to $$LJ^XLFSTR in ICR #10104
- ; Reference to EN^DIQ1 in ICR #10015
- ; Reference to ^DG(40.8,0) in ICR #417
- ; Reference to ^DG(40.8,"AD") in ICR #2817
- ; Reference to ^TMP($J supported by SACC 2.3.2.5.1
- ; Reference to ^DIC(42 in ICR #1848
- ; Reference to $$DSS^PSNAPIS in ICR #2351
- ; Reference to $$NPI^XUSNPI in ICR #4532
- ;
- BEG ;entry point from option
- I '$O(^ECX(728.904,"A",0)) W !,"There are no unit dose orders to extract",!! R X:5 K X Q
- D SETUP I ECFILE="" Q
- D ^ECXTRAC,^ECXKILL
- Q
- ;
- START ;start package specific extract
- N RERUN,ECXLDT ;149
- S RERUN=0 ;149
- S ECXLDT=+$P($G(^ECX(728,1,ECNODE)),U,ECPIECE) ;149 Get last run date
- I ECXLDT'<ECSD S RERUN=1 ;149
- S QFLG=0
- S ECED=ECED+.3
- F ECD=ECSD1:0 S ECD=$O(^ECX(728.904,"A",ECD)) Q:'ECD Q:ECD>ECED Q:QFLG D
- .S ECXJ=0 F S ECXJ=$O(^ECX(728.904,"A",ECD,ECXJ)) Q:'ECXJ Q:QFLG I $D(^ECX(728.904,ECXJ,0)) D
- ..S DATA=^ECX(728.904,ECXJ,0),^(1)=$P(EC23,U,2),^ECX(728.904,"AC",$P(EC23,U,2),ECXJ)="" D STUFF
- K ^TMP($J,"ECXP")
- I $D(^TMP($J,"ECXUDM")) D SENDMSG^ECXUD1 ;181 - Send messages with list of clinics with NO/Inactive Stop Code
- I 'RERUN D CLEAN(0,$$FMADD^XLFDT(ECSD,-180)) ;149 Remove old log entries
- Q
- ;
- STUFF ;get data
- N X,W,OK,P1,P3,PSTAT,PT,ECXPHA,ON,ECDRG,ECXESC,ECXECL,ECXCLST,ECPROIEN,ECXUDDT,ECXUDTM,ECXNEW ;144,149
- N ECXSTANO,ECXASIH,ECXDEA,ECXCLIN ;166,170,174
- N ECXNMPI,ECXCERN,ECXSIGI ;184
- N ECXDUNIT,ECXPPDU ;187 Add Dispense Unit and Price Per Dispense Unit
- S (ECXNMPI,ECXCERN,ECXSIGI)="" ;184
- S (ECXESC,ECXECL,ECXCLST)="" ;144
- S ECXDFN=$P(DATA,U,2),ECDRG=$P(DATA,U,4)
- ;
- ;get patient specific data
- S ECXERR="" D PAT(ECXDFN,ECD,.ECXERR)
- Q:ECXERR
- ;
- S ECXPRO=$P(DATA,U,7),ECPROIEN=+ECXPRO,ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";")
- S ECXPRNPI=$$NPI^XUSNPI("Individual_ID",ECPROIEN,ECD)
- S:+ECXPRNPI'>0 ECXPRNPI="" S ECXPRNPI=$P(ECXPRNPI,U)
- S W=$P(DATA,U,6)
- S ECXW=$S(ECXADM="":"",1:$P($G(^DIC(42,+W,44)),U)) ;154 Ward gets set to null if this is an order for an outpatient
- S ON=$P(DATA,U,10) ;174 Setting of Order Number moved up
- I ECXW S ECXDIV=$P($G(^DIC(42,+W,0)),U,11) ;174 For inpt get division from ward
- I ECXW="" D ;174 Handle outpt with no ward (clinic order)
- .S ECXCLIN=+$$GET1^DIQ(55.06,ON_","_ECXDFN_",",130,"I") ;174 Get clinic med was given in
- .S ECXDIV=$$GET1^DIQ(44,ECXCLIN,3.5,"I") ;174 Medical center division associated with clinic
- I $$GET1^DIQ(4,+$P($G(^DG(40.8,+ECXDIV,0)),U,7),101,"I")!(ECXDIV="") S ECXDIV=$O(^DG(40.8,"AD",+$G(^ECX(728,1,0)),0)) ;174 If institution is inactive or blank then set division to DSS default
- S ECXSTANO=$$GETDIV^ECXDEPT(ECXDIV) ;166 tjl - Get Patient Division based on Facility
- S ECXUDDT=$$ECXDATE^ECXUTL($P(DATA,U,3),ECXYM)
- S ECXUDTM=$E($P($P(DATA,U,3),".",2)_"000000",1,6)
- S ECXQTY=$P(DATA,U,5),ECXCOST=$P(DATA,U,8) ;174
- ;call pharmacy drug file (#50) api via ecxutl5
- S ECXPHA=$$PHAAPI^ECXUTL5(ECDRG)
- S ECCAT=$P(ECXPHA,U,2),(ECINV,ECXDEA)=$P(ECXPHA,U,4) ;174
- I ECXLOGIC<2014 D ;New way to calculate cost dea spl hndlg **144
- .S ECINV=$S(ECINV["I":"I",1:"")
- I ECXLOGIC>2013 D
- .S ECINV=$S((+ECINV>0)&(+ECINV<6):+ECINV,ECINV["I":"I",1:"")
- S ECNDC=$P(ECXPHA,U,3)
- S ECNFC=$$RJ^XLFSTR($P(ECNDC,"-"),6,0)_$$RJ^XLFSTR($P(ECNDC,"-",2),4,0)_$$RJ^XLFSTR($P(ECNDC,"-",3),2,0),ECNFC=$TR(ECNFC,"*",0)
- I ECNDC["LCL"!(ECNDC["LCD") S ECNDC="" ;170,174 Reset NDC to null if it's missing from file 50
- S P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6),X="PSNAPIS"
- S ECXDUNIT=$P(ECXPHA,U,8),ECXPPDU=$P(ECXPHA,U,7) ;187
- X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC
- I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC
- ; - Department and National Production Division
- ;- Use of DSS Department postponed [S ECXDSSD=$$UDP^ECXDEPT(ECXDIV)]
- S ECXDSSD=""
- S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV)
- ;- Observation patient indicator (YES/NO)
- S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
- ;- Ordering Date, Ordering Stop Code
- S ECXORDDT=$TR($$FMTE^XLFDT($P(DATA,U,9),"7DF")," /","0")
- S ECXORDST="" I ECXA="O" D
- .;Get ordering stop code based on FY 2006 logic for outpatient
- .S ECXORDST=$$DOUDO^ECXUTL5(ECXDFN,ON)
- .I $P(ECXORDST,U,2)'="" D ;181 - No/Inactive Stop Code, default to PHA. Save information to send mail later
- ..D SETTMP(ECXORDST)
- ..S ECXORDST="PHA"
- ;Ordering Provider Person Class
- S ECXOPPC=$$PRVCLASS^ECXUTL($E(ECXPRO,2,999),$P(DATA,U,9))
- S (ECXBCDD,ECXBCDG,ECXBCUA,ECXBCIF)="" ;144 BCMA are place holders now
- ;- Set national patient record flag if exist
- D NPRF^ECXUTL5
- ;149 Determine if script required pharmacist workload
- S ECXNEW=$$NEW ;149
- ;- If no encounter number don't file record
- S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADM,$P(DATA,U,3),ECXTS,ECXOBS,ECHEAD,,)
- I $G(ECXASIH) S ECXA="A" ;170
- D:ECXENC'="" FILE
- Q
- ;
- PAT(ECXDFN,ECXDATE,ECXERR) ;get demographics from patient file
- ;init variables
- S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)=""
- ;get patient data if saved
- I $D(^TMP($J,"ECXP",ECXDFN)) D
- .S PT=^TMP($J,"ECXP",ECXDFN),ECXPNM=$P(PT,U),ECXSSN=$P(PT,U,2)
- .S (ECXNMPI,ECXMPI)=$P(PT,U,3),ECXDOB=$P(PT,U,4) ;184 - Added ECXNMPI
- .S ECXELIG=$P(PT,U,5),ECXSEX=$P(PT,U,6)
- .S ECXSTATE=$P(PT,U,7),ECXCNTY=$P(PT,U,8),ECXZIP=$P(PT,U,9)
- .S ECXVET=$P(PT,U,10),ECXPOS=$P(PT,U,11),ECXPST=$P(PT,U,12)
- .S ECXPLOC=$P(PT,U,13),ECXRST=$P(PT,U,14),ECXAST=$P(PT,U,15)
- .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18)
- .S ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21)
- .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24)
- .S ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27)
- .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2),ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4),ECXCNTRY=$P(PT1,U,5)
- .S ECXSHADI=$P(PT1,U,6),ECXPATCAT=$P(PT1,U,7),ECXCLST=$P(PT1,U,8) ;144
- .S ECXSIGI=$P(PT1,U,11) ;184
- .I $$ENROLLM^ECXUTL2(ECXDFN)
- ;set patient data
- I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK
- .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;5",.ECXPAT)
- .I 'OK K ECXPAT S ECXERR=1 Q
- .S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),(ECXMPI,ECXNMPI)=ECXPAT("MPI") ;184 - field added ECXNMPI
- .S ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG"),ECXSEX=ECXPAT("SEX")
- .S ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY")
- .S ECXZIP=ECXPAT("ZIP"),ECXVET=ECXPAT("VET"),ECXCNTRY=ECXPAT("COUNTRY")
- .S ECXPOS=ECXPAT("POS"),ECXPST=ECXPAT("POW STAT")
- .S ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT")
- .S ECXAST=ECXPAT("AO STAT"),ECXAOL=ECXPAT("AOL")
- .S ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT")
- .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS")
- .S ECXCLST=ECXPAT("CL STAT") ;144
- .S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND
- .S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC
- .S ECXSIGI=ECXPAT("SIGI") ;184 Self Identified Gender
- .;OEF/OIF data
- .S ECXOEF=ECXPAT("ECXOEF")
- .S ECXOEFDT=ECXPAT("ECXOEFDT")
- .;get CNHU status
- .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN)
- .;get enrollment data (category, status and priority)
- .I $$ENROLLM^ECXUTL2(ECXDFN)
- .; - 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)
- .; - Race and Ethnicity
- .S ECXETH=ECXPAT("ETHNIC")
- .S ECXRC1=ECXPAT("RACE1")
- .;get emergency response indicator (FEMA)
- .S ECXERI=ECXPAT("ERI")
- .S ECXEST=ECXPAT("EC STAT")
- .;save for later
- .S ^TMP($J,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST
- .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST
- .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT_U_ECXCNTRY_U_ECXSHADI_U_ECXPATCAT_U_ECXCLST_U_ECXSVCI_U_ECXSVCL_U_ECXSIGI ;149,184 - Added ECXSIGI
- ;
- ;get inpatient data
- S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXA=$P(X,U),ECXMN=$P(X,U,2)
- S ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),ECXDOM=$P(X,U,10),ECXASIH=$P(X,U,14) ;170
- ;
- ;get primary care data
- S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
- S ECPTTM=$P(X,U),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)
- Q
- ;
- FILE ;file record
- ;node0
- ;facility^dfn^ssn^name^in/out^day^drug category^quantity^ward^
- ;provider^cost^mov #^treat spec^ndc^new feeder key^investigational^
- ;udp time^adm date^adm time
- ;node1
- ;mpi^placeholder^provider npi^dom^observ pat ind^encounter num^
- ;prod div code^means tst^elig^dob^sex^state^county^zip+4^vet^
- ;period of svc^pow stat^pow loc^ir status^ao status^ao loc^
- ;purple heart ind.^mst status^cnh/sh status^enrollment loc^
- ;enrollment cat^enrollment status^enrollment priority^Placehold pc team^
- ;Placehold pc provider^pc provider npi^Placehold pc provider p.class^Placehold assoc. pc provider^
- ;assoc. pc provider npi^Placehold assoc. pc provider p.class
- ;node2
- ;ordering date^ordering stop code^head & neck cancer ind.^Placehold ethnicity^
- ;Placehold race1^bcma drug dispensed^bcma dose given^bcma unit of
- ;administration^bcma icu flag^ordering provider person class^
- ;^enrollment priority ECXPRIOR_enrollment subgroup
- ;ECXSBGRP^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet
- ;elig ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible
- ;ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA)
- ;ECXERI^environ contamin ECXEST^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^Placehold associate pc provider npi ECASNPI^Placehold primary care provider npi ECPTNPI^provider npi ECXPRNPI
- ;^country ECXCNTRY^PATCAT^Encounter SC ECXESC^Camp Lejeune Status ECXCLST^Encounter Camp Lejeune ECXECL
- ;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL) ^ New Script (ECXNEW)
- ;^Patient Division (ECXSTANO)
- ;Node 3
- ;Vista DEA Special Hdlg (ECXDEA)
- ;Node 4 ;184
- ;Placehold Cerner (ECXCERN)^
- ;Node 5 ;184
- ;New MPI (ECXNMPI^Self Identified Gender (ECXSIGI)^Price Per Dispense Unit ECXPPDU^Dispense Unit^Dispense UNit
- ;
- ;convert specialty to PTF Code for transmission
- N ECXDATA
- S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
- S ECXTS=$G(ECXDATA(7))
- ;done
- N DA,DIK
- S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
- I ECXLOGIC>2018 S (ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)="" ;170 Fields will now be null
- I ECXLOGIC>2020 S ECXMTST="" ;178 Means Test field will now be null
- I ECXLOGIC>2022 S ECXMPI="" ;184 - field retired
- S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
- S ECODE=ECODE_ECXUDDT_U_ECCAT_U_ECXQTY_U_ECXW_U_ECXPRO_U_ECXCOST_U
- S ECODE=ECODE_ECXMN_U_ECXTS_U_ECNDC_U_ECNFC_U_ECINV_U_ECXUDTM_U
- S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U
- S ECODE=ECODE_$$ECXTIME^ECXUTL(ECXADM)_U
- S ECODE1=ECXMPI_U_ECXDSSD_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U
- S ECODE1=ECODE1_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U_ECXSEX_U
- S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U
- S ECODE1=ECODE1_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U
- S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXCNHU_U_ECXENRL_U
- S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_ECPTTM_U_ECPTPR_U
- S ECODE1=ECODE1_U_ECCLAS_U_ECASPR_U_U_ECCLAS2_U
- S ECODE2=ECXORDDT_U_ECXORDST_U_ECXHNCI_U_ECXETH_U_ECXRC1
- I ECXLOGIC>2003 S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC
- I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST
- I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECXPRNPI
- I ECXLOGIC>2009 S ECODE2=ECODE2_U_ECXCNTRY
- I ECXLOGIC>2010 S ECODE2=ECODE2_U_ECXPATCAT ; 127 PATCAT ADDED
- I ECXLOGIC>2013 S ECODE2=ECODE2_U_ECXESC_U_ECXCLST_U_ECXECL ;144
- I ECXLOGIC>2014 S ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL_U_ECXNEW ;149
- I ECXLOGIC>2017 S ECODE2=ECODE2_U_ECXSTANO_$S(ECXLOGIC>2019:"^",1:"") ;166 tjl,174
- I ECXLOGIC>2019 S ECODE3=ECXDEA_U ;174 ,184 - Added "^"
- I ECXLOGIC>2022 S ECODE4=$G(ECXCERN)_U,ECODE5=ECXNMPI_U_ECXSIGI ;184
- I ECXLOGIC>2023 S ECODE5=ECODE5_U_ECXPPDU_U_ECXDUNIT ;187
- S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
- S ^ECX(ECFILE,EC7,2)=ECODE2 S:ECXLOGIC>2019 ^ECX(ECFILE,EC7,3)=ECODE3 ;S ECRN=ECRN+1 ;174,184 - Moved record count to below
- S ^ECX(ECFILE,EC7,4)=$G(ECODE4),^ECX(ECFILE,EC7,5)=$G(ECODE5) ;184
- S ECRN=ECRN+1 ;184 - Moved record count from above
- S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
- I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
- Q
- ;
- NEW() ;149 Function added to determine if script had pharmacist involvement
- N ALIEN,ADATE,SCRIPT,VDATE,DONE,IENS
- S SCRIPT="N",VDATE="",DONE=0
- S ALIEN=0 F S ALIEN=$O(^PS(55,ECXDFN,5,ON,9,ALIEN)) Q:'+ALIEN!(DONE) S IENS=ALIEN_","_ON_","_ECXDFN_"," D
- .S ADATE=$$GET1^DIQ(55.09,IENS,".01","I")
- .I $P(ADATE,".")>ECD S DONE=1 Q ;If date of activity is after dispense date then stop
- .I "^VP^VPR^"[("^"_$$GET1^DIQ(55.09,IENS,"2:1")_"^") S VDATE=ADATE ;if activity status is verified by pharmacist or verified by pharmacist renewal
- I VDATE'="" D
- .I '$D(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON))!($G(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON))=ECXJ) S SCRIPT="Y"
- .I '$D(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON)) S ^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON)=ECXJ ;Store first instance of med given
- Q SCRIPT
- ;
- CLEAN(START,END) ;149 Section added to delete old log entries
- N DATE,PAT,ON
- S DATE=START F S DATE=$O(^XTMP("ECXSCRIPT",DATE)) Q:'+DATE!(DATE>END) S PAT=0 F S PAT=$O(^XTMP("ECXSCRIPT",DATE,PAT)) Q:'+PAT S ON=0 F S ON=$O(^XTMP("ECXSCRIPT",DATE,PAT,ON)) Q:'+ON K ^XTMP("ECXSCRIPT",DATE,PAT,ON)
- S ^XTMP("ECXSCRIPT",0)=$$FMADD^XLFDT($$DT^XLFDT,365)_"^"_$$DT^XLFDT_"^"_"Log of pharmacy orders that have already been counted"
- Q
- ;
- SETUP ;Set required input for ECXTRAC
- S ECHEAD="UDP"
- 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
- ;
- SETTMP(STR) ;181 - Set global TMP for Mail Message
- N CLIN,SCODE,DIC,ECXDIC,ECXDICA,ECXNOSC,ECXINVSC,DIQ,DR,DA
- I $P(STR,U,2)="MISSING STOP CODE" D Q
- .S CLIN=$P(STR,U)
- .I $D(^TMP($J,"ECXUDM","NOSC",CLIN)) Q
- .I '$D(^TMP($J,"ECXUDM","ECXNOSC")) S ^TMP($J,"ECXUDM","ECXNOSC")=0
- .S ECXNOSC=^TMP($J,"ECXUDM","ECXNOSC")+1
- .S DIC="^SC(",DIQ="IE",DIQ="ECXDIC",DR=".01",DA=CLIN D EN^DIQ1
- .S ^TMP($J,"ECXUDM","ECXNOSC",ECXNOSC,0)=$J(CLIN,8)_" "_$$LJ^XLFSTR(ECXDIC(44,CLIN,.01),32)
- .S ^TMP($J,"ECXUDM","ECXNOSC")=ECXNOSC
- .S ^TMP($J,"ECXUDM","NOSC",CLIN)=""
- I $P(STR,U,2)="INVALID STOP CODE" D
- .S CLIN=$P(STR,U),SCODE=$P(STR,U,3)
- .I $D(^TMP($J,"ECXUDM","INVSC",CLIN)) Q
- .I '$D(^TMP($J,"ECXUDM","ECXINVSC")) S ^TMP($J,"ECXUDM","ECXINVSC")=0
- .S ECXINVSC=^TMP($J,"ECXUDM","ECXINVSC")+1
- .S DIC="^SC(",DIQ="IE",DIQ="ECXDIC",DR=".01",DA=CLIN D EN^DIQ1
- .S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICA",DR=".01;1;2",DA=SCODE D EN^DIQ1
- .S ^TMP($J,"ECXUDM","ECXINVSC",ECXINVSC,0)=$J(CLIN,8)_"/"_$$LJ^XLFSTR(ECXDIC(44,CLIN,.01),25)_" "_$J(ECXDICA(40.7,SCODE,1,"E"),8)_"/"_$$LJ^XLFSTR(ECXDICA(40.7,SCODE,.01,"E"),25)
- .S ^TMP($J,"ECXUDM","ECXINVSC")=ECXINVSC
- .S ^TMP($J,"ECXUDM","INVSC",CLIN)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUD 15683 printed Feb 18, 2025@23:20:38 Page 2
- ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ;6/26/19 10:46
- +1 ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107,105,120,127,144,149,154,161,166,170,174,178,181,184,187**;Dec 22, 1997;Build 163
- +2 ;
- +3 ; Reference to $$LJ^XLFSTR in ICR #10104
- +4 ; Reference to EN^DIQ1 in ICR #10015
- +5 ; Reference to ^DG(40.8,0) in ICR #417
- +6 ; Reference to ^DG(40.8,"AD") in ICR #2817
- +7 ; Reference to ^TMP($J supported by SACC 2.3.2.5.1
- +8 ; Reference to ^DIC(42 in ICR #1848
- +9 ; Reference to $$DSS^PSNAPIS in ICR #2351
- +10 ; Reference to $$NPI^XUSNPI in ICR #4532
- +11 ;
- BEG ;entry point from option
- +1 IF '$ORDER(^ECX(728.904,"A",0))
- WRITE !,"There are no unit dose orders to extract",!!
- READ X:5
- KILL X
- QUIT
- +2 DO SETUP
- IF ECFILE=""
- QUIT
- +3 DO ^ECXTRAC
- DO ^ECXKILL
- +4 QUIT
- +5 ;
- START ;start package specific extract
- +1 ;149
- NEW RERUN,ECXLDT
- +2 ;149
- SET RERUN=0
- +3 ;149 Get last run date
- SET ECXLDT=+$PIECE($GET(^ECX(728,1,ECNODE)),U,ECPIECE)
- +4 ;149
- IF ECXLDT'<ECSD
- SET RERUN=1
- +5 SET QFLG=0
- +6 SET ECED=ECED+.3
- +7 FOR ECD=ECSD1:0
- SET ECD=$ORDER(^ECX(728.904,"A",ECD))
- if 'ECD
- QUIT
- if ECD>ECED
- QUIT
- if QFLG
- QUIT
- Begin DoDot:1
- +8 SET ECXJ=0
- FOR
- SET ECXJ=$ORDER(^ECX(728.904,"A",ECD,ECXJ))
- if 'ECXJ
- QUIT
- if QFLG
- QUIT
- IF $DATA(^ECX(728.904,ECXJ,0))
- Begin DoDot:2
- +9 SET DATA=^ECX(728.904,ECXJ,0)
- SET ^(1)=$PIECE(EC23,U,2)
- SET ^ECX(728.904,"AC",$PIECE(EC23,U,2),ECXJ)=""
- DO STUFF
- End DoDot:2
- End DoDot:1
- +10 KILL ^TMP($JOB,"ECXP")
- +11 ;181 - Send messages with list of clinics with NO/Inactive Stop Code
- IF $DATA(^TMP($JOB,"ECXUDM"))
- DO SENDMSG^ECXUD1
- +12 ;149 Remove old log entries
- IF 'RERUN
- DO CLEAN(0,$$FMADD^XLFDT(ECSD,-180))
- +13 QUIT
- +14 ;
- STUFF ;get data
- +1 ;144,149
- NEW X,W,OK,P1,P3,PSTAT,PT,ECXPHA,ON,ECDRG,ECXESC,ECXECL,ECXCLST,ECPROIEN,ECXUDDT,ECXUDTM,ECXNEW
- +2 ;166,170,174
- NEW ECXSTANO,ECXASIH,ECXDEA,ECXCLIN
- +3 ;184
- NEW ECXNMPI,ECXCERN,ECXSIGI
- +4 ;187 Add Dispense Unit and Price Per Dispense Unit
- NEW ECXDUNIT,ECXPPDU
- +5 ;184
- SET (ECXNMPI,ECXCERN,ECXSIGI)=""
- +6 ;144
- SET (ECXESC,ECXECL,ECXCLST)=""
- +7 SET ECXDFN=$PIECE(DATA,U,2)
- SET ECDRG=$PIECE(DATA,U,4)
- +8 ;
- +9 ;get patient specific data
- +10 SET ECXERR=""
- DO PAT(ECXDFN,ECD,.ECXERR)
- +11 if ECXERR
- QUIT
- +12 ;
- +13 SET ECXPRO=$PIECE(DATA,U,7)
- SET ECPROIEN=+ECXPRO
- SET ECXPRO=$EXTRACT($PIECE(ECXPRO,";",2))_$PIECE(ECXPRO,";")
- +14 SET ECXPRNPI=$$NPI^XUSNPI("Individual_ID",ECPROIEN,ECD)
- +15 if +ECXPRNPI'>0
- SET ECXPRNPI=""
- SET ECXPRNPI=$PIECE(ECXPRNPI,U)
- +16 SET W=$PIECE(DATA,U,6)
- +17 ;154 Ward gets set to null if this is an order for an outpatient
- SET ECXW=$SELECT(ECXADM="":"",1:$PIECE($GET(^DIC(42,+W,44)),U))
- +18 ;174 Setting of Order Number moved up
- SET ON=$PIECE(DATA,U,10)
- +19 ;174 For inpt get division from ward
- IF ECXW
- SET ECXDIV=$PIECE($GET(^DIC(42,+W,0)),U,11)
- +20 ;174 Handle outpt with no ward (clinic order)
- IF ECXW=""
- Begin DoDot:1
- +21 ;174 Get clinic med was given in
- SET ECXCLIN=+$$GET1^DIQ(55.06,ON_","_ECXDFN_",",130,"I")
- +22 ;174 Medical center division associated with clinic
- SET ECXDIV=$$GET1^DIQ(44,ECXCLIN,3.5,"I")
- End DoDot:1
- +23 ;174 If institution is inactive or blank then set division to DSS default
- IF $$GET1^DIQ(4,+$PIECE($GET(^DG(40.8,+ECXDIV,0)),U,7),101,"I")!(ECXDIV="")
- SET ECXDIV=$ORDER(^DG(40.8,"AD",+$GET(^ECX(728,1,0)),0))
- +24 ;166 tjl - Get Patient Division based on Facility
- SET ECXSTANO=$$GETDIV^ECXDEPT(ECXDIV)
- +25 SET ECXUDDT=$$ECXDATE^ECXUTL($PIECE(DATA,U,3),ECXYM)
- +26 SET ECXUDTM=$EXTRACT($PIECE($PIECE(DATA,U,3),".",2)_"000000",1,6)
- +27 ;174
- SET ECXQTY=$PIECE(DATA,U,5)
- SET ECXCOST=$PIECE(DATA,U,8)
- +28 ;call pharmacy drug file (#50) api via ecxutl5
- +29 SET ECXPHA=$$PHAAPI^ECXUTL5(ECDRG)
- +30 ;174
- SET ECCAT=$PIECE(ECXPHA,U,2)
- SET (ECINV,ECXDEA)=$PIECE(ECXPHA,U,4)
- +31 ;New way to calculate cost dea spl hndlg **144
- IF ECXLOGIC<2014
- Begin DoDot:1
- +32 SET ECINV=$SELECT(ECINV["I":"I",1:"")
- End DoDot:1
- +33 IF ECXLOGIC>2013
- Begin DoDot:1
- +34 SET ECINV=$SELECT((+ECINV>0)&(+ECINV<6):+ECINV,ECINV["I":"I",1:"")
- End DoDot:1
- +35 SET ECNDC=$PIECE(ECXPHA,U,3)
- +36 SET ECNFC=$$RJ^XLFSTR($PIECE(ECNDC,"-"),6,0)_$$RJ^XLFSTR($PIECE(ECNDC,"-",2),4,0)_$$RJ^XLFSTR($PIECE(ECNDC,"-",3),2,0)
- SET ECNFC=$TRANSLATE(ECNFC,"*",0)
- +37 ;170,174 Reset NDC to null if it's missing from file 50
- IF ECNDC["LCL"!(ECNDC["LCD")
- SET ECNDC=""
- +38 SET P1=$PIECE(ECXPHA,U,5)
- SET P3=$PIECE(ECXPHA,U,6)
- SET X="PSNAPIS"
- +39 ;187
- SET ECXDUNIT=$PIECE(ECXPHA,U,8)
- SET ECXPPDU=$PIECE(ECXPHA,U,7)
- +40 XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC
- +41 IF $LENGTH(ECNFC)=12
- SET ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC
- +42 ; - Department and National Production Division
- +43 ;- Use of DSS Department postponed [S ECXDSSD=$$UDP^ECXDEPT(ECXDIV)]
- +44 SET ECXDSSD=""
- +45 SET ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV)
- +46 ;- Observation patient indicator (YES/NO)
- +47 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
- +48 ;- Ordering Date, Ordering Stop Code
- +49 SET ECXORDDT=$TRANSLATE($$FMTE^XLFDT($PIECE(DATA,U,9),"7DF")," /","0")
- +50 SET ECXORDST=""
- IF ECXA="O"
- Begin DoDot:1
- +51 ;Get ordering stop code based on FY 2006 logic for outpatient
- +52 SET ECXORDST=$$DOUDO^ECXUTL5(ECXDFN,ON)
- +53 ;181 - No/Inactive Stop Code, default to PHA. Save information to send mail later
- IF $PIECE(ECXORDST,U,2)'=""
- Begin DoDot:2
- +54 DO SETTMP(ECXORDST)
- +55 SET ECXORDST="PHA"
- End DoDot:2
- End DoDot:1
- +56 ;Ordering Provider Person Class
- +57 SET ECXOPPC=$$PRVCLASS^ECXUTL($EXTRACT(ECXPRO,2,999),$PIECE(DATA,U,9))
- +58 ;144 BCMA are place holders now
- SET (ECXBCDD,ECXBCDG,ECXBCUA,ECXBCIF)=""
- +59 ;- Set national patient record flag if exist
- +60 DO NPRF^ECXUTL5
- +61 ;149 Determine if script required pharmacist workload
- +62 ;149
- SET ECXNEW=$$NEW
- +63 ;- If no encounter number don't file record
- +64 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADM,$PIECE(DATA,U,3),ECXTS,ECXOBS,ECHEAD,,)
- +65 ;170
- IF $GET(ECXASIH)
- SET ECXA="A"
- +66 if ECXENC'=""
- DO FILE
- +67 QUIT
- +68 ;
- PAT(ECXDFN,ECXDATE,ECXERR) ;get demographics from patient file
- +1 ;init variables
- +2 SET (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)=""
- +3 ;get patient data if saved
- +4 IF $DATA(^TMP($JOB,"ECXP",ECXDFN))
- Begin DoDot:1
- +5 SET PT=^TMP($JOB,"ECXP",ECXDFN)
- SET ECXPNM=$PIECE(PT,U)
- SET ECXSSN=$PIECE(PT,U,2)
- +6 ;184 - Added ECXNMPI
- SET (ECXNMPI,ECXMPI)=$PIECE(PT,U,3)
- SET ECXDOB=$PIECE(PT,U,4)
- +7 SET ECXELIG=$PIECE(PT,U,5)
- SET ECXSEX=$PIECE(PT,U,6)
- +8 SET ECXSTATE=$PIECE(PT,U,7)
- SET ECXCNTY=$PIECE(PT,U,8)
- SET ECXZIP=$PIECE(PT,U,9)
- +9 SET ECXVET=$PIECE(PT,U,10)
- SET ECXPOS=$PIECE(PT,U,11)
- SET ECXPST=$PIECE(PT,U,12)
- +10 SET ECXPLOC=$PIECE(PT,U,13)
- SET ECXRST=$PIECE(PT,U,14)
- SET ECXAST=$PIECE(PT,U,15)
- +11 SET ECXAOL=$PIECE(PT,U,16)
- SET ECXPHI=$PIECE(PT,U,17)
- SET ECXMST=$PIECE(PT,U,18)
- +12 SET ECXENRL=$PIECE(PT,U,19)
- SET ECXCNHU=$PIECE(PT,U,20)
- SET ECXCAT=$PIECE(PT,U,21)
- +13 SET ECXSTAT=$PIECE(PT,U,22)
- SET ECXPRIOR=$PIECE(PT,U,23)
- SET ECXHNCI=$PIECE(PT,U,24)
- +14 SET ECXETH=$PIECE(PT,U,25)
- SET ECXRC1=$PIECE(PT,U,26)
- SET ECXMTST=$PIECE(PT,U,27)
- +15 SET PT1=$GET(^TMP($JOB,"ECXP",ECXDFN,1))
- SET ECXERI=$PIECE(PT1,U)
- SET ECXEST=$PIECE(PT1,U,2)
- SET ECXOEF=$PIECE(PT1,U,3)
- SET ECXOEFDT=$PIECE(PT1,U,4)
- SET ECXCNTRY=$PIECE(PT1,U,5)
- +16 ;144
- SET ECXSHADI=$PIECE(PT1,U,6)
- SET ECXPATCAT=$PIECE(PT1,U,7)
- SET ECXCLST=$PIECE(PT1,U,8)
- +17 ;184
- SET ECXSIGI=$PIECE(PT1,U,11)
- +18 IF $$ENROLLM^ECXUTL2(ECXDFN)
- End DoDot:1
- +19 ;set patient data
- +20 IF '$DATA(^TMP($JOB,"ECXP",ECXDFN))
- Begin DoDot:1
- +21 KILL ECXPAT
- SET OK=$$PAT^ECXUTL3(ECXDFN,$PIECE(ECXDATE,"."),"1;2;3;5",.ECXPAT)
- +22 IF 'OK
- KILL ECXPAT
- SET ECXERR=1
- QUIT
- +23 ;184 - field added ECXNMPI
- SET ECXPNM=ECXPAT("NAME")
- SET ECXSSN=ECXPAT("SSN")
- SET (ECXMPI,ECXNMPI)=ECXPAT("MPI")
- +24 SET ECXDOB=ECXPAT("DOB")
- SET ECXELIG=ECXPAT("ELIG")
- SET ECXSEX=ECXPAT("SEX")
- +25 SET ECXSTATE=ECXPAT("STATE")
- SET ECXCNTY=ECXPAT("COUNTY")
- +26 SET ECXZIP=ECXPAT("ZIP")
- SET ECXVET=ECXPAT("VET")
- SET ECXCNTRY=ECXPAT("COUNTRY")
- +27 SET ECXPOS=ECXPAT("POS")
- SET ECXPST=ECXPAT("POW STAT")
- +28 SET ECXPLOC=ECXPAT("POW LOC")
- SET ECXRST=ECXPAT("IR STAT")
- +29 SET ECXAST=ECXPAT("AO STAT")
- SET ECXAOL=ECXPAT("AOL")
- +30 SET ECXPHI=ECXPAT("PHI")
- SET ECXMST=ECXPAT("MST STAT")
- +31 SET ECXENRL=ECXPAT("ENROLL LOC")
- SET ECXMTST=ECXPAT("MEANS")
- +32 ;144
- SET ECXCLST=ECXPAT("CL STAT")
- +33 ;149 COMBAT SVC IND
- SET ECXSVCI=ECXPAT("COMBSVCI")
- +34 ;149 COMBAT SVC LOC
- SET ECXSVCL=ECXPAT("COMBSVCL")
- +35 ;184 Self Identified Gender
- SET ECXSIGI=ECXPAT("SIGI")
- +36 ;OEF/OIF data
- +37 SET ECXOEF=ECXPAT("ECXOEF")
- +38 SET ECXOEFDT=ECXPAT("ECXOEFDT")
- +39 ;get CNHU status
- +40 SET ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN)
- +41 ;get enrollment data (category, status and priority)
- +42 IF $$ENROLLM^ECXUTL2(ECXDFN)
- +43 ; - Head and Neck Cancer Indicator
- +44 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
- +45 ; - Proj. 112/SHAD Indicator
- +46 SET ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
- +47 ; ******* - PATCH 127, ADD PATCAT CODE ********
- +48 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
- +49 ; - Race and Ethnicity
- +50 SET ECXETH=ECXPAT("ETHNIC")
- +51 SET ECXRC1=ECXPAT("RACE1")
- +52 ;get emergency response indicator (FEMA)
- +53 SET ECXERI=ECXPAT("ERI")
- +54 SET ECXEST=ECXPAT("EC STAT")
- +55 ;save for later
- +56 SET ^TMP($JOB,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST
- +57 SET ^TMP($JOB,"ECXP",ECXDFN)=^TMP($JOB,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST
- +58 ;149,184 - Added ECXSIGI
- SET ^TMP($JOB,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT_U_ECXCNTRY_U_ECXSHADI_U_ECXPATCAT_U_ECXCLST_U_ECXSVCI_U_ECXSVCL_U_ECXSIGI
- End DoDot:1
- if 'OK
- QUIT
- +59 ;
- +60 ;get inpatient data
- +61 SET X=$$INP^ECXUTL2(ECXDFN,ECXDATE)
- SET ECXA=$PIECE(X,U)
- SET ECXMN=$PIECE(X,U,2)
- +62 ;170
- SET ECXTS=$PIECE(X,U,3)
- SET ECXADM=$PIECE(X,U,4)
- SET ECXDOM=$PIECE(X,U,10)
- SET ECXASIH=$PIECE(X,U,14)
- +63 ;
- +64 ;get primary care data
- +65 SET X=$$PRIMARY^ECXUTL2(ECXDFN,$PIECE(ECXDATE,"."))
- +66 SET ECPTTM=$PIECE(X,U)
- SET ECPTPR=$PIECE(X,U,2)
- SET ECCLAS=$PIECE(X,U,3)
- SET ECPTNPI=$PIECE(X,U,4)
- +67 SET ECASPR=$PIECE(X,U,5)
- SET ECCLAS2=$PIECE(X,U,6)
- SET ECASNPI=$PIECE(X,U,7)
- +68 QUIT
- +69 ;
- FILE ;file record
- +1 ;node0
- +2 ;facility^dfn^ssn^name^in/out^day^drug category^quantity^ward^
- +3 ;provider^cost^mov #^treat spec^ndc^new feeder key^investigational^
- +4 ;udp time^adm date^adm time
- +5 ;node1
- +6 ;mpi^placeholder^provider npi^dom^observ pat ind^encounter num^
- +7 ;prod div code^means tst^elig^dob^sex^state^county^zip+4^vet^
- +8 ;period of svc^pow stat^pow loc^ir status^ao status^ao loc^
- +9 ;purple heart ind.^mst status^cnh/sh status^enrollment loc^
- +10 ;enrollment cat^enrollment status^enrollment priority^Placehold pc team^
- +11 ;Placehold pc provider^pc provider npi^Placehold pc provider p.class^Placehold assoc. pc provider^
- +12 ;assoc. pc provider npi^Placehold assoc. pc provider p.class
- +13 ;node2
- +14 ;ordering date^ordering stop code^head & neck cancer ind.^Placehold ethnicity^
- +15 ;Placehold race1^bcma drug dispensed^bcma dose given^bcma unit of
- +16 ;administration^bcma icu flag^ordering provider person class^
- +17 ;^enrollment priority ECXPRIOR_enrollment subgroup
- +18 ;ECXSBGRP^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet
- +19 ;elig ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible
- +20 ;ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA)
- +21 ;ECXERI^environ contamin ECXEST^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^Placehold associate pc provider npi ECASNPI^Placehold primary care provider npi ECPTNPI^provider npi ECXPRNPI
- +22 ;^country ECXCNTRY^PATCAT^Encounter SC ECXESC^Camp Lejeune Status ECXCLST^Encounter Camp Lejeune ECXECL
- +23 ;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL) ^ New Script (ECXNEW)
- +24 ;^Patient Division (ECXSTANO)
- +25 ;Node 3
- +26 ;Vista DEA Special Hdlg (ECXDEA)
- +27 ;Node 4 ;184
- +28 ;Placehold Cerner (ECXCERN)^
- +29 ;Node 5 ;184
- +30 ;New MPI (ECXNMPI^Self Identified Gender (ECXSIGI)^Price Per Dispense Unit ECXPPDU^Dispense Unit^Dispense UNit
- +31 ;
- +32 ;convert specialty to PTF Code for transmission
- +33 NEW ECXDATA
- +34 SET ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
- +35 SET ECXTS=$GET(ECXDATA(7))
- +36 ;done
- +37 NEW DA,DIK
- +38 SET EC7=$ORDER(^ECX(ECFILE,999999999),-1)
- SET EC7=EC7+1
- +39 ;170 Fields will now be null
- IF ECXLOGIC>2018
- SET (ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)=""
- +40 ;178 Means Test field will now be null
- IF ECXLOGIC>2020
- SET ECXMTST=""
- +41 ;184 - field retired
- IF ECXLOGIC>2022
- SET ECXMPI=""
- +42 SET ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
- +43 SET ECODE=ECODE_ECXUDDT_U_ECCAT_U_ECXQTY_U_ECXW_U_ECXPRO_U_ECXCOST_U
- +44 SET ECODE=ECODE_ECXMN_U_ECXTS_U_ECNDC_U_ECNFC_U_ECINV_U_ECXUDTM_U
- +45 SET ECODE=ECODE_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U
- +46 SET ECODE=ECODE_$$ECXTIME^ECXUTL(ECXADM)_U
- +47 SET ECODE1=ECXMPI_U_ECXDSSD_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U
- +48 SET ECODE1=ECODE1_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U_ECXSEX_U
- +49 SET ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U
- +50 SET ECODE1=ECODE1_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U
- +51 SET ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXCNHU_U_ECXENRL_U
- +52 SET ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$SELECT(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_ECPTTM_U_ECPTPR_U
- +53 SET ECODE1=ECODE1_U_ECCLAS_U_ECASPR_U_U_ECCLAS2_U
- +54 SET ECODE2=ECXORDDT_U_ECXORDST_U_ECXHNCI_U_ECXETH_U_ECXRC1
- +55 IF ECXLOGIC>2003
- SET ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC
- +56 IF ECXLOGIC>2004
- SET ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
- +57 IF ECXLOGIC>2006
- SET ECODE2=ECODE2_U_ECXERI_U_ECXEST
- +58 IF ECXLOGIC>2007
- SET ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECXPRNPI
- +59 IF ECXLOGIC>2009
- SET ECODE2=ECODE2_U_ECXCNTRY
- +60 ; 127 PATCAT ADDED
- IF ECXLOGIC>2010
- SET ECODE2=ECODE2_U_ECXPATCAT
- +61 ;144
- IF ECXLOGIC>2013
- SET ECODE2=ECODE2_U_ECXESC_U_ECXCLST_U_ECXECL
- +62 ;149
- IF ECXLOGIC>2014
- SET ECODE2=ECODE2_U_ECXSVCI_U_ECXSVCL_U_ECXNEW
- +63 ;166 tjl,174
- IF ECXLOGIC>2017
- SET ECODE2=ECODE2_U_ECXSTANO_$SELECT(ECXLOGIC>2019:"^",1:"")
- +64 ;174 ,184 - Added "^"
- IF ECXLOGIC>2019
- SET ECODE3=ECXDEA_U
- +65 ;184
- IF ECXLOGIC>2022
- SET ECODE4=$GET(ECXCERN)_U
- SET ECODE5=ECXNMPI_U_ECXSIGI
- +66 ;187
- IF ECXLOGIC>2023
- SET ECODE5=ECODE5_U_ECXPPDU_U_ECXDUNIT
- +67 SET ^ECX(ECFILE,EC7,0)=ECODE
- SET ^ECX(ECFILE,EC7,1)=ECODE1
- +68 ;S ECRN=ECRN+1 ;174,184 - Moved record count to below
- SET ^ECX(ECFILE,EC7,2)=ECODE2
- if ECXLOGIC>2019
- SET ^ECX(ECFILE,EC7,3)=ECODE3
- +69 ;184
- SET ^ECX(ECFILE,EC7,4)=$GET(ECODE4)
- SET ^ECX(ECFILE,EC7,5)=$GET(ECODE5)
- +70 ;184 - Moved record count from above
- SET ECRN=ECRN+1
- +71 SET DA=EC7
- SET DIK="^ECX("_ECFILE_","
- DO IX1^DIK
- KILL DIK,DA
- +72 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET QFLG=1
- +73 QUIT
- +74 ;
- NEW() ;149 Function added to determine if script had pharmacist involvement
- +1 NEW ALIEN,ADATE,SCRIPT,VDATE,DONE,IENS
- +2 SET SCRIPT="N"
- SET VDATE=""
- SET DONE=0
- +3 SET ALIEN=0
- FOR
- SET ALIEN=$ORDER(^PS(55,ECXDFN,5,ON,9,ALIEN))
- if '+ALIEN!(DONE)
- QUIT
- SET IENS=ALIEN_","_ON_","_ECXDFN_","
- Begin DoDot:1
- +4 SET ADATE=$$GET1^DIQ(55.09,IENS,".01","I")
- +5 ;If date of activity is after dispense date then stop
- IF $PIECE(ADATE,".")>ECD
- SET DONE=1
- QUIT
- +6 ;if activity status is verified by pharmacist or verified by pharmacist renewal
- IF "^VP^VPR^"[("^"_$$GET1^DIQ(55.09,IENS,"2:1")_"^")
- SET VDATE=ADATE
- End DoDot:1
- +7 IF VDATE'=""
- Begin DoDot:1
- +8 IF '$DATA(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON))!($GET(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON))=ECXJ)
- SET SCRIPT="Y"
- +9 ;Store first instance of med given
- IF '$DATA(^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON))
- SET ^XTMP("ECXSCRIPT",VDATE,ECXDFN,ON)=ECXJ
- End DoDot:1
- +10 QUIT SCRIPT
- +11 ;
- CLEAN(START,END) ;149 Section added to delete old log entries
- +1 NEW DATE,PAT,ON
- +2 SET DATE=START
- FOR
- SET DATE=$ORDER(^XTMP("ECXSCRIPT",DATE))
- if '+DATE!(DATE>END)
- QUIT
- SET PAT=0
- FOR
- SET PAT=$ORDER(^XTMP("ECXSCRIPT",DATE,PAT))
- if '+PAT
- QUIT
- SET ON=0
- FOR
- SET ON=$ORDER(^XTMP("ECXSCRIPT",DATE,PAT,ON))
- if '+ON
- QUIT
- KILL ^XTMP("ECXSCRIPT",DATE,PAT,ON)
- +3 SET ^XTMP("ECXSCRIPT",0)=$$FMADD^XLFDT($$DT^XLFDT,365)_"^"_$$DT^XLFDT_"^"_"Log of pharmacy orders that have already been counted"
- +4 QUIT
- +5 ;
- SETUP ;Set required input for ECXTRAC
- +1 SET ECHEAD="UDP"
- +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
- +3 ;
- SETTMP(STR) ;181 - Set global TMP for Mail Message
- +1 NEW CLIN,SCODE,DIC,ECXDIC,ECXDICA,ECXNOSC,ECXINVSC,DIQ,DR,DA
- +2 IF $PIECE(STR,U,2)="MISSING STOP CODE"
- Begin DoDot:1
- +3 SET CLIN=$PIECE(STR,U)
- +4 IF $DATA(^TMP($JOB,"ECXUDM","NOSC",CLIN))
- QUIT
- +5 IF '$DATA(^TMP($JOB,"ECXUDM","ECXNOSC"))
- SET ^TMP($JOB,"ECXUDM","ECXNOSC")=0
- +6 SET ECXNOSC=^TMP($JOB,"ECXUDM","ECXNOSC")+1
- +7 SET DIC="^SC("
- SET DIQ="IE"
- SET DIQ="ECXDIC"
- SET DR=".01"
- SET DA=CLIN
- DO EN^DIQ1
- +8 SET ^TMP($JOB,"ECXUDM","ECXNOSC",ECXNOSC,0)=$JUSTIFY(CLIN,8)_" "_$$LJ^XLFSTR(ECXDIC(44,CLIN,.01),32)
- +9 SET ^TMP($JOB,"ECXUDM","ECXNOSC")=ECXNOSC
- +10 SET ^TMP($JOB,"ECXUDM","NOSC",CLIN)=""
- End DoDot:1
- QUIT
- +11 IF $PIECE(STR,U,2)="INVALID STOP CODE"
- Begin DoDot:1
- +12 SET CLIN=$PIECE(STR,U)
- SET SCODE=$PIECE(STR,U,3)
- +13 IF $DATA(^TMP($JOB,"ECXUDM","INVSC",CLIN))
- QUIT
- +14 IF '$DATA(^TMP($JOB,"ECXUDM","ECXINVSC"))
- SET ^TMP($JOB,"ECXUDM","ECXINVSC")=0
- +15 SET ECXINVSC=^TMP($JOB,"ECXUDM","ECXINVSC")+1
- +16 SET DIC="^SC("
- SET DIQ="IE"
- SET DIQ="ECXDIC"
- SET DR=".01"
- SET DA=CLIN
- DO EN^DIQ1
- +17 SET DIC="^DIC(40.7,"
- SET DIQ(0)="E"
- SET DIQ="ECXDICA"
- SET DR=".01;1;2"
- SET DA=SCODE
- DO EN^DIQ1
- +18 SET ^TMP($JOB,"ECXUDM","ECXINVSC",ECXINVSC,0)=$JUSTIFY(CLIN,8)_"/"_$$LJ^XLFSTR(ECXDIC(44,CLIN,.01),25)_" "_$JUSTIFY(ECXDICA(40.7,SCODE,1,"E"),8)_"/"_$$LJ^XLFSTR(ECXDICA(40.7,SCODE,.01,"E"),25)
- +19 SET ^TMP($JOB,"ECXUDM","ECXINVSC")=ECXINVSC
- +20 SET ^TMP($JOB,"ECXUDM","INVSC",CLIN)=""
- End DoDot:1
- +21 QUIT