Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSURG.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DSS_EXTRACTS-ECX/ECXSURG.m (modified) (8 diffs)

FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSURG.m

@@ -1 @@
-ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/20/07 8:13am
- ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99,105**;Dec 22, 1997;Build 70
+ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/2/06 9:00am
+ ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99**;Dec 22, 1997;Build 2
 BEG ;entry point from option
  D SETUP I ECFILE="" Q
@@ -16 +16 @@
  N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,ECXNONL,ECXSTOP,TIMEDIF
  N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC
- N ECXCRST,ECXSTCD,ECXCLIN
  S ECXDATE=ECD,ECXERR=0,ECXQ=""
  Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
  I ECXADMDT="" S ECXADD=ECXADMDT
  I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)
- 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 EC0=^SRF(ECD0,0)
  S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"")
  S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"")
+ ;S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"")
  S DATAOP=$S($D(^SRO(136,ECD0,0)):^(0),1:"")
  S ECNO=$G(^SRF(ECD0,"NON"))
  ;get data
  S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13)
- S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
- S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)
  ;-Time patient in OR room (Nurse Time)
  S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10))
@@ -40 +33 @@
  N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV)  ;Production Division
  S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2)
- S ECSANPI=$$NPI^XUSNPI("Individual_ID",ECSA,ECXDATE)
- S:+ECSANPI'>0 ECSANPI="" S ECSANPI=$P(ECSANPI,U)
  ;get principle anesthetist and person class DBIA #103
  S ECXPA=$P($G(^SRF(ECD0,.3)),U,1)
- S ECPANPI=$$NPI^XUSNPI("Individual_ID",ECXPA,ECXDATE)
- S:+ECPANPI'>0 ECPANPI="" S ECPANPI=$P(ECPANPI,U)
  S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE)
  S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U)
@@ -61 +50 @@
  I $P(ECNO,U)="Y" D
  .S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7)
- .S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
- .S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)
- .S ECATNPI=$$NPI^XUSNPI("Individual_ID",ECAT,ECXDATE)
- .S:+ECATNPI'>0 ECATNPI="" S ECATNPI=$P(ECATNPI,U)
  .S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4))
  .S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME
@@ -72 +57 @@
  .;- Get DSS Stop Code to use in encounter number
  .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4)
- ;
- ;- Get credit stop, stop code and clinic
- I $$SUR^ECXUTL6(.ECXCRST,.ECXSTCD,.ECXCLIN)
  ;
  ;- If surgery cancelled/aborted quit and go to next record
@@ -154 +136 @@
  S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC=""
  ;
- ;- Get postop diagnosis codes
- I $$SURPODX^ECXUTL6(.ECXPODX,.ECXPODX1,.ECXPODX2,.ECXPODX3,.ECXPODX4,.ECXPODX5)
- ;
- D FILE^ECXSURG1
+ D FILE
  ;get secondary procedures
  ;ecode0=s^cpt code
  S ECXJ=0
+ ;F  S ECXJ=$O(^SRF(ECD0,13,ECXJ)) Q:'ECXJ  I $D(^(ECXJ,0)),$D(^(2)),$P(^(2),U)]"" D
  F  S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ  I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D
  .;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD=""
- .S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),U),ECXMOD=""
- .S ECPT=$P(^(0),"^"),ECXCMOD=""
+ . S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),"^"),ECXCMOD=""
  .K ARR,ERR
  .D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D
@@ -174 +153 @@
  .S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD)
  .S ECODE0="S"_U   ;_ECPT
- .D FILE^ECXSURG1
+ .D FILE
  ;get prostheses
  ;ecode0=i^^^^^^prosthesis^old qty field (null)
@@ -181 +160 @@
  .S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1
  .S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U
- .D FILE^ECXSURG1
- Q
- ;
+ .D FILE
+ Q
+ ;
+FILE ;file record
+ ;node0
+ ;division^dfn^ssn^name^in/out (ECXA)^day^case #^
+ ;surg specialty^or room #^
+ ;surgeon^attending^anesthesia supervisor^anesthesia technique^
+ ;primary/secondary/prostheses^cpt^^pt time^op time^anes time^
+ ;prostheses^qty^^
+ ;movement number^treating specialty^cancel/abort (ECCAN)^time^or type^
+ ;attending's service^non-or dss id^recovery room time^^
+ ;primary care team^primary care provider^admission date
+ ;node1
+ ;mpi^dss dept ECXDSSD^surgeon npi^attending npi^anes supervisor npi^
+ ;pc provider npi^pc prov person class^
+ ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^
+ ;cpt&modifiers ECXCPT^dom ECXDOM^enrollment category ECXCAT^
+ ;enrollment status ECXSTAT^enrollment priority ECXPRIOR^
+ ;period of service ECXPOS^purple heart indicator ECXPHI^
+ ;observ pat ind ECXOBS^encounter num ECXENC^ao loc ECXAOL^
+ ;production division ECXPDIV^head & neck canc ind ECXHNCI^
+ ;ethnicity ECXETH^race1 ECXRC1^new quantity ECXQ^
+ ;^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig
+ ;ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC
+ ;or clean time ECXORCT^time pt in hold area ECXPTHA^national patient
+ ;record flag ECXNPRFI^princ anesthetist ECXPA^surgeon per class ECSRPC
+ ;node2
+ ;atten surgeon per class ECATPC^anesthesia super person class ECSAPC^
+ ;princ anesthetist PC ECXPAPC^emergency response indicator(FEMA) ECXERI^
+ ;agent orange indic ECXAO^head/neck cancer ECXHNC
+ ;
+ N DA,DIK,STR
+ S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
+ S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
+ S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECD0_U_ECSS_U_ECO_U
+ S ECODE=ECODE_ECSR_U_ECAT_U_ECSA_U_ECANE_U_ECODE0_U
+ S STR=ECXMN_U_ECXTS_U_$S(ECCAN'="":ECCAN,1:"")_U_ECXTM_U_ECORTY_U
+ S STR=STR_ECATSV_U_ECNL_U_ECRR_U_U_ECPTTM_U_ECPTPR_U_ECXADD_U
+ S $P(ECODE,U,26,38)=STR
+ S ECODE1=ECXMPI_U_ECXDSSD_U_ECSRNPI_U_ECATNPI_U_ECSANPI_U_ECPTNPI_U
+ S ECODE1=ECODE1_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXCPT_U_ECXDOM_U
+ S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U
+ S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXPDIV_U_ECXHNCI_U
+ S ECODE1=ECODE1_ECXETH_U_ECXRC1_U_ECXQ_U
+ I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXORCT_U_ECXPTHA_U_ECXNPRFI
+ I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXPA_U_ECSRPC_U,ECODE2=ECATPC_U_ECSAPC_U_ECXPAPC
+ I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXHNC
+ S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1
+ S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
+ I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
  ;
 TIME ; given date/time get increment