Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXOPRX.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXOPRX.m
r613 r623 1 ECXOPRX ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 11/5/07 8:17am 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,30,33,38,39,46,49,71,81,84,92,105**;Dec 22, 1997;Build 70 3 ; 4 BEG ;entry point from option 5 D SETUP I ECFILE="" Q 6 D ^ECXTRAC,^ECXKILL 7 Q 8 ; 9 START ;entry when queued 10 N X,DA,DIC,DIQ,DR,ECXNPRFI,ECRXPTST,ECNONVAP,ECRXNUM,ECXSCRX 11 S QFLG=0 12 I '$D(ECINST) D 13 .S ECINST=+$P(^ECX(728,1,0),U) K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99" 14 .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC 15 ;before V6 16 S ECPROF=6,ECD=$O(^PSRX("AL",0)) I ECD,ECD<ECSD1 G V6 17 S ECED=ECED+.3,ECREF=1,ECD=ECSD1 18 F S ECD=$O(^PSRX("AD",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AD",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AD",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 19 Q 20 ; 21 V6 ;version 6 or better 22 K ^TMP($J,"ECXP") 23 S ECPROF=2,ECED=ECED+.3,ECREF=1,ECD=ECSD1 24 F S ECD=$O(^PSRX("AL",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AL",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AL",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 25 Q:QFLG 26 S ECREF="P",ECD=ECSD1 27 F S ECD=$O(^PSRX("AM",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AM",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AM",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 28 K ^TMP($J,"ECXP") 29 Q 30 ; 31 STUFF ;get data 32 N ECXPHA 33 S ECDATA=$G(^PSRX(ECRX,0)),ECXPHA="" 34 I ECRFL S ECDATA1=$G(^PSRX(ECRX,ECREF,ECRFL,0)) I ECDATA1="" Q 35 ;ecref set to 1 in extract+5 and v6+1 and to "P" in v6+2 36 ;refill nodes and partial nodes are identical in layout. Fills 37 ;(ie ecrfl=0)& refills (ie ecrfl>0) from "AL" xref, partials from "AM" 38 S (ECXDSSD,ECXPROVN,ECXCVE,ECXCVEDT,ECXCVENC,ECRXPTST,ECRXNUM)="",ECXERR=0,ECXDATE=ECD,ECXDFN=$P(ECDATA,U,2),ECDRG=+$P(ECDATA,U,6) 39 ;- Get rx patient status & rx number 40 S ECRXPTST=$$RXPTST^ECXUTL5($P(ECDATA,U,3)),ECRXNUM=$P(ECDATA,U,1) 41 ;- Get provider (either 2_provider or 6_provider depending on version) 42 S ECXPROV=$S($P(ECDATA,U,4)'="":ECPROF_$P(ECDATA,U,4),1:""),ECXPROVP=$$PRVCLASS^ECXUTL($P(ECDATA,U,4),ECXDATE) 43 S ECPRVNPI=$$NPI^XUSNPI("Individual_ID",$P(ECDATA,U,4),ECXDATE) 44 S:+ECPRVNPI'>0 ECPRVNPI="" S ECPRVNPI=$P(ECPRVNPI,U) 45 ;get classification data 46 S ECXCLS=$G(^PSRX(ECRX,"IBQ")),ECXMIL=$P(ECXCLS,U,2),ECXAO=$P(ECXCLS,U,3),ECXIR=$P(ECXCLS,U,4),ECXECE=$P(ECXCLS,U,5),ECXHNC=$P(ECXCLS,U,6) 47 F X="ECXMIL","ECXAO","ECXIR","ECXECE","ECXHNC" S @X=$S(@X:"Y",@X=0:"N",1:"") 48 ;- Check non-va provider flag and set to 'Y' if exist 49 S ECNONVAP=$$NONVAP^ECXUTL5($E(ECXPROV,2,99)) 50 ;get patient specific data 51 D PAT(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR 52 I 'ECRFL D 53 .S ECMW=$P(ECDATA,U,11),ECQTY=+$P(ECDATA,U,7),ECXDIV=$S($D(^PSRX(ECRX,2)):$P(^(2),U,9),1:1) 54 .S ECPRC=+$P(ECDATA,U,17),ECOPAY=$P($G(^PSRX(ECRX,"IB")),U,2)]"" 55 I ECRFL D 56 .S ECMW=$P(ECDATA1,U,2),ECQTY=+$P(ECDATA1,U,4),ECXDIV=$S(+$P(ECDATA1,U,9):$P(ECDATA1,U,9),1:1) 57 .S ECPRC=+$P(ECDATA1,U,11),ECOPAY=$P($G(^PSRX(ECRX,1,ECRFL,"IB")),U)]"" 58 S ECXCOST=$J((ECQTY*ECPRC),1,2),ECDS=$S(ECRFL:$P(ECDATA1,U,10),1:$P(ECDATA,U,8)) 59 ;call pharmacy drug file (#50) api 60 S ECXPHA=$$PHAAPI^ECXUTL5(ECDRG),ECCAT=$P(ECXPHA,U,2),ECINV=$P(ECXPHA,U,4)["I",ECINV=$S(ECINV:"I",1:""),ECUI=$P(ECXPHA,U,8),ECNDC=$P(ECXPHA,U,3) 61 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),P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6) 62 S X="PSNAPIS" X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC 63 I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC 64 I ECMW="M" S ECMW=1 I $D(^PSRX("AR",ECD,ECRX)) S ECMW=2 65 I ECMW="W" S ECMW="" 66 S ECXNEW="" I ECRFL=0 S ECXNEW=1 67 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS) ;Observation pat indic (YES/NO) 68 S ECXORDPH="" ;Ordering physician (null for FY2002) 69 ;- Ordering stop code & Ordering date 70 S ECXORDST=$P($G(^ECX(728.44,+$P(ECDATA,U,5),0)),U,2),ECXORDDT=$$ECXDATE^ECXUTL(+$P(ECDATA,U,13),ECXYM) 71 S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN) ;CNH status (YES/NO) 72 ;- DSS Dept and National Prod Division 73 ;S ECXDSSD=$$PRE^ECXDEPT(ECXDIV,ECMW,ECINST) dss department postponed 74 N ECXPDIV S ECXPDIV=$$PREDIV^ECXDEPT(ECXDIV) 75 ;- Set national patient record flag if exist 76 D NPRF^ECXUTL5 77 S ECXSCRX=$$SCRX^ECXUTL5(ECRX) ;Service connected rx 78 ;- If no encounter number don't file record 79 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,) 80 I ECXLOGIC>2003 D 81 .I (ECMW=2)!((ECMW=1)&(ECXLOGIC>2006)),ECXSSN'="" D 82 ..N TMP S TMP=$$JULDT^ECXUTL4(ECD),ECXENC=$E(ECXSSN,1,9)_TMP_"160",ECXA="O" 83 I ECXENC'="" D FILE^ECXOPRX1 84 Q 85 ; 86 PAT(ECXDFN,ECXDATE,ECXERR) ;Determine in/outpatient status, movement number, primary care team and provider 87 N OK,X,PT 88 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)="" 89 ;get patient data if saved 90 I $D(^TMP($J,"ECXP",ECXDFN)) D 91 .S PT=^TMP($J,"ECXP",ECXDFN),ECXSSN=$P(PT,U),ECXPNM=$P(PT,U,2),ECXMPI=$P(PT,U,3),ECXSEX=$P(PT,U,4),ECXDOB=$P(PT,U,5) 92 .S ECXELIG=$P(PT,U,6),ECXVET=$P(PT,U,7),ECXRACE=$P(PT,U,8),ECXPST=$P(PT,U,9),ECXPLOC=$P(PT,U,10),ECXRST=$P(PT,U,11) 93 .S ECXAST=$P(PT,U,12),ECXMST=$P(PT,U,13),ECXSTATE=$P(PT,U,14),ECXCNTY=$P(PT,U,15),ECXZIP=$P(PT,U,16),ECXENRL=$P(PT,U,17) 94 .S ECXPHI=$P(PT,U,20),ECXCAT=$P(PT,U,21),ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23) 95 .S ECXCNHU=$P(PT,U,24),ECXPOS=$P(PT,U,25),ECXAOL=$P(PT,U,26),ECXHNCI=$P(PT,U,27),ECXETH=$P(PT,U,28),ECXRC1=$P(PT,U,29),ECXMTST=$P(PT,U,30) 96 .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) 97 .I $$ENROLLM^ECXUTL2(ECXDFN) 98 ;set patient data 99 I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK 100 .K ECXPAT 101 .S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECSD1,"."),"1;2;3;5",.ECXPAT) 102 .I 'OK S ECXERR=1 Q 103 .S ECXSSN=ECXPAT("SSN"),ECXPNM=ECXPAT("NAME"),ECXMPI=ECXPAT("MPI"),ECXSEX=ECXPAT("SEX"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG") 104 .S ECXVET=ECXPAT("VET"),ECXRACE=ECXPAT("RACE"),ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT") 105 .S ECXAST=ECXPAT("AO STAT"),ECXMST=ECXPAT("MST STAT"),ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP"),ECXENRL=ECXPAT("ENROLL LOC") 106 .S ECXERI=ECXPAT("ERI"),ECXEST=ECXPAT("EC STAT") 107 .;- CNH Stat (placeholder),Purp Heart Ind,Per of Svce,AO Loc,MT Stat 108 .S ECXCNHU="",ECXPHI=ECXPAT("PHI"),ECXPOS=ECXPAT("POS"),ECXAOL=ECXPAT("AOL"),ECXMTST=ECXPAT("MEANS") 109 .I $$ENROLLM^ECXUTL2(ECXDFN) 110 .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) ;Head and Neck Cancer Indicator 111 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") ;Race and Ethnicity 112 .; OEF/OIF data 113 .S ECXOEF=ECXPAT("ECXOEF") 114 .S ECXOEFDT=ECXPAT("ECXOEFDT") 115 .S ^TMP($J,"ECXP",ECXDFN)=ECXSSN_U_ECXPNM_U_ECXMPI_U_ECXSEX_U_ECXDOB_U_ECXELIG_U_ECXVET_U_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U_ECXMST_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXENRL_U_U 116 .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXPHI_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXCNHU_U_ECXPOS_U_ECXAOL_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST 117 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT 118 ;get inpatient data 119 S (ECXA,ECXADMDT,ECXDOM,ECXMN,ECXTS)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) D 120 .S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4) 121 ;get primary care data 122 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,".")),ECPTTM=$P(X,U),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) 123 Q 124 ; 125 SETUP ;Set required input for ECXTRAC 126 S ECHEAD="PRE" 127 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 128 Q 129 QUE ; entry point for the background requeuing handled by ECXTAUTO 130 D SETUP,QUE^ECXTAUTO,^ECXKILL Q 1 ECXOPRX ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 11/2/06 8:42am 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,30,33,38,39,46,49,71,81,84,92**;Dec 22, 1997;Build 30 3 ; 4 BEG ;entry point from option 5 D SETUP I ECFILE="" Q 6 D ^ECXTRAC,^ECXKILL 7 Q 8 ; 9 START ;entry when queued 10 N X,DA,DIC,DIQ,DR,ECXNPRFI,ECRXPTST,ECNONVAP,ECRXNUM,ECXSCRX 11 S QFLG=0 12 I '$D(ECINST) D 13 .S ECINST=+$P(^ECX(728,1,0),U) K ECXDIC S DA=ECINST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99" 14 .D EN^DIQ1 S ECINST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC 15 ;before V6 16 S ECPROF=6,ECD=$O(^PSRX("AL",0)) I ECD,ECD<ECSD1 G V6 17 S ECED=ECED+.3,ECREF=1,ECD=ECSD1 18 F S ECD=$O(^PSRX("AD",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AD",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AD",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 19 Q 20 ; 21 V6 ;version 6 or better 22 K ^TMP($J,"ECXP") 23 S ECPROF=2,ECED=ECED+.3,ECREF=1,ECD=ECSD1 24 F S ECD=$O(^PSRX("AL",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AL",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AL",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 25 Q:QFLG 26 S ECREF="P",ECD=ECSD1 27 F S ECD=$O(^PSRX("AM",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECRX=$O(^PSRX("AM",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AM",ECD,ECRX,ECRFL)) Q:ECRFL="" D STUFF Q:QFLG 28 K ^TMP($J,"ECXP") 29 Q 30 ; 31 STUFF ;get data 32 N ECXPHA 33 S ECDATA=$G(^PSRX(ECRX,0)),ECXPHA="" 34 I ECRFL S ECDATA1=$G(^PSRX(ECRX,ECREF,ECRFL,0)) I ECDATA1="" Q 35 ;ecref set to 1 in extract+5 and v6+1 and to "P" in v6+2 36 ;refill nodes and partial nodes are identical in layout. Fills 37 ;(ie ecrfl=0)& refills (ie ecrfl>0) from "AL" xref, partials from "AM" 38 S (ECXDSSD,ECXPROVN,ECXCVE,ECXCVEDT,ECXCVENC,ECRXPTST,ECRXNUM)="",ECXERR=0,ECXDATE=ECD,ECXDFN=$P(ECDATA,U,2),ECDRG=+$P(ECDATA,U,6) 39 ;- Get rx patient status & rx number 40 S ECRXPTST=$$RXPTST^ECXUTL5($P(ECDATA,U,3)),ECRXNUM=$P(ECDATA,U,1) 41 ;- Get provider (either 2_provider or 6_provider depending on version) 42 S ECXPROV=$S($P(ECDATA,U,4)'="":ECPROF_$P(ECDATA,U,4),1:""),ECXPROVP=$$PRVCLASS^ECXUTL($P(ECDATA,U,4),ECXDATE) 43 ;get classification data 44 S ECXCLS=$G(^PSRX(ECRX,"IBQ")),ECXMIL=$P(ECXCLS,U,2),ECXAO=$P(ECXCLS,U,3),ECXIR=$P(ECXCLS,U,4),ECXECE=$P(ECXCLS,U,5),ECXHNC=$P(ECXCLS,U,6) 45 F X="ECXMIL","ECXAO","ECXIR","ECXECE","ECXHNC" S @X=$S(@X:"Y",@X=0:"N",1:"") 46 ;- Check non-va provider flag and set to 'Y' if exist 47 S ECNONVAP=$$NONVAP^ECXUTL5($E(ECXPROV,2,99)) 48 ;get patient specific data 49 D PAT(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR 50 I 'ECRFL D 51 .S ECMW=$P(ECDATA,U,11),ECQTY=+$P(ECDATA,U,7),ECXDIV=$S($D(^PSRX(ECRX,2)):$P(^(2),U,9),1:1) 52 .S ECPRC=+$P(ECDATA,U,17),ECOPAY=$P($G(^PSRX(ECRX,"IB")),U,2)]"" 53 I ECRFL D 54 .S ECMW=$P(ECDATA1,U,2),ECQTY=+$P(ECDATA1,U,4),ECXDIV=$S(+$P(ECDATA1,U,9):$P(ECDATA1,U,9),1:1) 55 .S ECPRC=+$P(ECDATA1,U,11),ECOPAY=$P($G(^PSRX(ECRX,1,ECRFL,"IB")),U)]"" 56 S ECXCOST=$J((ECQTY*ECPRC),1,2),ECDS=$S(ECRFL:$P(ECDATA1,U,10),1:$P(ECDATA,U,8)) 57 ;call pharmacy drug file (#50) api 58 S ECXPHA=$$PHAAPI^ECXUTL5(ECDRG),ECCAT=$P(ECXPHA,U,2),ECINV=$P(ECXPHA,U,4)["I",ECINV=$S(ECINV:"I",1:""),ECUI=$P(ECXPHA,U,8),ECNDC=$P(ECXPHA,U,3) 59 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),P1=$P(ECXPHA,U,5),P3=$P(ECXPHA,U,6) 60 S X="PSNAPIS" X ^%ZOSF("TEST") I $T S ECNFC=$$DSS^PSNAPIS(P1,P3,ECXYM)_ECNFC 61 I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC 62 I ECMW="M" S ECMW=1 I $D(^PSRX("AR",ECD,ECRX)) S ECMW=2 63 I ECMW="W" S ECMW="" 64 S ECXNEW="" I ECRFL=0 S ECXNEW=1 65 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS) ;Observation pat indic (YES/NO) 66 S ECXORDPH="" ;Ordering physician (null for FY2002) 67 ;- Ordering stop code & Ordering date 68 S ECXORDST=$P($G(^ECX(728.44,+$P(ECDATA,U,5),0)),U,2),ECXORDDT=$$ECXDATE^ECXUTL(+$P(ECDATA,U,13),ECXYM) 69 S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN) ;CNH status (YES/NO) 70 ;- DSS Dept and National Prod Division 71 ;S ECXDSSD=$$PRE^ECXDEPT(ECXDIV,ECMW,ECINST) dss department postponed 72 N ECXPDIV S ECXPDIV=$$PREDIV^ECXDEPT(ECXDIV) 73 ;- Set national patient record flag if exist 74 D NPRF^ECXUTL5 75 S ECXSCRX=$$SCRX^ECXUTL5(ECRX) ;Service connected rx 76 ;- If no encounter number don't file record 77 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,,) 78 I ECXLOGIC>2003 D 79 .I (ECMW=2)!((ECMW=1)&(ECXLOGIC>2006)),ECXSSN'="" D 80 ..N TMP S TMP=$$JULDT^ECXUTL4(ECD),ECXENC=$E(ECXSSN,1,9)_TMP_"160",ECXA="O" 81 I ECXENC'="" D FILE^ECXOPRX1 82 Q 83 ; 84 PAT(ECXDFN,ECXDATE,ECXERR) ;Determine in/outpatient status, movement number, primary care team and provider 85 N OK,X,PT 86 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)="" 87 ;get patient data if saved 88 I $D(^TMP($J,"ECXP",ECXDFN)) D 89 .S PT=^TMP($J,"ECXP",ECXDFN),ECXSSN=$P(PT,U),ECXPNM=$P(PT,U,2),ECXMPI=$P(PT,U,3),ECXSEX=$P(PT,U,4),ECXDOB=$P(PT,U,5) 90 .S ECXELIG=$P(PT,U,6),ECXVET=$P(PT,U,7),ECXRACE=$P(PT,U,8),ECXPST=$P(PT,U,9),ECXPLOC=$P(PT,U,10),ECXRST=$P(PT,U,11) 91 .S ECXAST=$P(PT,U,12),ECXMST=$P(PT,U,13),ECXSTATE=$P(PT,U,14),ECXCNTY=$P(PT,U,15),ECXZIP=$P(PT,U,16),ECXENRL=$P(PT,U,17) 92 .S ECXPHI=$P(PT,U,20),ECXCAT=$P(PT,U,21),ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23) 93 .S ECXCNHU=$P(PT,U,24),ECXPOS=$P(PT,U,25),ECXAOL=$P(PT,U,26),ECXHNCI=$P(PT,U,27),ECXETH=$P(PT,U,28),ECXRC1=$P(PT,U,29),ECXMTST=$P(PT,U,30) 94 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) 95 .I $$ENROLLM^ECXUTL2(ECXDFN) 96 ;set patient data 97 I '$D(^TMP($J,"ECXP",ECXDFN)) D Q:'OK 98 .K ECXPAT 99 .S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECSD1,"."),"1;2;3;5",.ECXPAT) 100 .I 'OK S ECXERR=1 Q 101 .S ECXSSN=ECXPAT("SSN"),ECXPNM=ECXPAT("NAME"),ECXMPI=ECXPAT("MPI"),ECXSEX=ECXPAT("SEX"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG") 102 .S ECXVET=ECXPAT("VET"),ECXRACE=ECXPAT("RACE"),ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC"),ECXRST=ECXPAT("IR STAT") 103 .S ECXAST=ECXPAT("AO STAT"),ECXMST=ECXPAT("MST STAT"),ECXSTATE=ECXPAT("STATE"),ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP"),ECXENRL=ECXPAT("ENROLL LOC") 104 .S ECXERI=ECXPAT("ERI"),ECXEST=ECXPAT("EC STAT") 105 .;- CNH Stat (placeholder),Purp Heart Ind,Per of Svce,AO Loc,MT Stat 106 .S ECXCNHU="",ECXPHI=ECXPAT("PHI"),ECXPOS=ECXPAT("POS"),ECXAOL=ECXPAT("AOL"),ECXMTST=ECXPAT("MEANS") 107 .I $$ENROLLM^ECXUTL2(ECXDFN) 108 .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) ;Head and Neck Cancer Indicator 109 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") ;Race and Ethnicity 110 .S ^TMP($J,"ECXP",ECXDFN)=ECXSSN_U_ECXPNM_U_ECXMPI_U_ECXSEX_U_ECXDOB_U_ECXELIG_U_ECXVET_U_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U_ECXMST_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXENRL_U_U 111 .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXPHI_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXCNHU_U_ECXPOS_U_ECXAOL_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST 112 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST 113 ;get inpatient data 114 S (ECXA,ECXADMDT,ECXDOM,ECXMN,ECXTS)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) D 115 .S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4) 116 ;get primary care data 117 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,".")),ECPTTM=$P(X,U),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) 118 Q 119 ; 120 SETUP ;Set required input for ECXTRAC 121 S ECHEAD="PRE" 122 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 123 Q 124 QUE ; entry point for the background requeuing handled by ECXTAUTO 125 D SETUP,QUE^ECXTAUTO,^ECXKILL Q
Note:
See TracChangeset
for help on using the changeset viewer.