Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXOPRX1.m

    r613 r623  
    1 ECXOPRX1        ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 6/6/07 7:23am
    2         ;;3.0;DSS EXTRACTS;**92,107,105**;Dec 22, 1997;Build 70
    3         ;
    4 FILE    ;file record
    5         ;node0
    6         ;inst^dfn^ssn^name^in/out ECXA^day^division^provider^drug category^mail^
    7         ;placeholder1^new^placeholder2^qty^cost^placeholder3^mov #^treat spec^placeholder4^unit of issue^dob^elig^vet^copay^
    8         ;feeder key^investigational^days supply^primary care team^primary care provider^time^race
    9         ;node1
    10         ;mpi^dss dept ECXDSSD^sex^zip+4^placeholder^placeholder^state^county^pc prov person class^pow status^pow location^
    11         ;ir status^ao status^sharing agree. payor^sharing agree. ins.^mst status^enroll loc^assoc pc provider^assoc pc prov person class^
    12         ;placeholder^dom ECXDOM^purple heart ECXPHI^enrollment category ECXCAT^enrollment status ECXSTST^
    13         ;enrollment priority ECXPRIOR^cnhu status ECXCNHU^period of service ECXPOS^observ pat ind ECXOBS^encounter num ECXENC^
    14         ;ao loc ECXAOL^ord physician ECXORDPH^ord stop code ECXORDST^ord date ECXORDDT^CNH status ECXCNH^national division ECXPDIV^
    15         ;MT Stat ECXMTST^head & neck cancer ind. ECXHNCI^ethnicity ECXETH^race ECXRC1^^enrollment priority ECXPRIOR_
    16         ;enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^
    17         ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^rx patient status ECRXPTST^non-va prescriber ECNONVAP^rx # ECRXNUM
    18         ;^emergency response indicator(FEMA) ECXERI^agent orange enc ECXAO^environ cont PGE ECXECE^head/neck ECXHNC^enc mst ECXMIL^environ contamin ECXEST^ion radiat ECXIR
    19         ;OEF/OIF data ECXOEF^OEFOIF return date ECXOEFDT^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^provider npi ECPRVNPI
    20         N DA,DIK
    21         S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
    22         S ECODE=EC7_U_EC23_U_ECINST_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
    23         S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXDIV_U
    24         S ECODE=ECODE_ECXPROV_U_ECCAT_U_ECMW_U_ECXPROVP_U_ECXNEW_U_U_ECQTY_U
    25         ;convert specialty to PTF Code for transmission
    26         N ECXDATA
    27         S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
    28         S ECXTS=$G(ECXDATA(7))
    29         ;done
    30         S ECODE=ECODE_ECXCOST_U_U_ECXMN_U_ECXTS_U_U_ECUI_U_ECXDOB_U
    31         S ECODE=ECODE_ECXELIG_U_ECXVET_U_ECOPAY_U_ECNFC_U_ECINV_U_ECDS_U
    32         S ECODE=ECODE_ECPTTM_U_ECPTPR_U_$$ECXTIME^ECXUTL(ECXDATE)_U_ECXRACE_U
    33         S ECODE1=ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U_ECXPROVN_U_U
    34         S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECCLAS_U_ECXPST_U_ECXPLOC_U
    35         S ECODE1=ECODE1_ECXRST_U_ECXAST_U_U_U_ECXMST_U_ECXENRL_U
    36         S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXPHI_U_ECXCAT_U
    37         S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXPOS_U_ECXOBS_U
    38         S ECODE1=ECODE1_ECXENC_U_ECXAOL_U_ECXORDPH_U_ECXORDST_U_ECXORDDT_U
    39         S ECODE1=ECODE1_ECXCNH_U_ECXPDIV_U_ECXMTST_U_ECXHNCI_U_ECXETH_U
    40         S ECODE1=ECODE1_ECXRC1_U
    41         I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U
    42         I ECXLOGIC>2004 S ECODE2=ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI_U_ECRXPTST_U_ECNONVAP
    43         I ECXLOGIC>2005 S ECODE2=ECODE2_U_ECRXNUM
    44         I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXEST_U_ECXIR_U_ECXSCRX
    45         I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECPRVNPI
    46         S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1
    47         S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
    48         I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
    49         Q
     1ECXOPRX1 ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 4/19/2007
     2 ;;3.0;DSS EXTRACTS;**92,107**;Dec 22, 1997;Build 9
     3 ;
     4FILE ;file record
     5 ;node0
     6 ;inst^dfn^ssn^name^in/out ECXA^day^division^provider^drug category^mail^
     7 ;placeholder1^new^placeholder2^qty^cost^placeholder3^mov #^treat spec^placeholder4^unit of issue^dob^elig^vet^copay^
     8 ;feeder key^investigational^days supply^primary care team^primary care provider^time^race
     9 ;node1
     10 ;mpi^dss dept ECXDSSD^sex^zip+4^provider npi^pc provider npi^state^county^pc prov person class^pow status^pow location^
     11 ;ir status^ao status^sharing agree. payor^sharing agree. ins.^mst status^enroll loc^assoc pc provider^assoc pc prov person class^
     12 ;assoc pc prov npi^dom ECXDOM^purple heart ECXPHI^enrollment category ECXCAT^enrollment status ECXSTST^
     13 ;enrollment priority ECXPRIOR^cnhu status ECXCNHU^period of service ECXPOS^observ pat ind ECXOBS^encounter num ECXENC^
     14 ;ao loc ECXAOL^ord physician ECXORDPH^ord stop code ECXORDST^ord date ECXORDDT^CNH status ECXCNH^national division ECXPDIV^
     15 ;MT Stat ECXMTST^head & neck cancer ind. ECXHNCI^ethnicity ECXETH^race ECXRC1^^enrollment priority ECXPRIOR_
     16 ;enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^
     17 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^rx patient status ECRXPTST^non-va prescriber ECNONVAP^rx # ECRXNUM
     18 ;^emergency response indicator(FEMA) ECXERI^agent orange enc ECXAO^environ cont PGE ECXECE^head/neck ECXHNC^enc mst ECXMIL^environ contamin ECXEST^ion radiat ECXIR
     19 N DA,DIK
     20 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
     21 S ECODE=EC7_U_EC23_U_ECINST_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
     22 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXDIV_U
     23 S ECODE=ECODE_ECXPROV_U_ECCAT_U_ECMW_U_ECXPROVP_U_ECXNEW_U_U_ECQTY_U
     24 ;convert specialty to PTF Code for transmission
     25 N ECXDATA
     26 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
     27 S ECXTS=$G(ECXDATA(7))
     28 ;done
     29 S ECODE=ECODE_ECXCOST_U_U_ECXMN_U_ECXTS_U_U_ECUI_U_ECXDOB_U
     30 S ECODE=ECODE_ECXELIG_U_ECXVET_U_ECOPAY_U_ECNFC_U_ECINV_U_ECDS_U
     31 S ECODE=ECODE_ECPTTM_U_ECPTPR_U_$$ECXTIME^ECXUTL(ECXDATE)_U_ECXRACE_U
     32 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U_ECXPROVN_U_ECPTNPI_U
     33 S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECCLAS_U_ECXPST_U_ECXPLOC_U
     34 S ECODE1=ECODE1_ECXRST_U_ECXAST_U_U_U_ECXMST_U_ECXENRL_U
     35 S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXPHI_U_ECXCAT_U
     36 S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXPOS_U_ECXOBS_U
     37 S ECODE1=ECODE1_ECXENC_U_ECXAOL_U_ECXORDPH_U_ECXORDST_U_ECXORDDT_U
     38 S ECODE1=ECODE1_ECXCNH_U_ECXPDIV_U_ECXMTST_U_ECXHNCI_U_ECXETH_U
     39 S ECODE1=ECODE1_ECXRC1_U
     40 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U
     41 I ECXLOGIC>2004 S ECODE2=ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI_U_ECRXPTST_U_ECNONVAP
     42 I ECXLOGIC>2005 S ECODE2=ECODE2_U_ECRXNUM
     43 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXEST_U_ECXIR_U_ECXSCRX
     44 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1
     45 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
     46 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
     47 Q
Note: See TracChangeset for help on using the changeset viewer.