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/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIX2.m

    r613 r623  
    1 XUSNPIX2        ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08  17:17
    2         ;;8.0;KERNEL;**438,452,453,481**; Jul 10, 1995;Build 21
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         ; NPI Extract Report
    6         ;
    7         ; Input parameter: N/A
    8         ;
    9         ; Other relevant variables:
    10         ;   XUSRTN="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP
    11         ;                         storage subscript)
    12         ; Storage Global:
    13         ;   ^XTMP("XUSNPIX2",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
    14         ;      where:
    15         ;      Piece 1 => Purge Date - 1 year in future
    16         ;      Piece 2 => Create Date - Today
    17         ;      Piece 3 => Description
    18         ;      Piece 4 => Last Date Compiled
    19         ;      Piece 5 => $H last run start time
    20         ;      Piece 6 => $H last run completion time
    21         ;
    22         ;   ^XTMP("XUSNPIX2",1) = STATION INFO
    23         ;   ^XTMP("XUSNPIX2",2) = DATA
    24         ;               
    25         ;          NPI => Unique NPI of entry
    26         ;          LDT => Last Date Run, VA Fileman Format
    27         ;
    28         ; Entry Point - ENT called from XUSNPIX1
    29         ;
    30         Q
    31         ;
    32 ENT(XUSPROD,XUSVER)     ; ENTRY POINT
    33         ; Initialize variables
    34         N XUSRTN
    35         S XUSRTN="XUSNPIX2"
    36         S DTTM2=$$HTE^XLFDT($H,"2")
    37         ; Check to see if report is in use
    38         L +^XTMP(XUSRTN):5 I '$T G EXIT
    39         ; Process Institution File
    40         D INIT(XUSRTN)
    41         ; Pull Station(Institution) data
    42         D STAT(XUSRTN)
    43         ; Process Report
    44         D PROC2(XUSRTN,XUSPROD,DTTM2)
    45         ;
    46         ; Standard EXIT point
    47 EXIT    ;
    48         K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J)
    49         ; Log Run Completion Time
    50         S $P(^XTMP(XUSRTN,0),U,6)=$H
    51         L -^XTMP(XUSRTN)
    52         K P,XUSPT,INST,DTTM2,XUSIZE,XUSHDR,XUSTAXID
    53         Q
    54         ;
    55 INIT(XUSRTN)    ; check/init variables
    56         N XUSDESC
    57         ;
    58         ; Reset Temporary Scratch Global
    59         K ^TMP(XUSRTN)
    60         S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete"
    61         S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
    62         ;
    63         I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
    64         ;
    65         ; Create pharmacy institution ^TMP file
    66         D GETPHARM
    67         Q
    68         ;
    69 STAT(XUSRTN)    ; Pull station and Institution info
    70         N SINFO,DIC4,IBSITE,IBFAC,IB0
    71         ; Pull site info
    72         S SINFO=$$SITE^VASITE
    73         ; Station Number
    74         S SITE=$P(SINFO,U,3)
    75         ; Institution 
    76         S INST=$P(SINFO,U)
    77         ;
    78         ; Get Federal Tax Id
    79         S XUSTAXID=""
    80         S IBSITE=0
    81         F  S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="")  D
    82         . S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5)
    83         ;
    84         ; Get institution mailing address (PAY TO)
    85         ;ST ADDR 1,ST ADDR 2,CITY,ZIP
    86         I INST D
    87         . S DIC4=$G(^DIC(4,INST,4))
    88         . S XUSPT(4)=$P(DIC4,U)
    89         . S XUSPT(5)=$P(DIC4,U,2)
    90         . S XUSPT(6)=$P(DIC4,U,3)
    91         . S XUSPT(7)=$P(DIC4,U,4)
    92         . I XUSPT(7) S XUSPT(7)=$P($G(^DIC(5,XUSPT(7),0)),U,2)
    93         . S XUSPT(8)=$P(DIC4,U,5)
    94         . S PTPMAIL=XUSPT(4)_U_XUSPT(5)_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)
    95         S XUSHDR="Station: "_SITE_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)_U_"TYPE 2"_U_XUSVER
    96         ;
    97         Q
    98         ;
    99 PROC2(XUSRTN,XUSPROD,DTTM2)     ;Process all Institution records
    100         N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM
    101         N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA,XUSEOL
    102         N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA,COUNT,TOTREC,MSGCNT,MAXSIZE
    103         ;
    104         ; Set to 300000 for live
    105         S MAXSIZE=300000
    106         ;
    107         ; Set end of line character
    108         S XUSEOL="~~"
    109         ;
    110         ; set counter
    111         S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
    112         ; Loop through INSTITUTION NPI records NPI xref
    113         S XUSNPI=0
    114         F  S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI  D
    115         . S INIEN=$O(^DIC(4,"ANPI",XUSNPI,""))
    116         . ;
    117         . ; Get Station Number
    118         . S XUSSTA=$P($G(^DIC(4,INIEN,99)),U)
    119         . ; Parent of Association
    120         . I (INIEN'=INST)&('$$POA(INIEN,INST)) Q
    121         . ; Initialize columns
    122         . F XUSI=1:1:24 S XUSIN(XUSI)=""
    123         . ;
    124         . S XUSIN(1)=XUSNPI
    125         . S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0=""
    126         . ;Organization Name 
    127         . S XUSIN(2)=$P($G(DIC0),U)
    128         . S XUSIN(3)=2
    129         . S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3)
    130         . ;
    131         . ; Pay to Provider Address
    132         . S XUSDATA2=PTPMAIL
    133         . ;
    134         . ; Servicing Provider Address
    135         . S DIC1=$G(^DIC(4,INIEN,1))
    136         . I DIC1'="" D
    137         . . S XUSIN(9)=$P(DIC1,U)
    138         . . S XUSIN(10)=$P(DIC1,U,2)
    139         . . S XUSIN(11)=$P(DIC1,U,3)
    140         . . S XUSIN(12)=$P($G(DIC0),U,2)
    141         . . I XUSIN(12) S XUSIN(12)=$P($G(^DIC(5,XUSIN(12),0)),U,2)
    142         . . S XUSIN(13)=$P(DIC1,U,4)
    143         . S XUSDATA3=XUSIN(9)_U_XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)
    144         . ;
    145         . ;Phone number (place holder)
    146         . S XUSIN(14)=""
    147         . ;
    148         . ; Get Taxonomy and Specialty
    149         . S XUSTXY=0
    150         . F  S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY  D
    151         . . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9)
    152         . . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7)
    153         . . I XUSSPC'="" D
    154         . . . I XUSIN(15)="" S XUSIN(15)=XUSSPC Q
    155         . . . S XUSIN(15)=XUSIN(15)_";"_XUSSPC
    156         . . I XUSTAX'="" D
    157         . . . I XUSIN(16)="" S XUSIN(16)=XUSTAX Q
    158         . . . S XUSIN(16)=XUSIN(16)_";"_XUSTAX
    159         . ;
    160         . ; Federal Tax ID
    161         . S XUSIN(17)=$G(XUSTAXID)
    162         . ;
    163         . ; Medicaid Part A/B
    164         . S XUSIN(18)=670899
    165         . S XUSIN(19)="VA"_$E(SITE+10000,2,5)
    166         . ;
    167         . S XUSDATA4=XUSIN(14)_U_XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)
    168         . ;
    169         . ; DEA Number
    170         . S XUSIN(20)=$P($G(^DIC(4,INIEN,"DEA")),U)
    171         . ;
    172         . ; get Facility Type and Name
    173         . S XUSFCT=$P($G(^DIC(4,INIEN,3)),U)
    174         . I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U)
    175         . I $G(XUSFCN)="PHARM" D
    176         . . I $D(^TMP("XUSNPIX",$J,INIEN)) D
    177         . . . S XUPHM=^TMP("XUSNPIX",$J,INIEN)
    178         . . . ; get NCPDP from ^TMP
    179         . . . S XUSIN(21)=$P($G(XUPHM),U)
    180         . . . ; get station number from^TMP
    181         . . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2)
    182         . ;
    183         . ; VISN Station Number
    184         . S XUSIN(22)=XUSSTA
    185         . ;
    186         . S XUSDATA5=XUSIN(20)_U_XUSIN(21)_U_XUSIN(22)
    187         . ;
    188         . ; Get BCBS Payer ID Array
    189         . K XUSBXID
    190         . D INSTID^XUSNPIXU(.XUSBXID)
    191         . ;
    192         . ; Update counter and save Entry
    193         . ;
    194         . S COUNT=COUNT+1,TOTREC=TOTREC+1
    195         . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL
    196         . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
    197         . I $D(XUSBXID) D
    198         . . S XUSB=""
    199         . . F  S XUSB=$O(XUSBXID(XUSB)) Q:XUSB=""  D
    200         . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
    201         . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL
    202         . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
    203         . K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID
    204         . I XUSIZE>MAXSIZE D
    205         . . D EOF(XUSRTN)
    206         . . D EMAIL(XUSRTN)
    207         . . K ^TMP(XUSRTN,$J)
    208         . . S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2)
    209         . . S ^TMP(XUSRTN,$J,1)=XUSHDR
    210         . . S COUNT=1,XUSIZE=0
    211         ;
    212         D EOF(XUSRTN)
    213         ;
    214         ; Send the last message (if it has records)
    215         I $G(COUNT)>1 D
    216         .D EMAIL(XUSRTN)
    217         .K ^TMP(XUSRTN,$J)
    218         .S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2)
    219         ;
    220         ; Set Summary totals
    221         S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2
    222         ;
    223         K XUSPT,PTPMAIL,LDTCMP,SITE,XUSTAXID
    224         Q
    225         ;
    226 EOF(XUSRTN)     ;
    227         Q:COUNT=1
    228         S MSGCNT=MSGCNT+1
    229         S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL
    230         S COUNT=COUNT+1
    231         S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
    232         Q
    233         ;
    234         ; Email the message
    235 EMAIL(XUSRTN)   ;
    236         N XMY
    237         ; Send email to designated recipient for live release
    238         S XMY("XXX@Q-NPS.VA.GOV")=""
    239         D ESEND
    240         Q
    241         ;
    242 ESEND   N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
    243         ;
    244         S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
    245         S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2"
    246         D ^XMD
    247         Q
    248 POA(IEN,INST)   ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain
    249         N XUSPOA
    250         I +$G(INST)=0 Q 0 ; No institution - return false
    251 POA1    ;
    252         I $G(IEN)="" Q 0 ; No IEN remaining to check - return false
    253         I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false
    254         S XUSPOA(IEN)=""
    255         S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution
    256         I XUSPOA=INST Q 1 ; Found matching institution - return true
    257         I IEN=XUSPOA Q 0 ; Top level reached - return false
    258         S IEN=XUSPOA ; Reset IEN to check next level
    259         G POA1
    260         ;
    261 GETPHARM        ;
    262         ; this subroutine retrieves data from the OUTPATIENT SITE file
    263         ; using the supported Pharmacy API PSS^PSO59.
    264         ; It takes the results and places them into a temporary
    265         ; global array that is accessed when processing data
    266         ; associated with a pharmacy institution.
    267         N D,DIC,XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP
    268         ;
    269         ;Fix for Remedy Ticket 217164
    270         ;Quit if Outpatient Site API routine is not loaded
    271         S X="PSO59" X ^%ZOSF("TEST") Q:'$T
    272         ;
    273         K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes
    274         D PSS^PSO59(,"??","XUS59")  ;IA#4827
    275         S XUS59DA=0
    276         ; gather data from each Outpatient site entry stored in the pharmacy
    277         ; ^TMP global and build 2nd ^TMP global for later processing
    278         F  S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA  D
    279         . ;
    280         . ;Get Pharmacy NPI institution from API
    281         . S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U)
    282         . Q:XUSNPIDA']""  ; NPI institution does not exist
    283         . ;
    284         . ; Get Pharmacy Related Institution from API
    285         . S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U)
    286         . ; get station number off the related institution
    287         . S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U)
    288         . ;
    289         . ; Get NCPDP number
    290         . S XUNCP=""   ;prevent previous values being carried over
    291         . S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC
    292         . I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02)
    293         . S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U)
    294         . ;
    295         . ; rebuild the ^TMP global by NPI institution
    296         . ; collect necessary data used in the 'PHARM' logic
    297         . S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station
    298         Q
     1XUSNPIX2 ;OAK_BP/CMW - NPI EXTRACT REPORT ; 06 Sep 2007  3:34 PM
     2 ;;8.0;KERNEL;**438,452,453**; Jul 10, 1995;Build 36
     3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
     4 ;
     5 ; NPI Extract Report
     6 ;
     7 ; Input parameter: N/A
     8 ;
     9 ; Other relevant variables:
     10 ;   XUSRTN="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP
     11 ;                         storage subscript)
     12 ; Storage Global:
     13 ;   ^XTMP("XUSNPIX2",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
     14 ;      where:
     15 ;      Piece 1 => Purge Date - 1 year in future
     16 ;      Piece 2 => Create Date - Today
     17 ;      Piece 3 => Description
     18 ;      Piece 4 => Last Date Compiled
     19 ;      Piece 5 => $H last run start time
     20 ;      Piece 6 => $H last run completion time
     21 ;
     22 ;   ^XTMP("XUSNPIX2",1) = STATION INFO
     23 ;   ^XTMP("XUSNPIX2",2) = DATA
     24 ;               
     25 ;          NPI => Unique NPI of entry
     26 ;          LDT => Last Date Run, VA Fileman Format
     27 ;
     28 ; Entry Point - ENT called from XUSNPIX1
     29 ;
     30 Q
     31 ;
     32ENT ; ENTRY POINT
     33 ; Initialize variables
     34 N XUSRTN
     35 S XUSRTN="XUSNPIX2"
     36 S DTTM2=$$HTE^XLFDT($H,"2")
     37 ; Check to see if report is in use
     38 L +^XTMP(XUSRTN):5 I '$T G EXIT
     39 ; Process Institution File
     40 D INIT(XUSRTN)
     41 ; Pull Station(Institution) data
     42 D STAT(XUSRTN)
     43 ; Process Report
     44 D PROC2(XUSRTN)
     45 ; Send the message
     46 D EMAIL(XUSRTN)
     47 D VMAIL(XUSRTN)
     48 S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2
     49 ;
     50 ; Standard EXIT point
     51EXIT ;
     52 K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J)
     53 ; Log Run Completion Time
     54 S $P(^XTMP(XUSRTN,0),U,6)=$H
     55 L -^XTMP(XUSRTN)
     56 K P,XUSPT,INST,XUSEOL,DTTM2,MAXSIZE,XUSIZE,MSGCNT,COUNT,TOTREC,XUSHDR,XUSTAXID
     57 Q
     58 ;
     59 ;
     60INIT(XUSRTN) ; check/init variables
     61 N XUSDESC
     62 ; Set end of line character
     63 S XUSEOL="~~"
     64 ; Set to 300000 for live
     65 S MAXSIZE=300000
     66 ; Reset Temporary Scratch Global
     67 K ^TMP(XUSRTN)
     68 S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete"
     69 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
     70 ;
     71 I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
     72 ;
     73 ; Create pharmacy institution ^TMP file
     74 D GETPHARM
     75 Q
     76 ;
     77STAT(XUSRTN) ; Pull station and Institution info
     78 N SINFO,DIC4,IBSITE,IBFAC,IB0
     79 ; Pull site info
     80 S SINFO=$$SITE^VASITE
     81 ; Station Number
     82 S SITE=$P(SINFO,U,3)
     83 ; Institution 
     84 S INST=$P(SINFO,U)
     85 ;
     86 ; Get Federal Tax Id
     87 S XUSTAXID=""
     88 S IBSITE=0
     89 F  S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="")  D
     90 . S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5)
     91 ;
     92 ; Get institution mailing address (PAY TO)
     93 ;ST ADDR 1,ST ADDR 2,CITY,ZIP
     94 I INST D
     95 . S DIC4=$G(^DIC(4,INST,4))
     96 . S XUSPT(4)=$P(DIC4,U)
     97 . S XUSPT(5)=$P(DIC4,U,2)
     98 . S XUSPT(6)=$P(DIC4,U,3)
     99 . S XUSPT(7)=$P(DIC4,U,4)
     100 . I XUSPT(7) S XUSPT(7)=$P($G(^DIC(5,XUSPT(7),0)),U,2)
     101 . S XUSPT(8)=$P(DIC4,U,5)
     102 . S PTPMAIL=XUSPT(4)_U_XUSPT(5)_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)
     103 S XUSHDR="Station: "_SITE_U_XUSPT(6)_U_XUSPT(7)_U_XUSPT(8)_U_"TYPE 2"_U_XUSVER
     104 ;
     105 Q
     106 ;
     107PROC2(XUSRTN) ;Process all Institution records
     108 N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM
     109 N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA
     110 N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA
     111 ; set counter
     112 S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
     113 ; Loop through INSTITUTION NPI records NPI xref
     114 S XUSNPI=0
     115 F  S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI  D
     116 . S INIEN=$O(^DIC(4,"ANPI",XUSNPI,""))
     117 . ;
     118 . ; Get Station Number
     119 . S XUSSTA=$P($G(^DIC(4,INIEN,99)),U)
     120 . ; Parent of Association
     121 . I (INIEN'=INST)&('$$POA(INIEN,INST)) Q
     122 . ; Initialize columns
     123 . F XUSI=1:1:24 S XUSIN(XUSI)=""
     124 . ;
     125 . S XUSIN(1)=XUSNPI
     126 . S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0=""
     127 . ;Organization Name 
     128 . S XUSIN(2)=$P($G(DIC0),U)
     129 . S XUSIN(3)=2
     130 . S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3)
     131 . ;
     132 . ; Pay to Provider Address
     133 . S XUSDATA2=PTPMAIL
     134 . ;
     135 . ; Servicing Provider Address
     136 . S DIC1=$G(^DIC(4,INIEN,1))
     137 . I DIC1'="" D
     138 . . S XUSIN(9)=$P(DIC1,U)
     139 . . S XUSIN(10)=$P(DIC1,U,2)
     140 . . S XUSIN(11)=$P(DIC1,U,3)
     141 . . S XUSIN(12)=$P($G(DIC0),U,2)
     142 . . I XUSIN(12) S XUSIN(12)=$P($G(^DIC(5,XUSIN(12),0)),U,2)
     143 . . S XUSIN(13)=$P(DIC1,U,4)
     144 . S XUSDATA3=XUSIN(9)_U_XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)
     145 . ;
     146 . ;Phone number (place holder)
     147 . S XUSIN(14)=""
     148 . ;
     149 . ; Get Taxonomy and Specialty
     150 . S XUSTXY=0
     151 . F  S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY  D
     152 . . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9)
     153 . . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7)
     154 . . I XUSSPC'="" D
     155 . . . I XUSIN(15)="" S XUSIN(15)=XUSSPC Q
     156 . . . S XUSIN(15)=XUSIN(15)_";"_XUSSPC
     157 . . I XUSTAX'="" D
     158 . . . I XUSIN(16)="" S XUSIN(16)=XUSTAX Q
     159 . . . S XUSIN(16)=XUSIN(16)_";"_XUSTAX
     160 . ;
     161 . ; Federal Tax ID
     162 . S XUSIN(17)=$G(XUSTAXID)
     163 . ;
     164 . ; Medicaid Part A/B
     165 . S XUSIN(18)=670899
     166 . S XUSIN(19)="VA"_$E(SITE+10000,2,5)
     167 . ;
     168 . S XUSDATA4=XUSIN(14)_U_XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)
     169 . ;
     170 . ; DEA Number
     171 . S XUSIN(20)=$P($G(^DIC(4,INIEN,"DEA")),U)
     172 . ;
     173 . ; get Facility Type and Name
     174 . S XUSFCT=$P($G(^DIC(4,INIEN,3)),U)
     175 . I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U)
     176 . I $G(XUSFCN)="PHARM" D
     177 . . I $D(^TMP("XUSNPIX",$J,INIEN)) D
     178 . . . S XUPHM=^TMP("XUSNPIX",$J,INIEN)
     179 . . . ; get NCPDP from ^TMP
     180 . . . S XUSIN(21)=$P($G(XUPHM),U)
     181 . . . ; get station number from^TMP
     182 . . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2)
     183 . ;
     184 . ; VISN Station Number
     185 . S XUSIN(22)=XUSSTA
     186 . ;
     187 . S XUSDATA5=XUSIN(20)_U_XUSIN(21)_U_XUSIN(22)
     188 . ;
     189 . ; Get BCBS Payer ID Array
     190 . K XUSBXID
     191 . D INSTID^XUSNPIXU(.XUSBXID)
     192 . ;
     193 . ; Update counter and save Entry
     194 . ;
     195 . S COUNT=COUNT+1,TOTREC=TOTREC+1
     196 . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL
     197 . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
     198 . I $D(XUSBXID) D
     199 . . S XUSB=""
     200 . . F  S XUSB=$O(XUSBXID(XUSB)) Q:XUSB=""  D
     201 . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
     202 . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL
     203 . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
     204 . K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID
     205 . I XUSIZE>MAXSIZE D
     206 . . D EOF(XUSRTN)
     207 . . D EMAIL(XUSRTN)
     208 . . D VMAIL(XUSRTN)
     209 . . S ^TMP(XUSRTN,$J,1)=XUSHDR
     210 . . S COUNT=1,XUSIZE=0
     211 ;
     212 D EOF(XUSRTN)
     213 K XUSPT,PTPMAIL,LDTCMP,SITE,XUSTAXID
     214 Q
     215 ;
     216EOF(XUSRTN) ;
     217 S MSGCNT=MSGCNT+1
     218 S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL
     219 S COUNT=COUNT+1
     220 S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
     221 Q
     222 ;
     223 ; EMail the message
     224EMAIL(XUSRTN) ;
     225 N XMY
     226 ; Send email to designated recipient for live release
     227 S XMY("XXX@Q-NPS.VA.GOV")=""
     228 ;S XMY(DUZ)="" ;use for testing - remove before live   
     229 D ESEND
     230 Q
     231 ;
     232VMAIL(XUSRTN) ; verification email
     233 N TMP
     234 S TMP=^TMP(XUSRTN,$J,1)
     235 K ^TMP(XUSRTN,$J)
     236 S ^TMP(XUSRTN,$J,1)=$P(TMP,U,1,4)
     237 S ^TMP(XUSRTN,$J,2)=""
     238 S ^TMP(XUSRTN,$J,3)="TYPE 1 : INSTITUTION FILE (#4)"
     239 S ^TMP(XUSRTN,$J,4)=""
     240 S ^TMP(XUSRTN,$J,5)="Date/Time of Extract:   "_$P(TMP,U,9)
     241 S ^TMP(XUSRTN,$J,6)=""
     242 S ^TMP(XUSRTN,$J,7)="Message number: "_MSGCNT_"  Total NPI records: "_(COUNT-2)
     243 S ^TMP(XUSRTN,$J,8)=""
     244 S ^TMP(XUSRTN,$J,9)="Programmer Notes:   "_XUSVER_" - "_$P(TMP,U,10)
     245 ; Send verification email to local mail group and VA Outlook mail group
     246 S XMY("G.NPI EXTRACT VERIFICATION")=""
     247 D ESEND
     248 K ^TMP(XUSRTN)
     249 Q
     250ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ
     251 ;Q
     252 S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
     253 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2"
     254 D ^XMD
     255 Q
     256POA(IEN,INST) ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain
     257 N XUSPOA
     258 I +$G(INST)=0 Q 0 ; No institution - return false
     259POA1 ;
     260 I $G(IEN)="" Q 0 ; No IEN remaining to check - return false
     261 I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false
     262 S XUSPOA(IEN)=""
     263 S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution
     264 I XUSPOA=INST Q 1 ; Found matching institution - return true
     265 I IEN=XUSPOA Q 0 ; Top level reached - return false
     266 S IEN=XUSPOA ; Reset IEN to check next level
     267 G POA1
     268 ;
     269GETPHARM ;
     270 ; this subroutine retrieves data from the OUTPATIENT SITE file
     271 ; using the supported Pharmacy API PSS^PSO59.
     272 ; It takes the results and places them into a temporary
     273 ; global array that is accessed when processing data
     274 ; associated with a pharmacy institution.
     275 N XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP
     276 K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes
     277 D PSS^PSO59(,"??","XUS59")
     278 S XUS59DA=0
     279 ; gather data from each Outpatient site entry stored in the pharmacy
     280 ; ^TMP global and build 2nd ^TMP global for later processing
     281 F  S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA  D
     282 . ;
     283 . ;Get Pharmacy NPI institution from API
     284 . S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U)
     285 . Q:XUSNPIDA']""  ; NPI institution does not exist
     286 . ;
     287 . ; Get Pharmacy Related Institution from API
     288 . S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U)
     289 . ; get station number off the related institution
     290 . S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U)
     291 . ;
     292 . ; Get NCPDP number
     293 . S XUNCP=""   ;prevent previous values being carried over
     294 . S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC
     295 . I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02)
     296 . S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U)
     297 . ;
     298 . ; rebuild the ^TMP global by NPI institution
     299 . ; collect necessary data used in the 'PHARM' logic
     300 . S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station
     301 Q
Note: See TracChangeset for help on using the changeset viewer.