Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPIVDN.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPIVDN.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPIVDN.m
r613 r623 1 ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 10/31/07 1:38pm 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107,105**;Dec 22, 1997;Build 70 3 BEG ;entry point from option 4 D SETUP I ECFILE="" Q 5 D ^ECXTRAC,^ECXKILL 6 Q 7 ; 8 START ; start package specific extract 9 N DIC,DA,DR,DIQ,DFN,ECXNPRFI,ECXPHA 10 S QFLG=0 11 I '$D(ECINST) D 12 .S ECINST=+$P(^ECX(728,1,0),U) K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99" 13 .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC 14 S ECED=ECED+.3 15 K ^TMP($J,"A"),^TMP($J,"S") 16 S ECD=ECSD1 17 F S ECD=$O(^ECX(728.113,"A",ECD)),DFN=0 Q:'ECD Q:ECD>ECED Q:QFLG F S DFN=$O(^ECX(728.113,"A",ECD,DFN)),ON=0 Q:'DFN F S ON=$O(^ECX(728.113,"A",ECD,DFN,ON)),DA=0 Q:'ON K ^TMP($J,"A"),^TMP($J,"S") S ECVOL=0 D Q:QFLG 18 .S ECXERR=0 D PAT(DFN,ECD,.ECXERR) 19 .Q:ECXERR 20 .F S DA=$O(^ECX(728.113,"A",ECD,DFN,ON,DA)) Q:'DA Q:QFLG I $D(^ECX(728.113,DA,0)) S EC=^(0) D Q:QFLG 21 ..S DRG=$P(EC,U,4) I $P(EC,U,8)]"" D 22 ...I '$D(^TMP($J,"A",DRG)) S ^(DRG)=$P(EC,U,7,8),^(DRG,1)=0,^(2)=$P(EC,U,12) 23 ...S ^(1)=^TMP($J,"A",DRG,1)+$S($P(EC,U,6)=1:1,$P(EC,U,6)=4:0,1:-1) 24 ..I $P(EC,U,9) D 25 ...I '$D(^TMP($J,"S",DRG)) S ^(DRG)=$P(EC,U,9)_"^ML",^(DRG,1)=0,^(2)=$P(EC,U,12),ECVOL=$P(EC,U,9)+ECVOL 26 ...S ^(1)=^TMP($J,"S",DRG,1)+$S($P(EC,U,6)=1:1,$P(EC,U,6)=4:0,1:-1) 27 ..S ECTYP=$P(EC,U,11),ECTOTC=0,ECDTTM=$$ECXTIME^ECXUTL($P(EC,U,5)) 28 .;looped thru all DAs for this order - now put it together 29 .;leave the next line in case the decision is made to send volume designations 30 .;I ECTYP="H" S ECTYP=ECTYP_$S(ECVOL'>1000:1,ECVOL'>2000:2,1:3) 31 .S ECXDSSI="" 32 .;loop thru tmp global and call pharmacy drug file (#50) api 33 .F SA="S","A" S DRG="" F S DRG=$O(^TMP($J,SA,DRG)) Q:DRG="" S ECXPHA="",ECXPHA=$$PHAAPI^ECXUTL5(DRG) I $P(ECXPHA,U)'="" D STUFF Q:QFLG 34 K ^TMP($J),CLIN,DA,DFN,DIC,DIK,DRG,ON,SA,X,Y,P1,P3 35 Q 36 STUFF ;get data 37 N ECORDST 38 S ECST=^TMP($J,SA,DRG),ECXCNT=^(DRG,1),ECXCOST=^(2),ECXCOST=ECXCOST*ECXCNT,ECVACL=$P(ECXPHA,U,2),ECORDST="" 39 ;if outpatient get division from iv rm; get dss identifier for clinic 40 I ECXA="O" D 41 .;- Only set ward to .5 if outpatient (but NOT observation patient) 42 .I $G(ECXW)="" S ECXW=.5 43 .I $P(EC,U,15) S ECIVRM=$P(EC,U,15),ECXDIV=$$PSJ59P5^ECXUTL5(ECIVRM) 44 .S CLIN=+$P(EC,U,13),(ECXP1,ECXP2)="000",ECXCL=$G(^ECX(728.44,CLIN,0)) Q:ECXCL="" 45 .S ECSC=$P(ECXCL,U,4),ECCSC=$P(ECXCL,U,5) 46 .I ECSC="" S ECSC=$P(ECXCL,U,2),ECCSC=$P(ECXCL,U,3) 47 .I ECSC S ECXP1=$$RJ^XLFSTR(ECSC,3,0),ECXP2=$$RJ^XLFSTR(ECCSC,3,0) 48 .I ECSC="" S ECSC=$P($G(^SC(ECXCL,0)),U,7),ECCSC=$P($G(^SC(ECXCL,0)),U,18) I ECSC D 49 ..S ECXP1=$P($G(^DIC(40.7,ECSC,0)),U,2) S:ECCSC]"" ECXP2=$P($G(^DIC(40.7,ECCSC,0)),U,2) 50 ..S ECXP1=$$RJ^XLFSTR(ECXP1,3,0),ECXP2=$$RJ^XLFSTR(ECXP2,3,0) 51 .S ECXDSSI=ECXP1_ECXP2 52 .I ECXLOGIC>2003 D 53 ..I "^18^23^24^36^41^65^94^"[("^"_ECXTS_"^") S ECXDSSI=$$TSMAP^ECXUTL4(ECXTS) 54 S ECINV=$P(ECXPHA,U,4),ECINV=$S(ECINV["I":"I",1:""),ECST=ECXCNT*ECST_" "_$P(ECST,U,2) 55 S ECNDC=$P(ECXPHA,U,3),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) 56 S P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6) 57 S X="PSNAPIS" X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC 58 I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC 59 ;- Ordering provider ("2"_provider) 60 S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:"") 61 N ECXUSRTN 62 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$P(EC,U,10),$P(EC,U,16)) 63 S:+ECXUSRTN'>0 ECXUSRTN="" S ECXOPNPI=$P(ECXUSRTN,U) 64 S ECXORDDT=$P(EC,U,16) ;- Ordering date 65 ;- Requesting physician (null for FY2002) 66 S ECXRPHY="" 67 ;- Department and National Prod Division 68 S ECXDSSD="" ;dss department use postponed $$IVP^ECXDEPT(ECXDIV) 69 N ECXPDIV S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) 70 ;- Observation patient indicator (yes/no) 71 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXDSSI) 72 ; - Ordering Date, Ordering Stop Code 73 S ECXORDST="" I ECXA="O" D 74 .S ECXORDST=$$DOIVPO^ECXUTL5(DFN,ON) 75 .I ECXOBS="NO" S ECORDST="160" 76 .I ECXOBS="YES" S ECORDST=$P($G(^ECX(727.831,+ECXTS,0)),U,6) 77 ;- If no encounter number don't file record 78 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADM,ECD,ECXTS,ECXOBS,ECHEAD,ECORDST,) 79 ;get BCMA data 80 S (ECXBCDD,ECXBCDG,ECXBCUA,ECXBCIF)="" 81 ;get ordering provider person class 82 S ECXOPPC=$$PRVCLASS^ECXUTL($E(ECXORDPR,2,999),ECXORDDT) 83 ;set national patient record flag if exist 84 S ECXDFN=DFN D NPRF^ECXUTL5 K ECXDFN 85 D:ECXENC'="" FILE^ECXPIVD2 K P1,P3 86 Q 87 PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographics, primary care, and inpatient data 88 N X 89 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)="" 90 ;get patient data if saved 91 I $D(^TMP($J,"ECXP",ECXDFN)) D 92 .S PT=^TMP($J,"ECXP",ECXDFN),ECXPNM=$P(PT,U),ECXSSN=$P(PT,U,2),ECXMPI=$P(PT,U,3) 93 .S ECXDOB=$P(PT,U,4),ECXELIG=$P(PT,U,5),ECXSEX=$P(PT,U,6),ECXSTATE=$P(PT,U,7),ECXCNTY=$P(PT,U,8),ECXZIP=$P(PT,U,9) 94 .S ECXVET=$P(PT,U,10),ECXPOS=$P(PT,U,11),ECXPST=$P(PT,U,12),ECXPLOC=$P(PT,U,13),ECXRST=$P(PT,U,14),ECXAST=$P(PT,U,15) 95 .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18),ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21) 96 .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24),ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27) 97 .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) 98 .I $$ENROLLM^ECXUTL2(ECXDFN) 99 ;set patient data 100 I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK 101 .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;5",.ECXPAT) 102 .I 'OK K ECXPAT S ECXERR=1 Q 103 .S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG"),ECXSEX=ECXPAT("SEX") 104 .S ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP"),ECXVET=ECXPAT("VET") 105 .S ECXPOS=ECXPAT("POS"),ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT") 106 .S ECXAST=ECXPAT("AO STAT"),ECXAOL=ECXPAT("AOL"),ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT") 107 .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS"),ECXEST=ECXPAT("EC STAT") 108 .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN) ;get CNHU status 109 .;get enrollment data (category, status and priority) 110 .I $$ENROLLM^ECXUTL2(ECXDFN) 111 .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) ;Head and Neck Cancer Indicator 112 .; - Race and Ethnicity 113 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") 114 .S ECXERI=ECXPAT("ERI") ;emergency response indicator (FEMA) 115 .S ECXOEF=ECXPAT("ECXOEF") 116 .S ECXOEFDT=ECXPAT("ECXOEFDT") 117 .;save for later 118 .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 119 .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 120 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT 121 ;get primary care data 122 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,".")) 123 S ECPTTM=$P(X,U,1),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4),ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7) 124 ;get inpatient data 125 S (ECXA,ECXMN,ECXADM,ECXTS,ECXW,ECXDIV)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) 126 S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),W=$P(X,U,9),ECXDOM=$P(X,U,10),ECXW=$P(W,";"),ECXDIV=$P(W,";",2) 127 Q 128 SETUP ;Set required input for ECXTRAC 129 S ECHEAD="IVP" 130 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 131 ;variables ecver and ecrtn will be reset in routine ecxtrac if appropriate 132 S ECVER=7 133 Q 134 QUE ; entry point for the background requeuing handled by ECXTAUTO 135 D SETUP,QUE^ECXTAUTO,^ECXKILL Q 1 ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 4/19/2007 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107**;Dec 22, 1997;Build 9 3 START ; start package specific extract 4 N DIC,DA,DR,DIQ,DFN,ECXNPRFI,ECXPHA 5 S QFLG=0 6 I '$D(ECINST) D 7 .S ECINST=+$P(^ECX(728,1,0),U) K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99" 8 .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC 9 S ECED=ECED+.3 10 K ^TMP($J,"A"),^TMP($J,"S") 11 S ECD=ECSD1 12 F S ECD=$O(^ECX(728.113,"A",ECD)),DFN=0 Q:'ECD Q:ECD>ECED Q:QFLG F S DFN=$O(^ECX(728.113,"A",ECD,DFN)),ON=0 Q:'DFN F S ON=$O(^ECX(728.113,"A",ECD,DFN,ON)),DA=0 Q:'ON K ^TMP($J,"A"),^TMP($J,"S") S ECVOL=0 D Q:QFLG 13 .S ECXERR=0 D PAT(DFN,ECD,.ECXERR) 14 .Q:ECXERR 15 .F S DA=$O(^ECX(728.113,"A",ECD,DFN,ON,DA)) Q:'DA Q:QFLG I $D(^ECX(728.113,DA,0)) S EC=^(0) D Q:QFLG 16 ..S DRG=$P(EC,U,4) I $P(EC,U,8)]"" D 17 ...I '$D(^TMP($J,"A",DRG)) S ^(DRG)=$P(EC,U,7,8),^(DRG,1)=0,^(2)=$P(EC,U,12) 18 ...S ^(1)=^TMP($J,"A",DRG,1)+$S($P(EC,U,6)=1:1,$P(EC,U,6)=4:0,1:-1) 19 ..I $P(EC,U,9) D 20 ...I '$D(^TMP($J,"S",DRG)) S ^(DRG)=$P(EC,U,9)_"^ML",^(DRG,1)=0,^(2)=$P(EC,U,12),ECVOL=$P(EC,U,9)+ECVOL 21 ...S ^(1)=^TMP($J,"S",DRG,1)+$S($P(EC,U,6)=1:1,$P(EC,U,6)=4:0,1:-1) 22 ..S ECTYP=$P(EC,U,11),ECTOTC=0,ECDTTM=$$ECXTIME^ECXUTL($P(EC,U,5)) 23 .;looped thru all DAs for this order - now put it together 24 .;leave the next line in case the decision is made to send volume designations 25 .;I ECTYP="H" S ECTYP=ECTYP_$S(ECVOL'>1000:1,ECVOL'>2000:2,1:3) 26 .S ECXDSSI="" 27 .;loop thru tmp global and call pharmacy drug file (#50) api 28 .F SA="S","A" S DRG="" F S DRG=$O(^TMP($J,SA,DRG)) Q:DRG="" S ECXPHA="",ECXPHA=$$PHAAPI^ECXUTL5(DRG) I $P(ECXPHA,U)'="" D STUFF Q:QFLG 29 K ^TMP($J),CLIN,DA,DFN,DIC,DIK,DRG,ON,SA,X,Y,P1,P3 30 Q 31 STUFF ;get data 32 N ECORDST 33 S ECST=^TMP($J,SA,DRG),ECXCNT=^(DRG,1),ECXCOST=^(2),ECXCOST=ECXCOST*ECXCNT,ECVACL=$P(ECXPHA,U,2),ECORDST="" 34 ;if outpatient get division from iv rm; get dss identifier for clinic 35 I ECXA="O" D 36 .;- Only set ward to .5 if outpatient (but NOT observation patient) 37 .I $G(ECXW)="" S ECXW=.5 38 .I $P(EC,U,15) S ECIVRM=$P(EC,U,15),ECXDIV=$$PSJ59P5^ECXUTL5(ECIVRM) 39 .S CLIN=+$P(EC,U,13),(ECXP1,ECXP2)="000",ECXCL=$G(^ECX(728.44,CLIN,0)) Q:ECXCL="" 40 .S ECSC=$P(ECXCL,U,4),ECCSC=$P(ECXCL,U,5) 41 .I ECSC="" S ECSC=$P(ECXCL,U,2),ECCSC=$P(ECXCL,U,3) 42 .I ECSC S ECXP1=$$RJ^XLFSTR(ECSC,3,0),ECXP2=$$RJ^XLFSTR(ECCSC,3,0) 43 .I ECSC="" S ECSC=$P($G(^SC(ECXCL,0)),U,7),ECCSC=$P($G(^SC(ECXCL,0)),U,18) I ECSC D 44 ..S ECXP1=$P($G(^DIC(40.7,ECSC,0)),U,2) S:ECCSC]"" ECXP2=$P($G(^DIC(40.7,ECCSC,0)),U,2) 45 ..S ECXP1=$$RJ^XLFSTR(ECXP1,3,0),ECXP2=$$RJ^XLFSTR(ECXP2,3,0) 46 .S ECXDSSI=ECXP1_ECXP2 47 .I ECXLOGIC>2003 D 48 ..I "^18^23^24^36^41^65^94^"[("^"_ECXTS_"^") S ECXDSSI=$$TSMAP^ECXUTL4(ECXTS) 49 S ECINV=$P(ECXPHA,U,4),ECINV=$S(ECINV["I":"I",1:""),ECST=ECXCNT*ECST_" "_$P(ECST,U,2) 50 S ECNDC=$P(ECXPHA,U,3),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) 51 S P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6) 52 S X="PSNAPIS" X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC 53 I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC 54 ;- Ordering provider ("2"_provider) 55 S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:""),ECXOPNPI="" 56 S ECXORDDT=$P(EC,U,16) ;- Ordering date 57 ;- Requesting physician (null for FY2002) 58 S ECXRPHY="" 59 ;- Department and National Prod Division 60 S ECXDSSD="" ;dss department use postponed $$IVP^ECXDEPT(ECXDIV) 61 N ECXPDIV S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) 62 ;- Observation patient indicator (yes/no) 63 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXDSSI) 64 ; - Ordering Date, Ordering Stop Code 65 S ECXORDST="" I ECXA="O" D 66 .S ECXORDST=$$DOIVPO^ECXUTL5(DFN,ON) 67 .I ECXOBS="NO" S ECORDST="160" 68 .I ECXOBS="YES" S ECORDST=$P($G(^ECX(727.831,+ECXTS,0)),U,6) 69 ;- If no encounter number don't file record 70 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADM,ECD,ECXTS,ECXOBS,ECHEAD,ECORDST,) 71 ;get BCMA data 72 S (ECXBCDD,ECXBCDG,ECXBCUA,ECXBCIF)="" 73 ;get ordering provider person class 74 S ECXOPPC=$$PRVCLASS^ECXUTL($E(ECXORDPR,2,999),ECXORDDT) 75 ;set national patient record flag if exist 76 S ECXDFN=DFN D NPRF^ECXUTL5 K ECXDFN 77 D:ECXENC'="" FILE K P1,P3 78 Q 79 PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographics, primary care, and inpatient data 80 N X 81 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)="" 82 ;get patient data if saved 83 I $D(^TMP($J,"ECXP",ECXDFN)) D 84 .S PT=^TMP($J,"ECXP",ECXDFN),ECXPNM=$P(PT,U),ECXSSN=$P(PT,U,2),ECXMPI=$P(PT,U,3) 85 .S ECXDOB=$P(PT,U,4),ECXELIG=$P(PT,U,5),ECXSEX=$P(PT,U,6),ECXSTATE=$P(PT,U,7),ECXCNTY=$P(PT,U,8),ECXZIP=$P(PT,U,9) 86 .S ECXVET=$P(PT,U,10),ECXPOS=$P(PT,U,11),ECXPST=$P(PT,U,12),ECXPLOC=$P(PT,U,13),ECXRST=$P(PT,U,14),ECXAST=$P(PT,U,15) 87 .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18),ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21) 88 .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24),ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27) 89 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) 90 .I $$ENROLLM^ECXUTL2(ECXDFN) 91 ;set patient data 92 I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK 93 .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;5",.ECXPAT) 94 .I 'OK K ECXPAT S ECXERR=1 Q 95 .S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG"),ECXSEX=ECXPAT("SEX") 96 .S ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP"),ECXVET=ECXPAT("VET") 97 .S ECXPOS=ECXPAT("POS"),ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT") 98 .S ECXAST=ECXPAT("AO STAT"),ECXAOL=ECXPAT("AOL"),ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT") 99 .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS"),ECXEST=ECXPAT("EC STAT") 100 .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN) ;get CNHU status 101 .;get enrollment data (category, status and priority) 102 .I $$ENROLLM^ECXUTL2(ECXDFN) 103 .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) ;Head and Neck Cancer Indicator 104 .; - Race and Ethnicity 105 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") 106 .S ECXERI=ECXPAT("ERI") ;emergency response indicator (FEMA) 107 .;save for later 108 .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 109 .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 110 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST 111 ;get primary care data 112 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,".")) 113 S ECPTTM=$P(X,U,1),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4),ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7) 114 ;get inpatient data 115 S (ECXA,ECXMN,ECXADM,ECXTS,ECXW,ECXDIV)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) 116 S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),W=$P(X,U,9),ECXDOM=$P(X,U,10),ECXW=$P(W,";"),ECXDIV=$P(W,";",2) 117 Q 118 FILE ;file record 119 ;node0 120 ;fac^dfn^ssn^name^i/o^day^va class^qty^ward^cost^movement #^treat spec^ndc^investigational^iv dispensing fee^new feeder key^total doses^ 121 ;primary care team^primary care provider^ivp time^adm date^adm time^dss identifier 122 ;node1 123 ;mpi^dss dept^pc provider npi^pc prov person class^assoc pc provider^assoc pc prov person class^assoc pc prov npi^dom^obs pat ind^enc num^ 124 ;ord pr^ordering stop code^ord dt^req phys^nat prod division^means tst^elig^dob^sex^state^county^zip+4^vet^period of svc^pow stat^pow loc^ir stat^ao stat^ 125 ;ao loc^purple heart ind.^mst stat^enrollment loc^enrollment cat^enrollment stat^enrollment prior^cnh/sh stat^ord pr npi 126 ;node2 127 ;head & neck cancer ind.^ethnicity^race1^bcma drug dispensed^bcma dose given^bcma unit of administration^bcma ICU flag^ 128 ;ordering provider person class^^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig ECXCVE^ 129 ;combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA) ECXERI^ 130 ;environ contamin ECXEST 131 N DA,DIK 132 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 133 S ECODE=EC7_U_EC23_U_ECXDIV_U_DFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 134 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U_ECVACL_U_ECXCNT_U_ECXW_U 135 ;convert specialty to PTF Code for transmission 136 N ECXDATA 137 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA) 138 S ECXTS=$G(ECXDATA(7)) 139 ;done 140 S ECODE=ECODE_ECXCOST_U_ECXMN_U_ECXTS_U_ECNDC_U_ECINV_U_ECTYP_U_ECNFC_U 141 S ECODE=ECODE_ECST_U_ECPTTM_U_ECPTPR_U_ECDTTM_U_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADM)_U_ECXDSSI_U 142 ;if outpat and not observ patient, admit date="" and admit time="000000" 143 I ECXA="O",(ECXOBS="NO") S $P(ECODE,U,24)="",$P(ECODE,U,25)="000000" 144 S ECODE1=ECXMPI_U_ECXDSSD_U_ECPTNPI_U_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDPR_U 145 S ECODE1=ECODE1_ECXORDST_U_$$ECXDATE^ECXUTL(ECXORDDT,ECXYM)_U_ECXRPHY_U_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U 146 S ECODE1=ECODE1_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U 147 S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCAT_U 148 S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXOPNPI_U 149 S ECODE2=ECXHNCI_U_ECXETH_U_ECXRC1 150 I ECXLOGIC>2003 D 151 .S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC 152 I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 153 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST 154 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1 155 S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 156 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX^DIK K DIK,DA 157 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 158 Q 159 SETUP ;Set required input for ECXTRAC 160 S ECHEAD="IVP" 161 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 162 ;variables ecver and ecrtn will be reset in routine ecxtrac if appropriate 163 S ECVER=7 164 Q 165 QUE ; entry point for the background requeuing handled by ECXTAUTO 166 D SETUP,QUE^ECXTAUTO,^ECXKILL Q
Note:
See TracChangeset
for help on using the changeset viewer.
