Released XU*8*548 SEQ #444 Extracted from mail message **KIDS**:XU*8.0*548^ **INSTALL NAME** XU*8.0*548 "BLD",8443,0) XU*8.0*548^KERNEL^0^3101104^y "BLD",8443,1,0) ^^2^2^3101025^ "BLD",8443,1,1,0) This is the NPI Crosswalk Extract that has been modified as "BLD",8443,1,2,0) requested by CBO. "BLD",8443,4,0) ^9.64PA^^ "BLD",8443,6) 11^ "BLD",8443,6.3) 24 "BLD",8443,"KRN",0) ^9.67PA^779.2^20 "BLD",8443,"KRN",.4,0) .4 "BLD",8443,"KRN",.4,"NM",0) ^9.68A^^ "BLD",8443,"KRN",.401,0) .401 "BLD",8443,"KRN",.402,0) .402 "BLD",8443,"KRN",.403,0) .403 "BLD",8443,"KRN",.5,0) .5 "BLD",8443,"KRN",.84,0) .84 "BLD",8443,"KRN",3.6,0) 3.6 "BLD",8443,"KRN",3.8,0) 3.8 "BLD",8443,"KRN",9.2,0) 9.2 "BLD",8443,"KRN",9.8,0) 9.8 "BLD",8443,"KRN",9.8,"NM",0) ^9.68A^6^6 "BLD",8443,"KRN",9.8,"NM",1,0) XUSNPIX1^^0^B172188323 "BLD",8443,"KRN",9.8,"NM",2,0) XUSNPIX2^^0^B99916076 "BLD",8443,"KRN",9.8,"NM",3,0) XUSNPIX3^^0^B23716384 "BLD",8443,"KRN",9.8,"NM",4,0) XUSNPIX4^^0^B99303079 "BLD",8443,"KRN",9.8,"NM",5,0) XUSNPIX5^^0^B15963770 "BLD",8443,"KRN",9.8,"NM",6,0) XUSNPIXU^^0^B28263362 "BLD",8443,"KRN",9.8,"NM","B","XUSNPIX1",1) "BLD",8443,"KRN",9.8,"NM","B","XUSNPIX2",2) "BLD",8443,"KRN",9.8,"NM","B","XUSNPIX3",3) "BLD",8443,"KRN",9.8,"NM","B","XUSNPIX4",4) "BLD",8443,"KRN",9.8,"NM","B","XUSNPIX5",5) "BLD",8443,"KRN",9.8,"NM","B","XUSNPIXU",6) "BLD",8443,"KRN",19,0) 19 "BLD",8443,"KRN",19.1,0) 19.1 "BLD",8443,"KRN",101,0) 101 "BLD",8443,"KRN",409.61,0) 409.61 "BLD",8443,"KRN",771,0) 771 "BLD",8443,"KRN",779.2,0) 779.2 "BLD",8443,"KRN",870,0) 870 "BLD",8443,"KRN",8989.51,0) 8989.51 "BLD",8443,"KRN",8989.52,0) 8989.52 "BLD",8443,"KRN",8994,0) 8994 "BLD",8443,"KRN","B",.4,.4) "BLD",8443,"KRN","B",.401,.401) "BLD",8443,"KRN","B",.402,.402) "BLD",8443,"KRN","B",.403,.403) "BLD",8443,"KRN","B",.5,.5) "BLD",8443,"KRN","B",.84,.84) "BLD",8443,"KRN","B",3.6,3.6) "BLD",8443,"KRN","B",3.8,3.8) "BLD",8443,"KRN","B",9.2,9.2) "BLD",8443,"KRN","B",9.8,9.8) "BLD",8443,"KRN","B",19,19) "BLD",8443,"KRN","B",19.1,19.1) "BLD",8443,"KRN","B",101,101) "BLD",8443,"KRN","B",409.61,409.61) "BLD",8443,"KRN","B",771,771) "BLD",8443,"KRN","B",779.2,779.2) "BLD",8443,"KRN","B",870,870) "BLD",8443,"KRN","B",8989.51,8989.51) "BLD",8443,"KRN","B",8989.52,8989.52) "BLD",8443,"KRN","B",8994,8994) "BLD",8443,"QDEF") ^^^^NO^^^^NO^^NO "BLD",8443,"QUES",0) ^9.62^^ "BLD",8443,"REQB",0) ^9.611^2^2 "BLD",8443,"REQB",1,0) XU*8.0*528^1 "BLD",8443,"REQB",2,0) XU*8.0*549^1 "BLD",8443,"REQB","B","XU*8.0*528",1) "BLD",8443,"REQB","B","XU*8.0*549",2) "MBREQ") 0 "PKG",172,-1) 1^1 "PKG",172,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",172,20,0) ^9.402P^^ "PKG",172,22,0) ^9.49I^1^1 "PKG",172,22,1,0) 8.0^2950703^2981210 "PKG",172,22,1,"PAH",1,0) 548^3101104^1157 "PKG",172,22,1,"PAH",1,1,0) ^^2^2^3101104 "PKG",172,22,1,"PAH",1,1,1,0) This is the NPI Crosswalk Extract that has been modified as "PKG",172,22,1,"PAH",1,1,2,0) requested by CBO. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","XUSNPIX1") 0^1^B172188323^B78458745 "RTN","XUSNPIX1",1,0) XUSNPIX1 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/9/08 18:18 "RTN","XUSNPIX1",2,0) ;;8.0;KERNEL;**438,452,453,481,528,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIX1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUSNPIX1",4,0) ; "RTN","XUSNPIX1",5,0) ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by "RTN","XUSNPIX1",6,0) ; Integration Agreement #4964. "RTN","XUSNPIX1",7,0) ; "RTN","XUSNPIX1",8,0) ; "RTN","XUSNPIX1",9,0) ; NPI Extract Report "RTN","XUSNPIX1",10,0) ; "RTN","XUSNPIX1",11,0) ; Input parameter: N/A "RTN","XUSNPIX1",12,0) ; "RTN","XUSNPIX1",13,0) ; Other relevant variables: "RTN","XUSNPIX1",14,0) ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP "RTN","XUSNPIX1",15,0) ; storage subscript) "RTN","XUSNPIX1",16,0) ; Storage Global: "RTN","XUSNPIX1",17,0) ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 "RTN","XUSNPIX1",18,0) ; where: "RTN","XUSNPIX1",19,0) ; Piece 1 => Purge Date - 1 year in future "RTN","XUSNPIX1",20,0) ; Piece 2 => Create Date - Today "RTN","XUSNPIX1",21,0) ; Piece 3 => Description "RTN","XUSNPIX1",22,0) ; Piece 4 => Last Date Compiled "RTN","XUSNPIX1",23,0) ; Piece 5 => $H last run start time "RTN","XUSNPIX1",24,0) ; Piece 6 => $H last run completion time "RTN","XUSNPIX1",25,0) ; "RTN","XUSNPIX1",26,0) ; ^XTMP("XUSNPIX1",1) = DATA "RTN","XUSNPIX1",27,0) ; "RTN","XUSNPIX1",28,0) ; XUSNPI => Unique NPI of entry "RTN","XUSNPIX1",29,0) ; LDT => Last Date Run, VA Fileman Format "RTN","XUSNPIX1",30,0) ; "RTN","XUSNPIX1",31,0) ; Entry Point - TASKMAN => Run report in background using TASKMAN "RTN","XUSNPIX1",32,0) ; "RTN","XUSNPIX1",33,0) Q "RTN","XUSNPIX1",34,0) ; "RTN","XUSNPIX1",35,0) TASKMAN ;TASKMAN ENTRY POINT "RTN","XUSNPIX1",36,0) ; Process Report "RTN","XUSNPIX1",37,0) N XUSRTN,DTTM,XUSPROD,XUSVER,INSMAIL,XUSNP2P,XUSTMP "RTN","XUSNPIX1",38,0) ; "RTN","XUSNPIX1",39,0) ; Check for required variables "RTN","XUSNPIX1",40,0) I $G(U)=""!($G(DT)="") G EXIT "RTN","XUSNPIX1",41,0) S XUSRTN="XUSNPIX1" "RTN","XUSNPIX1",42,0) S DTTM=$$HTE^XLFDT($H,"2") "RTN","XUSNPIX1",43,0) ; Check to see if report is in use "RTN","XUSNPIX1",44,0) L +^XTMP(XUSRTN):5 I '$T G EXIT "RTN","XUSNPIX1",45,0) ; "RTN","XUSNPIX1",46,0) ;Reset Summary Scratch Globals "RTN","XUSNPIX1",47,0) K ^TMP("XUSNPIXS",$J) "RTN","XUSNPIX1",48,0) K ^TMP("XUSNPIXT",$J) "RTN","XUSNPIX1",49,0) ; "RTN","XUSNPIX1",50,0) ; Initialize variables "RTN","XUSNPIX1",51,0) D INIT(XUSRTN) "RTN","XUSNPIX1",52,0) ; "RTN","XUSNPIX1",53,0) ; Pull Station(Institution) data "RTN","XUSNPIX1",54,0) D INST(XUSRTN,XUSVER,.INSMAIL) "RTN","XUSNPIX1",55,0) ; "RTN","XUSNPIX1",56,0) ;Process New Person File "RTN","XUSNPIX1",57,0) D PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) "RTN","XUSNPIX1",58,0) ; "RTN","XUSNPIX1",59,0) ; Process Institution File "RTN","XUSNPIX1",60,0) D ENT^XUSNPIX2(XUSPROD,XUSVER) "RTN","XUSNPIX1",61,0) ; "RTN","XUSNPIX1",62,0) ; Process Non VA File "RTN","XUSNPIX1",63,0) D ENT^XUSNPIX3(XUSPROD,XUSVER) "RTN","XUSNPIX1",64,0) ; "RTN","XUSNPIX1",65,0) ; Send summary message "RTN","XUSNPIX1",66,0) D SMAIL^XUSNPIX5("XUSNPIXT",XUSPROD,XUSVER,DTTM) "RTN","XUSNPIX1",67,0) ; "RTN","XUSNPIX1",68,0) ;Standard EXIT point "RTN","XUSNPIX1",69,0) EXIT ; "RTN","XUSNPIX1",70,0) K DTTM,XUSVER,XUSHDR,XUSPROD,INSMAIL "RTN","XUSNPIX1",71,0) ; "RTN","XUSNPIX1",72,0) ;Kill off Scratch Globals "RTN","XUSNPIX1",73,0) K ^TMP("XUSNPIXS",$J) "RTN","XUSNPIX1",74,0) K ^TMP("XUSNPIXT",$J) "RTN","XUSNPIX1",75,0) K ^TMP("XUSNPIXU",$J) "RTN","XUSNPIX1",76,0) K ^TMP("P2P") "RTN","XUSNPIX1",77,0) ; Log Run Completion Time "RTN","XUSNPIX1",78,0) S $P(^XTMP(XUSRTN,0),U,6)=$H "RTN","XUSNPIX1",79,0) L -^XTMP(XUSRTN) "RTN","XUSNPIX1",80,0) ; "RTN","XUSNPIX1",81,0) Q "RTN","XUSNPIX1",82,0) ; "RTN","XUSNPIX1",83,0) INIT(XUSRTN) ; check/init variables "RTN","XUSNPIX1",84,0) N XUSDESC,IBSIEN,ZN19,P2PVAL "RTN","XUSNPIX1",85,0) ; Set to NEXT release version from NPM "RTN","XUSNPIX1",86,0) ; Update the build number here. "RTN","XUSNPIX1",87,0) S XUSVER="548.14" ; last patch to update the structure of the data extract (XU*8.0*548) "RTN","XUSNPIX1",88,0) ; "RTN","XUSNPIX1",89,0) ; Get production/test account flag "RTN","XUSNPIX1",90,0) S XUSPROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST") "RTN","XUSNPIX1",91,0) ; "RTN","XUSNPIX1",92,0) ; Reset Temporary Scratch Global "RTN","XUSNPIX1",93,0) D INIT^XUSNPIXU "RTN","XUSNPIX1",94,0) K ^TMP(XUSRTN) "RTN","XUSNPIX1",95,0) S XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete" "RTN","XUSNPIX1",96,0) S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H "RTN","XUSNPIX1",97,0) ; Generate TMP BCBS Array "RTN","XUSNPIX1",98,0) D BCBSID^XUSNPIXU "RTN","XUSNPIX1",99,0) D P2PBASE^XUSNPIXU(.XUSTMP) ;XUSTMP array used for Type 1 and 2 VA "RTN","XUSNPIX1",100,0) Q "RTN","XUSNPIX1",101,0) ; "RTN","XUSNPIX1",102,0) MAILTO(XMY) ;sets the MailMan recipients based on need (XU*8.0*548) "RTN","XUSNPIX1",103,0) ; "RTN","XUSNPIX1",104,0) ;When you don't want data to go out to Austin's FSC but you need it to "RTN","XUSNPIX1",105,0) ;stay within the VistA's MailMan for internal testing, comment out setting "RTN","XUSNPIX1",106,0) ;the XMY("XXX@Q-NPS.VA.GOV) array and add your own MailMan address that "RTN","XUSNPIX1",107,0) ;is present in the VistA account your are on. An example of an email address "RTN","XUSNPIX1",108,0) ;for testing purposes is below. "RTN","XUSNPIX1",109,0) ; "RTN","XUSNPIX1",110,0) ;S XMY("TJERNAGEL.STEVE@MNTVBB.FO-ALBANY.MED.VA.GOV")="" ; for testing only "RTN","XUSNPIX1",111,0) ;S XMY("TJERNAGEL.STEVE@CHEY65.FO-BAYPINES.MED.VA.GOV")="" ;for CHEY65 testing only "RTN","XUSNPIX1",112,0) ;S XMY("NULL.RODGER_B@MNTVBB.FO-ALBANY.MED.VA.GOV")="" ; for testing only "RTN","XUSNPIX1",113,0) ;S XMY("NULL.RODGER@CHEY65.FO-BAYPINES.MED.VA.GOV")="" ; for CHEY65 testing only "RTN","XUSNPIX1",114,0) ;S XMY("WHITE.DARLENE@MNTVBB.FO-ALBANY.MED.VA.GOV")="" ; for testing only "RTN","XUSNPIX1",115,0) ;S XMY("WHITE.DARLENE@CHEY65.FO-BAYPINES.MED.VA.GOV")="" ; for CHEY65 testing only "RTN","XUSNPIX1",116,0) ; "RTN","XUSNPIX1",117,0) ;When you want data to go out to Austin's FSC group, uncomment this line. "RTN","XUSNPIX1",118,0) S XMY("XXX@Q-NPS.VA.GOV")="" ;uncomment to run for live *** "RTN","XUSNPIX1",119,0) Q "RTN","XUSNPIX1",120,0) ; "RTN","XUSNPIX1",121,0) INST(XUSRTN,XUSVER,INSMAIL) ;Pull station and Institution info "RTN","XUSNPIX1",122,0) N INST,SINFO,DIC4 "RTN","XUSNPIX1",123,0) ; Pull site info "RTN","XUSNPIX1",124,0) S SINFO=$$SITE^VASITE "RTN","XUSNPIX1",125,0) ; Station Number "RTN","XUSNPIX1",126,0) S SITE=$P(SINFO,U,3) "RTN","XUSNPIX1",127,0) ; Institution "RTN","XUSNPIX1",128,0) S INST=$P(SINFO,U) "RTN","XUSNPIX1",129,0) ; "RTN","XUSNPIX1",130,0) ; Get institution mailing address "RTN","XUSNPIX1",131,0) I INST D "RTN","XUSNPIX1",132,0) . S DIC4=$G(^DIC(4,INST,4)) "RTN","XUSNPIX1",133,0) . S XUSNP(7)=$P(DIC4,U) "RTN","XUSNPIX1",134,0) . S XUSNP(8)=$P(DIC4,U,2) "RTN","XUSNPIX1",135,0) . S XUSNP(9)=$P(DIC4,U,3) "RTN","XUSNPIX1",136,0) . S XUSNP(10)=$P(DIC4,U,4) "RTN","XUSNPIX1",137,0) . I XUSNP(10) S XUSNP(10)=$P($G(^DIC(5,XUSNP(10),0)),U,2) "RTN","XUSNPIX1",138,0) . S XUSNP(11)=$P(DIC4,U,5) "RTN","XUSNPIX1",139,0) . S INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11) "RTN","XUSNPIX1",140,0) S XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER "RTN","XUSNPIX1",141,0) ; "RTN","XUSNPIX1",142,0) Q "RTN","XUSNPIX1",143,0) ; "RTN","XUSNPIX1",144,0) PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) ;Process all New Person records "RTN","XUSNPIX1",145,0) N XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN "RTN","XUSNPIX1",146,0) N XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13,COUNT,MSGCNT,MAXSIZE,TOTREC,XUSEOL "RTN","XUSNPIX1",147,0) N FND,XUSUSCT,XUSUSC1,I "RTN","XUSNPIX1",148,0) ; "RTN","XUSNPIX1",149,0) ; Set to 300000 for live "RTN","XUSNPIX1",150,0) S MAXSIZE=300000 "RTN","XUSNPIX1",151,0) ; "RTN","XUSNPIX1",152,0) ; Set end of line character "RTN","XUSNPIX1",153,0) S XUSEOL="~~" "RTN","XUSNPIX1",154,0) ; "RTN","XUSNPIX1",155,0) ; set counter "RTN","XUSNPIX1",156,0) S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0 "RTN","XUSNPIX1",157,0) ; "RTN","XUSNPIX1",158,0) ; Loop through NEW PERSON NPI records NPI cross ref "RTN","XUSNPIX1",159,0) S XUSNPI=0 "RTN","XUSNPIX1",160,0) F S XUSNPI=$O(^VA(200,"ANPI",XUSNPI)) Q:'XUSNPI D "RTN","XUSNPIX1",161,0) . S NPIEN=$O(^VA(200,"ANPI",XUSNPI,"")) "RTN","XUSNPIX1",162,0) . ; "RTN","XUSNPIX1",163,0) . ; Init columns "RTN","XUSNPIX1",164,0) . ;F XUSI=1:1:29 S XUSNP(XUSI)="" "RTN","XUSNPIX1",165,0) . F XUSI=1:1:33 S XUSNP(XUSI)="" "RTN","XUSNPIX1",166,0) . S XUSNP(1)=XUSNPI S XUSDATA1=XUSNP(1) "RTN","XUSNPIX1",167,0) . ; "RTN","XUSNPIX1",168,0) . S XUSVA0=$G(^VA(200,NPIEN,0)) "RTN","XUSNPIX1",169,0) . S XUSVA1=$G(^VA(200,NPIEN,1)) "RTN","XUSNPIX1",170,0) . S XUSNAME=$P(XUSVA0,U) "RTN","XUSNPIX1",171,0) . ; "RTN","XUSNPIX1",172,0) . ; Break name into components "RTN","XUSNPIX1",173,0) . I XUSNAME'="" D "RTN","XUSNPIX1",174,0) . . S XLFNC=XUSNAME D FORMAT^XLFNAME7(.XLFNC,,,,0) "RTN","XUSNPIX1",175,0) . . S XUSNP(2)=XLFNC("GIVEN"),XUSNP(3)=XLFNC("MIDDLE"),XUSNP(4)=XLFNC("FAMILY") "RTN","XUSNPIX1",176,0) . . I XLFNC("SUFFIX")'="" S XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX") "RTN","XUSNPIX1",177,0) . . K XLFNC "RTN","XUSNPIX1",178,0) . S XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4) "RTN","XUSNPIX1",179,0) . ; "RTN","XUSNPIX1",180,0) . S XUSNP(5)=1 ;type "RTN","XUSNPIX1",181,0) . S XUSDOB=$P(XUSVA1,U,3) "RTN","XUSNPIX1",182,0) . ; dob formatted as mm/dd/yyyy "RTN","XUSNPIX1",183,0) . I XUSDOB D "RTN","XUSNPIX1",184,0) . . S XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5) "RTN","XUSNPIX1",185,0) . S XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6) "RTN","XUSNPIX1",186,0) . ; "RTN","XUSNPIX1",187,0) . ; Office Phone number "RTN","XUSNPIX1",188,0) . S XUSOPN=$P($G(^VA(200,NPIEN,.13)),U,2) "RTN","XUSNPIX1",189,0) . ;I XUSOPN'="" S XUSNP(17)=XUSOPN "RTN","XUSNPIX1",190,0) . I XUSOPN'="" S XUSNP(18)=XUSOPN "RTN","XUSNPIX1",191,0) . ; "RTN","XUSNPIX1",192,0) . ; Servicing Provider Address "RTN","XUSNPIX1",193,0) . S (XUSDIV)=0 "RTN","XUSNPIX1",194,0) . ; Loop through Division multiple "RTN","XUSNPIX1",195,0) . F S XUSDIV=$O(^VA(200,NPIEN,2,XUSDIV)) Q:'XUSDIV D "RTN","XUSNPIX1",196,0) . . S DIC4=$G(^DIC(4,XUSDIV,4)) "RTN","XUSNPIX1",197,0) . . S XUSNP(13)=$P(DIC4,U) "RTN","XUSNPIX1",198,0) . . S XUSNP(14)=$P(DIC4,U,2) "RTN","XUSNPIX1",199,0) . . S XUSNP(15)=$P(DIC4,U,3) "RTN","XUSNPIX1",200,0) . . S XUSNP(16)=$P(DIC4,U,4) "RTN","XUSNPIX1",201,0) . . I XUSNP(16) S XUSNP(16)=$P($G(^DIC(5,XUSNP(16),0)),U,2) "RTN","XUSNPIX1",202,0) . . S XUSNP(17)=$P(DIC4,U,5) "RTN","XUSNPIX1",203,0) . . S XUSSTA(XUSDIV)=$P($G(^DIC(4,XUSDIV,99)),U) "RTN","XUSNPIX1",204,0) . . S SPADR(XUSDIV)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18) "RTN","XUSNPIX1",205,0) . ; "RTN","XUSNPIX1",206,0) . ; If no divisions found "RTN","XUSNPIX1",207,0) . I '$D(SPADR) D "RTN","XUSNPIX1",208,0) . . S XUSSTA(9999)="N/A",SPADR(9999)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18) "RTN","XUSNPIX1",209,0) . ; "RTN","XUSNPIX1",210,0) . ; Degree "RTN","XUSNPIX1",211,0) . S XUSNP(19)=$P($G(^VA(200,NPIEN,3.1)),U,6) "RTN","XUSNPIX1",212,0) . ; Degree Code (place holder, currently empty) "RTN","XUSNPIX1",213,0) . S XUSNP(20)="" "RTN","XUSNPIX1",214,0) . ; "RTN","XUSNPIX1",215,0) . ; get primary specialty "RTN","XUSNPIX1",216,0) . S XUSPER=0 "RTN","XUSNPIX1",217,0) . F S XUSPER=$O(^VA(200,NPIEN,"USC1","B",XUSPER)) Q:'XUSPER D "RTN","XUSNPIX1",218,0) . . S XUSSPC=$P($G(^USC(8932.1,XUSPER,0)),U,9) "RTN","XUSNPIX1",219,0) . . ;S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7) "RTN","XUSNPIX1",220,0) . . I XUSSPC'="" D "RTN","XUSNPIX1",221,0) . . . ;I XUSNP(20)="" S XUSNP(20)=XUSSPC Q "RTN","XUSNPIX1",222,0) . . . ;S XUSNP(20)=XUSNP(20)_";"_XUSSPC "RTN","XUSNPIX1",223,0) . . . I XUSNP(21)="" S XUSNP(21)=XUSSPC Q "RTN","XUSNPIX1",224,0) . . . S XUSNP(21)=XUSNP(21)_";"_XUSSPC "RTN","XUSNPIX1",225,0) . . . Q "RTN","XUSNPIX1",226,0) . . Q "RTN","XUSNPIX1",227,0) . ;get taxonomy (primary and all secondaries) "RTN","XUSNPIX1",228,0) . N XUSCLASS,XUSEXPDT ; ptr to Person class, expiration date "RTN","XUSNPIX1",229,0) . S XUSPER=0 "RTN","XUSNPIX1",230,0) . K ^XTMP("USC1",$J) "RTN","XUSNPIX1",231,0) . F S XUSPER=$O(^VA(200,NPIEN,"USC1","AD",XUSPER)) Q:'XUSPER D "RTN","XUSNPIX1",232,0) . . S XUSUSC1="" "RTN","XUSNPIX1",233,0) . . F S XUSUSC1=$O(^VA(200,NPIEN,"USC1","AD",XUSPER,XUSUSC1)) Q:XUSUSC1="" D "RTN","XUSNPIX1",234,0) . . . S XUSCLASS=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U),XUSEXPDT=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U,3) "RTN","XUSNPIX1",235,0) . . . S ^XTMP("USC1",$J,XUSUSC1)=XUSEXPDT_U_XUSCLASS "RTN","XUSNPIX1",236,0) . . . Q "RTN","XUSNPIX1",237,0) . . Q "RTN","XUSNPIX1",238,0) . ;find primary taxonomy code "RTN","XUSNPIX1",239,0) . S XUSUSC1="",FND=0,XUSUSCT="" "RTN","XUSNPIX1",240,0) . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1),-1) Q:XUSUSC1=""!(FND=1) D "RTN","XUSNPIX1",241,0) . . I $P($G(^XTMP("USC1",$J,XUSUSC1)),U)'="" Q ; not active, expiration dt exists "RTN","XUSNPIX1",242,0) . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2) "RTN","XUSNPIX1",243,0) . . I XUSCLASS="" Q "RTN","XUSNPIX1",244,0) . . S XUSNP(22)=$P($G(^USC(8932.1,XUSCLASS,0)),U,7),FND=1,XUSUSCT=XUSUSC1 "RTN","XUSNPIX1",245,0) . . Q "RTN","XUSNPIX1",246,0) . I $D(^XTMP("USC1",$J))&$G(XUSUSCT) K ^XTMP("USC1",$J,XUSUSCT) ;remove the active taxonomy code "RTN","XUSNPIX1",247,0) . S XUSUSC1="" "RTN","XUSNPIX1",248,0) . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1)) Q:XUSUSC1="" D "RTN","XUSNPIX1",249,0) . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2) "RTN","XUSNPIX1",250,0) . . I XUSCLASS="" Q "RTN","XUSNPIX1",251,0) . . S XUSTAX=$P($G(^USC(8932.1,XUSCLASS,0)),U,7) "RTN","XUSNPIX1",252,0) . . I XUSTAX'="" D "RTN","XUSNPIX1",253,0) . . . ; "RTN","XUSNPIX1",254,0) . . . I XUSNP(23)="" S XUSNP(23)=XUSTAX Q "RTN","XUSNPIX1",255,0) . . . ; "RTN","XUSNPIX1",256,0) . . . ; *** Start ^XU*8.0*548 - RBN *** "RTN","XUSNPIX1",257,0) . . . ; "RTN","XUSNPIX1",258,0) . . . ;S XUSNP(23)=XUSNP(23)_";"_XUSTAX "RTN","XUSNPIX1",259,0) . . . S:(XUSNP(23)'[XUSTAX&(XUSTAX'=XUSNP(22))) XUSNP(23)=XUSNP(23)_";"_XUSTAX "RTN","XUSNPIX1",260,0) . . . ; "RTN","XUSNPIX1",261,0) . . . ; *** End ^XU*8.0*548 - RBN *** "RTN","XUSNPIX1",262,0) . . . ; "RTN","XUSNPIX1",263,0) . ; "RTN","XUSNPIX1",264,0) . ; Tax ID "RTN","XUSNPIX1",265,0) . S XUSTAXID=$P($G(^VA(200,NPIEN,"TPB")),U,2) "RTN","XUSNPIX1",266,0) . I XUSTAXID="" S XUSTAXID=$P($G(^VA(200,NPIEN,1)),U,9) "RTN","XUSNPIX1",267,0) . ;S XUSNP(22)=XUSTAXID "RTN","XUSNPIX1",268,0) . S XUSNP(24)=XUSTAXID "RTN","XUSNPIX1",269,0) . ; "RTN","XUSNPIX1",270,0) . ;S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22) "RTN","XUSNPIX1",271,0) . S XUSDATA2=XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)_U_XUSNP(23)_U_XUSNP(24) "RTN","XUSNPIX1",272,0) . ; "RTN","XUSNPIX1",273,0) . ; Medicare Part A/B "RTN","XUSNPIX1",274,0) . ;S XUSNP(23)=670899 "RTN","XUSNPIX1",275,0) . ;S XUSNP(24)="VA"_$E(SITE+10000,2,5) "RTN","XUSNPIX1",276,0) . S XUSNP(25)=670899 "RTN","XUSNPIX1",277,0) . S XUSNP(26)="VA"_$E(SITE+10000,2,5) "RTN","XUSNPIX1",278,0) . ; "RTN","XUSNPIX1",279,0) . ; State License "RTN","XUSNPIX1",280,0) . S XUSSTL=0 "RTN","XUSNPIX1",281,0) . F S XUSSTL=$O(^VA(200,NPIEN,"PS1",XUSSTL)) Q:'XUSSTL D "RTN","XUSNPIX1",282,0) . . S XUSSTLN=$P($G(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2) "RTN","XUSNPIX1",283,0) . . I XUSSTLN'="" D "RTN","XUSNPIX1",284,0) . . . ;I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q "RTN","XUSNPIX1",285,0) . . . ;S XUSNP(25)=XUSNP(25)_";"_XUSSTLN "RTN","XUSNPIX1",286,0) . . . I XUSNP(27)="" S XUSNP(27)=XUSSTLN Q "RTN","XUSNPIX1",287,0) . . . ;S XUSNP(27)=XUSNP(27)_";"_XUSSTLN "RTN","XUSNPIX1",288,0) . ; DEA # "RTN","XUSNPIX1",289,0) . ;S XUSNP(26)=$P($G(^VA(200,NPIEN,"PS")),U,2) "RTN","XUSNPIX1",290,0) . S XUSNP(28)=$P($G(^VA(200,NPIEN,"PS")),U,2) "RTN","XUSNPIX1",291,0) . ; "RTN","XUSNPIX1",292,0) . ;S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26) "RTN","XUSNPIX1",293,0) . S XUSDATA2=XUSDATA2_U_XUSNP(25)_U_XUSNP(26)_U_XUSNP(27)_U_XUSNP(28) "RTN","XUSNPIX1",294,0) . ; "RTN","XUSNPIX1",295,0) . ; Add logic for STATUS and CREATION/TERMINATION DATE from file #200 "RTN","XUSNPIX1",296,0) . S XUSNP(29)="",XUSNP(30)="" "RTN","XUSNPIX1",297,0) . S XUSNP(29)=$P($G(^VA(200,NPIEN,0)),U,11) "RTN","XUSNPIX1",298,0) . I $G(XUSNP(29))'="" S XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="TERMINATED" "RTN","XUSNPIX1",299,0) . I $G(XUSNP(29))="" S XUSNP(29)=$P($G(^VA(200,NPIEN,1)),U,7),XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="ACTIVE" "RTN","XUSNPIX1",300,0) . ; "RTN","XUSNPIX1",301,0) . S XUSDATA2=XUSDATA2_U_XUSNP(29)_U_XUSNP(30) "RTN","XUSNPIX1",302,0) . ; "RTN","XUSNPIX1",303,0) . ; Get BCBS Payer ID Array "RTN","XUSNPIX1",304,0) . K XUSBXID "RTN","XUSNPIX1",305,0) . D PRACID^XUSNPIXU(NPIEN,.XUSBXID) "RTN","XUSNPIX1",306,0) . ; "RTN","XUSNPIX1",307,0) . ; Save entry to ^TMP and update count "RTN","XUSNPIX1",308,0) . N XUSB,XUSB1 "RTN","XUSNPIX1",309,0) . S XUSDIV=0 "RTN","XUSNPIX1",310,0) . F S XUSDIV=$O(SPADR(XUSDIV)) Q:'XUSDIV D "RTN","XUSNPIX1",311,0) . . ; "RTN","XUSNPIX1",312,0) . . ; Pay to Provider Address NP7-12 "RTN","XUSNPIX1",313,0) . . I $D(XUSTMP("P2P",XUSDIV)) D "RTN","XUSNPIX1",314,0) . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),0)),U,2) "RTN","XUSNPIX1",315,0) . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,1) "RTN","XUSNPIX1",316,0) . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,2) "RTN","XUSNPIX1",317,0) . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,3) "RTN","XUSNPIX1",318,0) . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,4) "RTN","XUSNPIX1",319,0) . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2) "RTN","XUSNPIX1",320,0) . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,5) "RTN","XUSNPIX1",321,0) . . . Q "RTN","XUSNPIX1",322,0) . . I '$D(XUSTMP("P2P",XUSDIV)) D "RTN","XUSNPIX1",323,0) . . . I '$D(XUSTMP("P2P","DEFAULT")) D Q "RTN","XUSNPIX1",324,0) . . . . F I=7:1:12 S $P(XUSDATA1,U,I)="" "RTN","XUSNPIX1",325,0) . . . N XUSDEF "RTN","XUSNPIX1",326,0) . . . S XUSDEF=$G(XUSTMP("P2P","DEFAULT")) "RTN","XUSNPIX1",327,0) . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,XUSDEF,0)),U,2) "RTN","XUSNPIX1",328,0) . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,1) "RTN","XUSNPIX1",329,0) . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,2) "RTN","XUSNPIX1",330,0) . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,3) "RTN","XUSNPIX1",331,0) . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,4) "RTN","XUSNPIX1",332,0) . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2) "RTN","XUSNPIX1",333,0) . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,5) "RTN","XUSNPIX1",334,0) . . . Q "RTN","XUSNPIX1",335,0) . . ; "RTN","XUSNPIX1",336,0) . . S COUNT=COUNT+1,TOTREC=TOTREC+1 "RTN","XUSNPIX1",337,0) . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL "RTN","XUSNPIX1",338,0) . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) "RTN","XUSNPIX1",339,0) . . ; Check BCBS Id array "RTN","XUSNPIX1",340,0) . . I $D(XUSBXID) D "RTN","XUSNPIX1",341,0) . . . S XUSB="" "RTN","XUSNPIX1",342,0) . . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D "RTN","XUSNPIX1",343,0) . . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p528 "RTN","XUSNPIX1",344,0) . . . . S COUNT=COUNT+1,TOTREC=TOTREC+1 "RTN","XUSNPIX1",345,0) . . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528 "RTN","XUSNPIX1",346,0) . . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) "RTN","XUSNPIX1",347,0) . K XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA "RTN","XUSNPIX1",348,0) . I XUSIZE>MAXSIZE D "RTN","XUSNPIX1",349,0) . . D EOF(XUSRTN) "RTN","XUSNPIX1",350,0) . . D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan "RTN","XUSNPIX1",351,0) . . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX1",352,0) . . S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2) "RTN","XUSNPIX1",353,0) . . S ^TMP(XUSRTN,$J,1)=XUSHDR "RTN","XUSNPIX1",354,0) . . S COUNT=1,XUSIZE=0 "RTN","XUSNPIX1",355,0) D EOF(XUSRTN) "RTN","XUSNPIX1",356,0) ; "RTN","XUSNPIX1",357,0) ; Send the last message (if it has records) "RTN","XUSNPIX1",358,0) I $G(COUNT)>1 D "RTN","XUSNPIX1",359,0) .D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan "RTN","XUSNPIX1",360,0) .K ^TMP(XUSRTN,$J) "RTN","XUSNPIX1",361,0) .S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2) "RTN","XUSNPIX1",362,0) ; "RTN","XUSNPIX1",363,0) ; Set summary totals "RTN","XUSNPIX1",364,0) S ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$H "RTN","XUSNPIX1",365,0) S ^XTMP("XUSNPIXT","H")=$P(XUSHDR,U,1,4) "RTN","XUSNPIX1",366,0) S ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM "RTN","XUSNPIX1",367,0) K INSMAIL,SITE "RTN","XUSNPIX1",368,0) Q "RTN","XUSNPIX1",369,0) ; "RTN","XUSNPIX1",370,0) EOF(XUSRTN) ; "RTN","XUSNPIX1",371,0) Q:COUNT=1 "RTN","XUSNPIX1",372,0) S MSGCNT=MSGCNT+1 "RTN","XUSNPIX1",373,0) S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$G(XUSPROD)_U_XUSEOL "RTN","XUSNPIX1",374,0) S COUNT=COUNT+1 "RTN","XUSNPIX1",375,0) S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX1",376,0) Q "RTN","XUSNPIX2") 0^2^B99916076^B90700763 "RTN","XUSNPIX2",1,0) XUSNPIX2 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:17 "RTN","XUSNPIX2",2,0) ;;8.0;KERNEL;**438,452,453,481,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIX2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUSNPIX2",4,0) ; "RTN","XUSNPIX2",5,0) ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by "RTN","XUSNPIX2",6,0) ; Integration Agreement #4964. "RTN","XUSNPIX2",7,0) ; "RTN","XUSNPIX2",8,0) ; "RTN","XUSNPIX2",9,0) ; NPI Extract Report "RTN","XUSNPIX2",10,0) ; "RTN","XUSNPIX2",11,0) ; Input parameter: N/A "RTN","XUSNPIX2",12,0) ; "RTN","XUSNPIX2",13,0) ; Other relevant variables: "RTN","XUSNPIX2",14,0) ; XUSRTN="XUSNPIX2" (current routine name, used for ^XTMP and ^TMP "RTN","XUSNPIX2",15,0) ; storage subscript) "RTN","XUSNPIX2",16,0) ; Storage Global: "RTN","XUSNPIX2",17,0) ; ^XTMP("XUSNPIX2",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 "RTN","XUSNPIX2",18,0) ; where: "RTN","XUSNPIX2",19,0) ; Piece 1 => Purge Date - 1 year in future "RTN","XUSNPIX2",20,0) ; Piece 2 => Create Date - Today "RTN","XUSNPIX2",21,0) ; Piece 3 => Description "RTN","XUSNPIX2",22,0) ; Piece 4 => Last Date Compiled "RTN","XUSNPIX2",23,0) ; Piece 5 => $H last run start time "RTN","XUSNPIX2",24,0) ; Piece 6 => $H last run completion time "RTN","XUSNPIX2",25,0) ; "RTN","XUSNPIX2",26,0) ; ^XTMP("XUSNPIX2",1) = STATION INFO "RTN","XUSNPIX2",27,0) ; ^XTMP("XUSNPIX2",2) = DATA "RTN","XUSNPIX2",28,0) ; "RTN","XUSNPIX2",29,0) ; NPI => Unique NPI of entry "RTN","XUSNPIX2",30,0) ; LDT => Last Date Run, VA Fileman Format "RTN","XUSNPIX2",31,0) ; "RTN","XUSNPIX2",32,0) ; Entry Point - ENT called from XUSNPIX1 "RTN","XUSNPIX2",33,0) ; "RTN","XUSNPIX2",34,0) Q "RTN","XUSNPIX2",35,0) ; "RTN","XUSNPIX2",36,0) ENT(XUSPROD,XUSVER) ; ENTRY POINT "RTN","XUSNPIX2",37,0) ; Initialize variables "RTN","XUSNPIX2",38,0) N XUSRTN "RTN","XUSNPIX2",39,0) S XUSRTN="XUSNPIX2" "RTN","XUSNPIX2",40,0) S DTTM2=$$HTE^XLFDT($H,"2") "RTN","XUSNPIX2",41,0) ; Check to see if report is in use "RTN","XUSNPIX2",42,0) L +^XTMP(XUSRTN):5 I '$T G EXIT "RTN","XUSNPIX2",43,0) ; Process Institution File "RTN","XUSNPIX2",44,0) D INIT(XUSRTN) "RTN","XUSNPIX2",45,0) ; Pull Station(Institution) data "RTN","XUSNPIX2",46,0) D STAT(XUSRTN) "RTN","XUSNPIX2",47,0) ; Process Report "RTN","XUSNPIX2",48,0) D PROC2(XUSRTN,XUSPROD,DTTM2) "RTN","XUSNPIX2",49,0) ; "RTN","XUSNPIX2",50,0) ; Standard EXIT point "RTN","XUSNPIX2",51,0) EXIT ; "RTN","XUSNPIX2",52,0) K ^TMP(XUSRTN,$J),^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) "RTN","XUSNPIX2",53,0) ; Log Run Completion Time "RTN","XUSNPIX2",54,0) S $P(^XTMP(XUSRTN,0),U,6)=$H "RTN","XUSNPIX2",55,0) L -^XTMP(XUSRTN) "RTN","XUSNPIX2",56,0) K P,XUSPT,INST,DTTM2,XUSIZE,XUSHDR,XUSTAXID "RTN","XUSNPIX2",57,0) Q "RTN","XUSNPIX2",58,0) ; "RTN","XUSNPIX2",59,0) INIT(XUSRTN) ; check/init variables "RTN","XUSNPIX2",60,0) N XUSDESC "RTN","XUSNPIX2",61,0) ; "RTN","XUSNPIX2",62,0) ; Reset Temporary Scratch Global "RTN","XUSNPIX2",63,0) K ^TMP(XUSRTN) "RTN","XUSNPIX2",64,0) S XUSDESC="NPI EXTRACT TYPE 2 - Do Not Delete" "RTN","XUSNPIX2",65,0) S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H "RTN","XUSNPIX2",66,0) ; "RTN","XUSNPIX2",67,0) I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU "RTN","XUSNPIX2",68,0) ; "RTN","XUSNPIX2",69,0) ; Create pharmacy institution ^TMP file "RTN","XUSNPIX2",70,0) D GETPHARM "RTN","XUSNPIX2",71,0) Q "RTN","XUSNPIX2",72,0) ; "RTN","XUSNPIX2",73,0) STAT(XUSRTN) ; Pull station and Institution info "RTN","XUSNPIX2",74,0) N SINFO,DIC4,IBSITE,XUSCITY,XUSSTATE,XUSZIP "RTN","XUSNPIX2",75,0) S (XUSCITY,XUSSTATE,XUSZIP)="" "RTN","XUSNPIX2",76,0) ; Pull site info "RTN","XUSNPIX2",77,0) S SINFO=$$SITE^VASITE "RTN","XUSNPIX2",78,0) ; Station Number "RTN","XUSNPIX2",79,0) S SITE=$P(SINFO,U,3) "RTN","XUSNPIX2",80,0) ; Institution "RTN","XUSNPIX2",81,0) S INST=$P(SINFO,U) "RTN","XUSNPIX2",82,0) ; "RTN","XUSNPIX2",83,0) ; Get Federal Tax Id "RTN","XUSNPIX2",84,0) S XUSTAXID="" "RTN","XUSNPIX2",85,0) S IBSITE=0 "RTN","XUSNPIX2",86,0) F S IBSITE=$O(^IBE(350.9,IBSITE)) Q:'IBSITE!(XUSTAXID'="") D "RTN","XUSNPIX2",87,0) . S XUSTAXID=$P($G(^IBE(350.9,IBSITE,1)),U,5) "RTN","XUSNPIX2",88,0) ; "RTN","XUSNPIX2",89,0) ; *** Start XU*8.0*548 - RBN *** "RTN","XUSNPIX2",90,0) ; Get header for extracted data NOT email "RTN","XUSNPIX2",91,0) I INST D "RTN","XUSNPIX2",92,0) . S DIC4=$G(^DIC(4,INST,4)) "RTN","XUSNPIX2",93,0) . S XUSCITY=$P(DIC4,U,3) "RTN","XUSNPIX2",94,0) . S XUSSTATE=$P(DIC4,U,4) "RTN","XUSNPIX2",95,0) . I XUSSTATE S XUSSTATE=$P($G(^DIC(5,XUSSTATE,0)),U,2) "RTN","XUSNPIX2",96,0) . S XUSZIP=$P(DIC4,U,5) "RTN","XUSNPIX2",97,0) S XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_"TYPE 2"_U_XUSVER "RTN","XUSNPIX2",98,0) ; "RTN","XUSNPIX2",99,0) Q "RTN","XUSNPIX2",100,0) ; "RTN","XUSNPIX2",101,0) PROC2(XUSRTN,XUSPROD,DTTM2) ;Process all Institution records "RTN","XUSNPIX2",102,0) N XUSNPI,XUSNEW,XUSDT,XUSI,XUSIN,XUSTXY,XUSSPC,XUSTAX,XUPHM,XUSDIV "RTN","XUSNPIX2",103,0) N XUSFCT,XUSFCN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSSTA,XUSEOL "RTN","XUSNPIX2",104,0) N INIEN,DIC0,DIC1,PSIEN,NPIINS,RELINS,PSSTA,COUNT,TOTREC,MSGCNT,MAXSIZE,XUSBFN,I "RTN","XUSNPIX2",105,0) ; "RTN","XUSNPIX2",106,0) ; Set to 300000 for live "RTN","XUSNPIX2",107,0) S MAXSIZE=300000 "RTN","XUSNPIX2",108,0) ; "RTN","XUSNPIX2",109,0) ; Set end of line character "RTN","XUSNPIX2",110,0) S XUSEOL="~~" "RTN","XUSNPIX2",111,0) ; "RTN","XUSNPIX2",112,0) ; set counter "RTN","XUSNPIX2",113,0) S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0 "RTN","XUSNPIX2",114,0) ; Loop through INSTITUTION NPI records NPI xref "RTN","XUSNPIX2",115,0) S XUSNPI=0 "RTN","XUSNPIX2",116,0) F S XUSNPI=$O(^DIC(4,"ANPI",XUSNPI)) Q:'XUSNPI D "RTN","XUSNPIX2",117,0) . S INIEN=$O(^DIC(4,"ANPI",XUSNPI,"")) "RTN","XUSNPIX2",118,0) . ; "RTN","XUSNPIX2",119,0) . ; Get Station Number "RTN","XUSNPIX2",120,0) . S XUSSTA=$P($G(^DIC(4,INIEN,99)),U) "RTN","XUSNPIX2",121,0) . ; Parent of Association "RTN","XUSNPIX2",122,0) . I (INIEN'=INST)&('$$POA(INIEN,INST)) Q "RTN","XUSNPIX2",123,0) . ; Initialize columns "RTN","XUSNPIX2",124,0) . F XUSI=1:1:24 S XUSIN(XUSI)="" "RTN","XUSNPIX2",125,0) . ; "RTN","XUSNPIX2",126,0) . S XUSIN(1)=XUSNPI "RTN","XUSNPIX2",127,0) . S DIC0=$G(^DIC(4,INIEN,0)) Q:DIC0="" "RTN","XUSNPIX2",128,0) . ;Organization Name "RTN","XUSNPIX2",129,0) . S XUSIN(2)=$P($G(^DIC(4,INIEN,99)),U,2) "RTN","XUSNPIX2",130,0) . S XUSIN(3)=2 "RTN","XUSNPIX2",131,0) . S XUSDATA1=XUSIN(1)_U_XUSIN(2)_U_XUSIN(3) "RTN","XUSNPIX2",132,0) . ; "RTN","XUSNPIX2",133,0) . ; Pay to Provider Address "RTN","XUSNPIX2",134,0) . S XUSDIV="" "RTN","XUSNPIX2",135,0) . I $D(XUSTMP("P2P","DEFAULT")) S XUSDIV=XUSTMP("P2P","DEFAULT") "RTN","XUSNPIX2",136,0) . I $D(XUSTMP("P2P",INIEN))=1 S XUSDIV=XUSTMP("P2P",INIEN) "RTN","XUSNPIX2",137,0) . I XUSDIV="" F I=1:1:6 S $P(XUSDATA2,U,I)="" "RTN","XUSNPIX2",138,0) . I XUSDIV'="" S XUSDATA2=$$P2PEXP^XUSNPIXU(XUSDIV) "RTN","XUSNPIX2",139,0) . ; "RTN","XUSNPIX2",140,0) . ; Servicing Provider Address "RTN","XUSNPIX2",141,0) . S DIC1=$G(^DIC(4,INIEN,1)) "RTN","XUSNPIX2",142,0) . I DIC1'="" D "RTN","XUSNPIX2",143,0) . . S XUSIN(10)=$P(DIC1,U) "RTN","XUSNPIX2",144,0) . . S XUSIN(11)=$P(DIC1,U,2) "RTN","XUSNPIX2",145,0) . . S XUSIN(12)=$P(DIC1,U,3) "RTN","XUSNPIX2",146,0) . . S XUSIN(13)=$P($G(DIC0),U,2) "RTN","XUSNPIX2",147,0) . . I XUSIN(13) S XUSIN(13)=$P($G(^DIC(5,XUSIN(13),0)),U,2) "RTN","XUSNPIX2",148,0) . . S XUSIN(14)=$P(DIC1,U,4) "RTN","XUSNPIX2",149,0) . S XUSDATA3=XUSIN(10)_U_XUSIN(11)_U_XUSIN(12)_U_XUSIN(13)_U_XUSIN(14) "RTN","XUSNPIX2",150,0) . ; "RTN","XUSNPIX2",151,0) . ;Phone number (place holder) "RTN","XUSNPIX2",152,0) . S XUSIN(15)="" "RTN","XUSNPIX2",153,0) . ; "RTN","XUSNPIX2",154,0) . ; Get Taxonomy and Specialty "RTN","XUSNPIX2",155,0) . S XUSTXY=0 "RTN","XUSNPIX2",156,0) . F S XUSTXY=$O(^DIC(4,INIEN,"TAXONOMY","B",XUSTXY)) Q:'XUSTXY D "RTN","XUSNPIX2",157,0) . . S XUSSPC=$P($G(^USC(8932.1,XUSTXY,0)),U,9) "RTN","XUSNPIX2",158,0) . . S XUSTAX=$P($G(^USC(8932.1,XUSTXY,0)),U,7) "RTN","XUSNPIX2",159,0) . . I XUSSPC'="" D "RTN","XUSNPIX2",160,0) . . . I XUSIN(16)="" S XUSIN(16)=XUSSPC Q "RTN","XUSNPIX2",161,0) . . . S XUSIN(16)=XUSIN(16)_";"_XUSSPC "RTN","XUSNPIX2",162,0) . . I XUSTAX'="" D "RTN","XUSNPIX2",163,0) . . . I XUSIN(17)="" S XUSIN(17)=XUSTAX Q "RTN","XUSNPIX2",164,0) . . . ;S XUSIN(17)=XUSIN(17)_";"_XUSTAX "RTN","XUSNPIX2",165,0) . . . ; "RTN","XUSNPIX2",166,0) . . . ; *** Start ^XU*8.0*548 - RBN *** "RTN","XUSNPIX2",167,0) . . . ; "RTN","XUSNPIX2",168,0) . . . S:(XUSIN(17)'[XUSTAX) XUSIN(17)=XUSIN(17)_";"_XUSTAX "RTN","XUSNPIX2",169,0) . . . ; "RTN","XUSNPIX2",170,0) . . . ; *** End ^XU*8.0*548 - RBN *** "RTN","XUSNPIX2",171,0) . ; "RTN","XUSNPIX2",172,0) . ; Federal Tax ID "RTN","XUSNPIX2",173,0) . S XUSIN(18)=$G(XUSTAXID) "RTN","XUSNPIX2",174,0) . ; "RTN","XUSNPIX2",175,0) . ; Medicaid Part A/B "RTN","XUSNPIX2",176,0) . S XUSIN(19)=670899 "RTN","XUSNPIX2",177,0) . S XUSIN(20)="VA"_$E(SITE+10000,2,5) "RTN","XUSNPIX2",178,0) . ; "RTN","XUSNPIX2",179,0) . S XUSDATA4=XUSIN(15)_U_XUSIN(16)_U_XUSIN(17)_U_XUSIN(18)_U_XUSIN(19)_U_XUSIN(20) "RTN","XUSNPIX2",180,0) . ; "RTN","XUSNPIX2",181,0) . ; DEA Number "RTN","XUSNPIX2",182,0) . S XUSIN(21)=$P($G(^DIC(4,INIEN,"DEA")),U) "RTN","XUSNPIX2",183,0) . ; "RTN","XUSNPIX2",184,0) . ; get Facility Type and Name "RTN","XUSNPIX2",185,0) . S XUSFCT=$P($G(^DIC(4,INIEN,3)),U) "RTN","XUSNPIX2",186,0) . I XUSFCT'="" S XUSFCN=$P($G(^DIC(4.1,XUSFCT,0)),U) "RTN","XUSNPIX2",187,0) . I $G(XUSFCN)="PHARM" D "RTN","XUSNPIX2",188,0) . . I $D(^TMP("XUSNPIX",$J,INIEN)) D "RTN","XUSNPIX2",189,0) . . . S XUPHM=^TMP("XUSNPIX",$J,INIEN) "RTN","XUSNPIX2",190,0) . . . ; get NCPDP from ^TMP "RTN","XUSNPIX2",191,0) . . . S XUSIN(22)=$P($G(XUPHM),U) "RTN","XUSNPIX2",192,0) . . . ; get station number from^TMP "RTN","XUSNPIX2",193,0) . . . I $P($G(XUPHM),U,2) S XUSSTA=$P(XUPHM,U,2) "RTN","XUSNPIX2",194,0) . ; "RTN","XUSNPIX2",195,0) . ; VISN Station Number "RTN","XUSNPIX2",196,0) . S XUSIN(23)=XUSSTA "RTN","XUSNPIX2",197,0) . ; "RTN","XUSNPIX2",198,0) . S XUSDATA5=XUSIN(21)_U_XUSIN(22)_U_XUSIN(23) "RTN","XUSNPIX2",199,0) . ; "RTN","XUSNPIX2",200,0) . ; Get BCBS Payer ID Array "RTN","XUSNPIX2",201,0) . K XUSBXID "RTN","XUSNPIX2",202,0) . D INSTID^XUSNPIXU(.XUSBXID) "RTN","XUSNPIX2",203,0) . ; "RTN","XUSNPIX2",204,0) . ; Update counter and save Entry "RTN","XUSNPIX2",205,0) . ; "RTN","XUSNPIX2",206,0) . S COUNT=COUNT+1,TOTREC=TOTREC+1 "RTN","XUSNPIX2",207,0) . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSEOL "RTN","XUSNPIX2",208,0) . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) "RTN","XUSNPIX2",209,0) . I $D(XUSBXID) D "RTN","XUSNPIX2",210,0) . . S XUSB="" "RTN","XUSNPIX2",211,0) . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D "RTN","XUSNPIX2",212,0) . . . S COUNT=COUNT+1,TOTREC=TOTREC+1 "RTN","XUSNPIX2",213,0) . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_XUSDATA2_U_XUSDATA3_U_XUSDATA4_U_XUSDATA5_U_XUSB_U_XUSBXID(XUSB)_U_XUSEOL "RTN","XUSNPIX2",214,0) . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT)) "RTN","XUSNPIX2",215,0) . K XUSIN,XUSDATA1,XUSDATA2,XUSDATA3,XUSDATA4,XUSDATA5,XUSB,XUSBXID "RTN","XUSNPIX2",216,0) . I XUSIZE>MAXSIZE D "RTN","XUSNPIX2",217,0) . . D EOF(XUSRTN) "RTN","XUSNPIX2",218,0) . . D EMAIL(XUSRTN) ;sending extracted data via MailMan "RTN","XUSNPIX2",219,0) . . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX2",220,0) . . S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2) "RTN","XUSNPIX2",221,0) . . S ^TMP(XUSRTN,$J,1)=XUSHDR "RTN","XUSNPIX2",222,0) . . S COUNT=1,XUSIZE=0 "RTN","XUSNPIX2",223,0) ; "RTN","XUSNPIX2",224,0) D EOF(XUSRTN) "RTN","XUSNPIX2",225,0) ; "RTN","XUSNPIX2",226,0) ; Send the last message (if it has records) "RTN","XUSNPIX2",227,0) I $G(COUNT)>1 D "RTN","XUSNPIX2",228,0) .D EMAIL(XUSRTN) ;sending extracted data via MailMan "RTN","XUSNPIX2",229,0) .K ^TMP(XUSRTN,$J) "RTN","XUSNPIX2",230,0) .S ^TMP("XUSNPIXS",$J,2,MSGCNT)="2^"_(COUNT-2) "RTN","XUSNPIX2",231,0) ; "RTN","XUSNPIX2",232,0) ; Set Summary totals "RTN","XUSNPIX2",233,0) S ^XTMP("XUSNPIXT",2)=MSGCNT_U_TOTREC_U_DTTM2 "RTN","XUSNPIX2",234,0) ; "RTN","XUSNPIX2",235,0) K XUSPT,LDTCMP,SITE,XUSTAXID "RTN","XUSNPIX2",236,0) Q "RTN","XUSNPIX2",237,0) ; "RTN","XUSNPIX2",238,0) EOF(XUSRTN) ; "RTN","XUSNPIX2",239,0) Q:COUNT=1 "RTN","XUSNPIX2",240,0) S MSGCNT=MSGCNT+1 "RTN","XUSNPIX2",241,0) S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM2_U_$G(XUSPROD)_U_XUSEOL "RTN","XUSNPIX2",242,0) S COUNT=COUNT+1 "RTN","XUSNPIX2",243,0) S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX2",244,0) Q "RTN","XUSNPIX2",245,0) ; "RTN","XUSNPIX2",246,0) ; Email the message "RTN","XUSNPIX2",247,0) EMAIL(XUSRTN) ; "RTN","XUSNPIX2",248,0) N XMY "RTN","XUSNPIX2",249,0) ; Send email to designated recipients for live release "RTN","XUSNPIX2",250,0) D MAILTO^XUSNPIX1(.XMY) ;p548 "RTN","XUSNPIX2",251,0) D ESEND "RTN","XUSNPIX2",252,0) Q "RTN","XUSNPIX2",253,0) ; "RTN","XUSNPIX2",254,0) ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM "RTN","XUSNPIX2",255,0) ; "RTN","XUSNPIX2",256,0) S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," "RTN","XUSNPIX2",257,0) S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 2" "RTN","XUSNPIX2",258,0) D ^XMD "RTN","XUSNPIX2",259,0) Q "RTN","XUSNPIX2",260,0) POA(IEN,INST) ; Check Parent of Association for Institution IEN up to VISN level to see if INST is in the chain "RTN","XUSNPIX2",261,0) N XUSPOA "RTN","XUSNPIX2",262,0) I +$G(INST)=0 Q 0 ; No institution - return false "RTN","XUSNPIX2",263,0) POA1 ; "RTN","XUSNPIX2",264,0) I $G(IEN)="" Q 0 ; No IEN remaining to check - return false "RTN","XUSNPIX2",265,0) I $D(XUSPOA(IEN)) Q 0 ; Already reviewed this IEN - possible infinite loop - return false "RTN","XUSNPIX2",266,0) S XUSPOA(IEN)="" "RTN","XUSNPIX2",267,0) S XUSPOA=$P($G(^DIC(4,IEN,7,2,0)),U,2) ; Get parent of this institution "RTN","XUSNPIX2",268,0) I XUSPOA=INST Q 1 ; Found matching institution - return true "RTN","XUSNPIX2",269,0) I IEN=XUSPOA Q 0 ; Top level reached - return false "RTN","XUSNPIX2",270,0) S IEN=XUSPOA ; Reset IEN to check next level "RTN","XUSNPIX2",271,0) G POA1 "RTN","XUSNPIX2",272,0) ; "RTN","XUSNPIX2",273,0) GETPHARM ; "RTN","XUSNPIX2",274,0) ; this subroutine retrieves data from the OUTPATIENT SITE file "RTN","XUSNPIX2",275,0) ; using the supported Pharmacy API PSS^PSO59. "RTN","XUSNPIX2",276,0) ; It takes the results and places them into a temporary "RTN","XUSNPIX2",277,0) ; global array that is accessed when processing data "RTN","XUSNPIX2",278,0) ; associated with a pharmacy institution. "RTN","XUSNPIX2",279,0) N D,DIC,XUS59DA,XUSNPIDA,XUSRELDA,PSSTA,Y,X,XUNCP "RTN","XUSNPIX2",280,0) ; "RTN","XUSNPIX2",281,0) ;Fix for Remedy Ticket 217164 "RTN","XUSNPIX2",282,0) ;Quit if Outpatient Site API routine is not loaded "RTN","XUSNPIX2",283,0) S X="PSO59" X ^%ZOSF("TEST") Q:'$T "RTN","XUSNPIX2",284,0) ; "RTN","XUSNPIX2",285,0) K ^TMP($J,"XUS59"),^TMP("XUSNPIX",$J) ; remove any pre-existing nodes "RTN","XUSNPIX2",286,0) D PSS^PSO59(,"??","XUS59") ;IA#4827 "RTN","XUSNPIX2",287,0) S XUS59DA=0 "RTN","XUSNPIX2",288,0) ; gather data from each Outpatient site entry stored in the pharmacy "RTN","XUSNPIX2",289,0) ; ^TMP global and build 2nd ^TMP global for later processing "RTN","XUSNPIX2",290,0) F S XUS59DA=$O(^TMP($J,"XUS59",XUS59DA)) Q:'XUS59DA D "RTN","XUSNPIX2",291,0) . ; "RTN","XUSNPIX2",292,0) . ;Get Pharmacy NPI institution from API "RTN","XUSNPIX2",293,0) . S XUSNPIDA=$P($G(^TMP($J,"XUS59",XUS59DA,101)),U) "RTN","XUSNPIX2",294,0) . Q:XUSNPIDA']"" ; NPI institution does not exist "RTN","XUSNPIX2",295,0) . ; "RTN","XUSNPIX2",296,0) . ; Get Pharmacy Related Institution from API "RTN","XUSNPIX2",297,0) . S XUSRELDA=$P($G(^TMP($J,"XUS59",XUS59DA,100)),U) "RTN","XUSNPIX2",298,0) . ; get station number off the related institution "RTN","XUSNPIX2",299,0) . S PSSTA=$P($G(^DIC(4,XUSRELDA,99)),U) "RTN","XUSNPIX2",300,0) . ; "RTN","XUSNPIX2",301,0) . ; Get NCPDP number "RTN","XUSNPIX2",302,0) . S XUNCP="" ;prevent previous values being carried over "RTN","XUSNPIX2",303,0) . S X=XUSNPIDA S D="C",DIC=9002313.56,DIC(0)="" D IX^DIC "RTN","XUSNPIX2",304,0) . I +Y>0 S XUNCP=$$GET1^DIQ(9002313.56,+Y,.02) "RTN","XUSNPIX2",305,0) . S:$G(XUNCP)="" XUNCP=$P($G(^TMP($J,"XUS59",XUS59DA,1008)),U) "RTN","XUSNPIX2",306,0) . ; "RTN","XUSNPIX2",307,0) . ; rebuild the ^TMP global by NPI institution "RTN","XUSNPIX2",308,0) . ; collect necessary data used in the 'PHARM' logic "RTN","XUSNPIX2",309,0) . S ^TMP("XUSNPIX",$J,XUSNPIDA)=XUNCP_"^"_PSSTA ; ncpdp#^station "RTN","XUSNPIX2",310,0) Q "RTN","XUSNPIX3") 0^3^B23716384^B20621795 "RTN","XUSNPIX3",1,0) XUSNPIX3 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06 "RTN","XUSNPIX3",2,0) ;;8.0;KERNEL;**438,452,453,481,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIX3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUSNPIX3",4,0) ; "RTN","XUSNPIX3",5,0) ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by "RTN","XUSNPIX3",6,0) ; Integration Agreement #4964. "RTN","XUSNPIX3",7,0) ; "RTN","XUSNPIX3",8,0) ; NPI Extract Report "RTN","XUSNPIX3",9,0) ; "RTN","XUSNPIX3",10,0) ; Input parameter: N/A "RTN","XUSNPIX3",11,0) ; "RTN","XUSNPIX3",12,0) ; Other relevant variables: "RTN","XUSNPIX3",13,0) ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP "RTN","XUSNPIX3",14,0) ; XUSRTN="XUSNPIX2NV" storage subscript) "RTN","XUSNPIX3",15,0) ; Storage Global: "RTN","XUSNPIX3",16,0) ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 "RTN","XUSNPIX3",17,0) ; ^XTMP("XUSNPIX2VA",0) "RTN","XUSNPIX3",18,0) ; where: "RTN","XUSNPIX3",19,0) ; Piece 1 => Purge Date - 1 year in future "RTN","XUSNPIX3",20,0) ; Piece 2 => Create Date - Today "RTN","XUSNPIX3",21,0) ; Piece 3 => Description "RTN","XUSNPIX3",22,0) ; Piece 4 => Last Date Compiled "RTN","XUSNPIX3",23,0) ; Piece 5 => $H last run start time "RTN","XUSNPIX3",24,0) ; Piece 6 => $H last run completion time "RTN","XUSNPIX3",25,0) ; "RTN","XUSNPIX3",26,0) ; Entry Point - ENT called from XUSNPIX1 "RTN","XUSNPIX3",27,0) ; "RTN","XUSNPIX3",28,0) Q "RTN","XUSNPIX3",29,0) ; "RTN","XUSNPIX3",30,0) ENT(XUSPROD,XUSVER) ; ENTRY POINT "RTN","XUSNPIX3",31,0) ; init variables "RTN","XUSNPIX3",32,0) N XUSRTN,XUSEOL,DTTM3,XUSP2P,INST,SITE "RTN","XUSNPIX3",33,0) N XUSNPI,XUSDATA,XUSTYP,XUST "RTN","XUSNPIX3",34,0) N NVIEN,IBA0,PROTYPE,NPIDT,NPINEW,XUSHDR,NVTYPE "RTN","XUSNPIX3",35,0) K ^TMP("XUSNPI",$J) "RTN","XUSNPIX3",36,0) ; "RTN","XUSNPIX3",37,0) ; Set end of line character "RTN","XUSNPIX3",38,0) S XUSEOL="~~" "RTN","XUSNPIX3",39,0) ; "RTN","XUSNPIX3",40,0) S DTTM3=$$HTE^XLFDT($H,"2") "RTN","XUSNPIX3",41,0) ; "RTN","XUSNPIX3",42,0) S XUST="" "RTN","XUSNPIX3",43,0) ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref "RTN","XUSNPIX3",44,0) S XUSNPI=0 "RTN","XUSNPIX3",45,0) F S XUSNPI=$O(^IBA(355.93,"NPI",XUSNPI)) Q:'XUSNPI D "RTN","XUSNPIX3",46,0) . S NVIEN=$O(^IBA(355.93,"NPI",XUSNPI,"")) "RTN","XUSNPIX3",47,0) . S IBA0=$G(^IBA(355.93,NVIEN,0)) "RTN","XUSNPIX3",48,0) . ; Get Provider Type "RTN","XUSNPIX3",49,0) . S PROTYPE=$P(IBA0,U,2) "RTN","XUSNPIX3",50,0) . S XUSTYP=$S(PROTYPE=1:2,1:1) "RTN","XUSNPIX3",51,0) . ; setup NPI array "RTN","XUSNPIX3",52,0) . S ^TMP("XUSNPI",$J,XUSTYP,XUSNPI)=NVIEN "RTN","XUSNPIX3",53,0) ; "RTN","XUSNPIX3",54,0) I $D(^TMP("XUSNPI",$J)) D INITA ; set up global variables and P2P data "RTN","XUSNPIX3",55,0) ; "RTN","XUSNPIX3",56,0) ; If Provider Type is Individual "RTN","XUSNPIX3",57,0) S XUSRTN="XUSNPIX1NV",NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)",NVTYPE="TYPE 1 (NVA)" "RTN","XUSNPIX3",58,0) I $D(^TMP("XUSNPI",$J,1)) D I XUST G EXIT "RTN","XUSNPIX3",59,0) . ; Check to see if report is in use "RTN","XUSNPIX3",60,0) . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q "RTN","XUSNPIX3",61,0) . D INITB(XUSRTN) "RTN","XUSNPIX3",62,0) . D HDR(XUSRTN) "RTN","XUSNPIX3",63,0) . D TYPE1^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) "RTN","XUSNPIX3",64,0) . ; "RTN","XUSNPIX3",65,0) . ; Log Run Completion Time "RTN","XUSNPIX3",66,0) . S $P(^XTMP(XUSRTN,0),U,6)=$H "RTN","XUSNPIX3",67,0) . L -^XTMP(XUSRTN) "RTN","XUSNPIX3",68,0) ; "RTN","XUSNPIX3",69,0) I '$D(^TMP("XUSNPI",$J,1)) D "RTN","XUSNPIX3",70,0) . D INITB(XUSRTN) "RTN","XUSNPIX3",71,0) . D HDR(XUSRTN) "RTN","XUSNPIX3",72,0) . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL "RTN","XUSNPIX3",73,0) . S ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3 "RTN","XUSNPIX3",74,0) . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX3",75,0) . D EMAIL(XUSRTN) "RTN","XUSNPIX3",76,0) . S ^TMP("XUSNPIXS",$J,3,1)="1 (Non-VA)^0" "RTN","XUSNPIX3",77,0) ; "RTN","XUSNPIX3",78,0) ; If Provider Type is Facility/Group "RTN","XUSNPIX3",79,0) S XUSRTN="XUSNPIX2NV",NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)",NVTYPE="TYPE 2 (NVA)" "RTN","XUSNPIX3",80,0) I $D(^TMP("XUSNPI",$J,2)) D I XUST G EXIT "RTN","XUSNPIX3",81,0) . ; Check to see if report is in use "RTN","XUSNPIX3",82,0) . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q "RTN","XUSNPIX3",83,0) . D INITB(XUSRTN) "RTN","XUSNPIX3",84,0) . D HDR(XUSRTN) "RTN","XUSNPIX3",85,0) . D TYPE2^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) "RTN","XUSNPIX3",86,0) . ; "RTN","XUSNPIX3",87,0) . ; Log Run Completion Time "RTN","XUSNPIX3",88,0) . S $P(^XTMP(XUSRTN,0),U,6)=$H "RTN","XUSNPIX3",89,0) . L -^XTMP(XUSRTN) "RTN","XUSNPIX3",90,0) . ; "RTN","XUSNPIX3",91,0) I '$D(^TMP("XUSNPI",$J,2)) D "RTN","XUSNPIX3",92,0) . D INITB(XUSRTN) "RTN","XUSNPIX3",93,0) . D HDR(XUSRTN) "RTN","XUSNPIX3",94,0) . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL "RTN","XUSNPIX3",95,0) . S ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3 "RTN","XUSNPIX3",96,0) . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX3",97,0) . D EMAIL(XUSRTN) "RTN","XUSNPIX3",98,0) . S ^TMP("XUSNPIXS",$J,4,1)="2 (Non-VA)^0" "RTN","XUSNPIX3",99,0) ; "RTN","XUSNPIX3",100,0) EXIT ;Standard EXIT point "RTN","XUSNPIX3",101,0) K ^TMP("XUSNPI",$J) "RTN","XUSNPIX3",102,0) K XUSNV,P,LDTCMP,SITE,NVHEADR,XUSEOL,DTTM3 "RTN","XUSNPIX3",103,0) ; "RTN","XUSNPIX3",104,0) Q "RTN","XUSNPIX3",105,0) ;============================================= "RTN","XUSNPIX3",106,0) INITA ; set up global variables (site and inst info) "RTN","XUSNPIX3",107,0) N SINFO,XUSTMP,XUSP2PA,I "RTN","XUSNPIX3",108,0) K XUSTMP "RTN","XUSNPIX3",109,0) ; "RTN","XUSNPIX3",110,0) ; Pull site info "RTN","XUSNPIX3",111,0) S SINFO=$$SITE^VASITE "RTN","XUSNPIX3",112,0) ; Station Number "RTN","XUSNPIX3",113,0) S SITE=$P(SINFO,U,3) "RTN","XUSNPIX3",114,0) ; Institution "RTN","XUSNPIX3",115,0) S INST=$P(SINFO,U) "RTN","XUSNPIX3",116,0) ; "RTN","XUSNPIX3",117,0) ; Get Pay-to-Provider for all Non-VA records (type 1 & 2) "RTN","XUSNPIX3",118,0) ; "RTN","XUSNPIX3",119,0) F I=1:1:6 S $P(XUSP2P,U,I)="" ; initialize "RTN","XUSNPIX3",120,0) D P2PBASE^XUSNPIXU(.XUSTMP) "RTN","XUSNPIX3",121,0) I $D(XUSTMP("P2P",INST)) S XUSP2P=$$P2PEXP^XUSNPIXU((XUSTMP("P2P",INST)),.XUSP2PA) "RTN","XUSNPIX3",122,0) Q "RTN","XUSNPIX3",123,0) ; "RTN","XUSNPIX3",124,0) INITB(XUSRTN) ; check/init variables "RTN","XUSNPIX3",125,0) N XUSDESC "RTN","XUSNPIX3",126,0) ; "RTN","XUSNPIX3",127,0) ;Reset Temporary Scratch Global "RTN","XUSNPIX3",128,0) K ^TMP(XUSRTN) "RTN","XUSNPIX3",129,0) S XUSDESC="NPI EXTRACT NON VA - Do Not Delete" "RTN","XUSNPIX3",130,0) S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H "RTN","XUSNPIX3",131,0) ; "RTN","XUSNPIX3",132,0) I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU "RTN","XUSNPIX3",133,0) Q "RTN","XUSNPIX3",134,0) ; "RTN","XUSNPIX3",135,0) HDR(XUSRTN) ;Get header "RTN","XUSNPIX3",136,0) N DIC4,XUSCITY,XUSSTATE,XUSZIP "RTN","XUSNPIX3",137,0) S (DIC4,XUSCITY,XUSSTATE,XUSZIP)="" "RTN","XUSNPIX3",138,0) ; "RTN","XUSNPIX3",139,0) ; *** Start XU*8.0*548 - RBN *** "RTN","XUSNPIX3",140,0) ; Get header for extracted data NOT email "RTN","XUSNPIX3",141,0) I INST D "RTN","XUSNPIX3",142,0) . S DIC4=$G(^DIC(4,INST,4)) "RTN","XUSNPIX3",143,0) . S XUSCITY=$P(DIC4,U,3) "RTN","XUSNPIX3",144,0) . S XUSSTATE=$P(DIC4,U,4) "RTN","XUSNPIX3",145,0) . I XUSSTATE S XUSSTATE=$P($G(^DIC(5,XUSSTATE,0)),U,2) "RTN","XUSNPIX3",146,0) . S XUSZIP=$P(DIC4,U,5) "RTN","XUSNPIX3",147,0) S XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_NVTYPE_U_XUSVER "RTN","XUSNPIX3",148,0) Q "RTN","XUSNPIX3",149,0) ; "RTN","XUSNPIX3",150,0) EMAIL(XUSRTN) ; EMAIL THE MESSAGE "RTN","XUSNPIX3",151,0) N XMY "RTN","XUSNPIX3",152,0) ; Send email to designated recipient for live release (send the extracted data via MailMan) "RTN","XUSNPIX3",153,0) D MAILTO^XUSNPIX1(.XMY) ;p548 "RTN","XUSNPIX3",154,0) D ESEND "RTN","XUSNPIX3",155,0) Q "RTN","XUSNPIX3",156,0) ; "RTN","XUSNPIX3",157,0) ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM "RTN","XUSNPIX3",158,0) S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," "RTN","XUSNPIX3",159,0) S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") "_NVHEADR "RTN","XUSNPIX3",160,0) D ^XMD "RTN","XUSNPIX3",161,0) Q "RTN","XUSNPIX4") 0^4^B99303079^B75484055 "RTN","XUSNPIX4",1,0) XUSNPIX4 ;OAK_BP/CMW/SLT - NPI EXTRACT REPORT ;7/7/08 17:39 "RTN","XUSNPIX4",2,0) ;;8.0;KERNEL;**438,452,453,481,528,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIX4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUSNPIX4",4,0) ; "RTN","XUSNPIX4",5,0) ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by "RTN","XUSNPIX4",6,0) ; Integration Agreement #4964. "RTN","XUSNPIX4",7,0) ; "RTN","XUSNPIX4",8,0) ; NPI Extract Report "RTN","XUSNPIX4",9,0) ; "RTN","XUSNPIX4",10,0) ; Input parameter: N/A "RTN","XUSNPIX4",11,0) ; "RTN","XUSNPIX4",12,0) ; Other relevant variables: "RTN","XUSNPIX4",13,0) ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP "RTN","XUSNPIX4",14,0) ; XUSRTN="XUSNPIX2NV" storage subscript) "RTN","XUSNPIX4",15,0) ; Storage Global: "RTN","XUSNPIX4",16,0) ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 "RTN","XUSNPIX4",17,0) ; ^XTMP("XUSNPIX2VA",0) "RTN","XUSNPIX4",18,0) ; where: "RTN","XUSNPIX4",19,0) ; Piece 1 => Purge Date - 1 year in future "RTN","XUSNPIX4",20,0) ; Piece 2 => Create Date - Today "RTN","XUSNPIX4",21,0) ; Piece 3 => Description "RTN","XUSNPIX4",22,0) ; Piece 4 => Last Date Compiled "RTN","XUSNPIX4",23,0) ; Piece 5 => $H last run start time "RTN","XUSNPIX4",24,0) ; Piece 6 => $H last run completion time "RTN","XUSNPIX4",25,0) ; "RTN","XUSNPIX4",26,0) ; Entry Point - ENT called from XUSNPIX1 "RTN","XUSNPIX4",27,0) ; "RTN","XUSNPIX4",28,0) Q "RTN","XUSNPIX4",29,0) ; "RTN","XUSNPIX4",30,0) ; Individual records "RTN","XUSNPIX4",31,0) TYPE1(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ; "RTN","XUSNPIX4",32,0) N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT "RTN","XUSNPIX4",33,0) N XUSI,XUSNM,XUSNV,XLFNC,XUSIZE,XUSDT,XUSNEW "RTN","XUSNPIX4",34,0) N TOTREC1 "RTN","XUSNPIX4",35,0) ; "RTN","XUSNPIX4",36,0) ; Set Maximum Message Size "RTN","XUSNPIX4",37,0) S MAXSIZE=300000 "RTN","XUSNPIX4",38,0) ; "RTN","XUSNPIX4",39,0) ; Set end of line character "RTN","XUSNPIX4",40,0) S XUSEOL="~~" "RTN","XUSNPIX4",41,0) ; "RTN","XUSNPIX4",42,0) S XUSCNT=1,(TOTREC1,MSGCNT,XUSIZE)=0 "RTN","XUSNPIX4",43,0) S XUSNPI="" "RTN","XUSNPIX4",44,0) F S XUSNPI=$O(^TMP("XUSNPI",$J,1,XUSNPI)) Q:'XUSNPI D "RTN","XUSNPIX4",45,0) . S XUSDATA=XUSNPI "RTN","XUSNPIX4",46,0) . S NVIEN=$G(^TMP("XUSNPI",$J,1,XUSNPI)) "RTN","XUSNPIX4",47,0) . ; "RTN","XUSNPIX4",48,0) . F XUSI=1:1:33 S XUSNV(XUSI)="" "RTN","XUSNPIX4",49,0) . S IBA0=$G(^IBA(355.93,NVIEN,0)) "RTN","XUSNPIX4",50,0) . S XUSNM=$P(IBA0,U) "RTN","XUSNPIX4",51,0) . ; Break Name into components "RTN","XUSNPIX4",52,0) . I XUSNM'="" D "RTN","XUSNPIX4",53,0) . . S XLFNC=XUSNM D FORMAT^XLFNAME7(.XLFNC,,,,0) "RTN","XUSNPIX4",54,0) . . S XUSNV(2)=XLFNC("GIVEN"),XUSNV(3)=XLFNC("MIDDLE"),XUSNV(4)=XLFNC("FAMILY") "RTN","XUSNPIX4",55,0) . . I XLFNC("SUFFIX")'="" S XUSNV(4)=XUSNV(4)_" "_XLFNC("SUFFIX") "RTN","XUSNPIX4",56,0) . . K XLFNC "RTN","XUSNPIX4",57,0) . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3)_U_XUSNV(4) "RTN","XUSNPIX4",58,0) . S XUSNV(5)=1 ;TYPE "RTN","XUSNPIX4",59,0) . ; "RTN","XUSNPIX4",60,0) . ; DOB (place holder) "RTN","XUSNPIX4",61,0) . S XUSNV(6)="" "RTN","XUSNPIX4",62,0) . S XUSDATA=XUSDATA_U_XUSNV(5)_U_XUSNV(6) "RTN","XUSNPIX4",63,0) . ; "RTN","XUSNPIX4",64,0) . ; Pay to Provider Address (7-12) "RTN","XUSNPIX4",65,0) . S XUSDATA=XUSDATA_U_XUSP2P "RTN","XUSNPIX4",66,0) . ; "RTN","XUSNPIX4",67,0) . ; Servicing Provider Address "RTN","XUSNPIX4",68,0) . S XUSNV(13)=$P(IBA0,U,5) "RTN","XUSNPIX4",69,0) . S XUSNV(14)=$P(IBA0,U,10) "RTN","XUSNPIX4",70,0) . S XUSNV(15)=$P(IBA0,U,6) "RTN","XUSNPIX4",71,0) . S XUSNV(16)=$P(IBA0,U,7) "RTN","XUSNPIX4",72,0) . I XUSNV(16) S XUSNV(16)=$P($G(^DIC(5,XUSNV(16),0)),U,2) "RTN","XUSNPIX4",73,0) . S XUSNV(17)=$P(IBA0,U,8) "RTN","XUSNPIX4",74,0) . S XUSDATA=XUSDATA_U_XUSNV(13)_U_XUSNV(14)_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17) "RTN","XUSNPIX4",75,0) . ; "RTN","XUSNPIX4",76,0) . ; Office Phone number (place holder) "RTN","XUSNPIX4",77,0) . S XUSNV(18)="" "RTN","XUSNPIX4",78,0) . ; "RTN","XUSNPIX4",79,0) . ; Degree Description / Degree Code (place holder) "RTN","XUSNPIX4",80,0) . S XUSNV(19)="" "RTN","XUSNPIX4",81,0) . S XUSNV(20)="" "RTN","XUSNPIX4",82,0) . ; "RTN","XUSNPIX4",83,0) . ; Get Taxonomy and specialty codes "RTN","XUSNPIX4",84,0) . N NVTX,NVSPC,NVTAX "RTN","XUSNPIX4",85,0) . S NVTX=0 "RTN","XUSNPIX4",86,0) . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D "RTN","XUSNPIX4",87,0) . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9) "RTN","XUSNPIX4",88,0) . . ;S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7) "RTN","XUSNPIX4",89,0) . . I NVSPC'="" D "RTN","XUSNPIX4",90,0) . . . I XUSNV(21)="" S XUSNV(21)=NVSPC Q "RTN","XUSNPIX4",91,0) . . . S XUSNV(21)=XUSNV(21)_";"_NVSPC "RTN","XUSNPIX4",92,0) . . . Q "RTN","XUSNPIX4",93,0) . . Q "RTN","XUSNPIX4",94,0) . ;use "B" cross ref to find primary vs non-primary code 0 (no)!1 (yes), and only "A"'s "RTN","XUSNPIX4",95,0) . S NVTX=0 "RTN","XUSNPIX4",96,0) . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY",NVTX)) Q:NVTX'?1N.N D "RTN","XUSNPIX4",97,0) . . S IBA=$G(^IBA(355.93,NVIEN,"TAXONOMY",NVTX,0)) "RTN","XUSNPIX4",98,0) . . I $P(IBA,U,3)="A" D "RTN","XUSNPIX4",99,0) . . . I $P(IBA,U,2)=1 S XUSNV(22)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7) "RTN","XUSNPIX4",100,0) . . . I $P(IBA,U,2)=0 D "RTN","XUSNPIX4",101,0) . . . . I XUSNV(23)="" S XUSNV(23)=$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7) Q "RTN","XUSNPIX4",102,0) . . . . ; "RTN","XUSNPIX4",103,0) . . . . ; *** Start XU*8.0*548 - RBN *** "RTN","XUSNPIX4",104,0) . . . . ; "RTN","XUSNPIX4",105,0) . . . . I (XUSNV(23)'[$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7))&($P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7)'=XUSNV(22)) D "RTN","XUSNPIX4",106,0) . . . . . S XUSNV(23)=XUSNV(23)_";"_$P($G(^USC(8932.1,$P(IBA,U,1),0)),U,7) "RTN","XUSNPIX4",107,0) . . . . . ; "RTN","XUSNPIX4",108,0) . . . . . ; *** End XU*8.0*548 - RBN *** "RTN","XUSNPIX4",109,0) . . . . . ; "RTN","XUSNPIX4",110,0) . . . . Q "RTN","XUSNPIX4",111,0) . . . Q "RTN","XUSNPIX4",112,0) . . Q "RTN","XUSNPIX4",113,0) . K IBA "RTN","XUSNPIX4",114,0) . ; "RTN","XUSNPIX4",115,0) . ; Fed tax ID "RTN","XUSNPIX4",116,0) . S XUSNV(24)=$P($G(IBA0),U,9) "RTN","XUSNPIX4",117,0) . ; "RTN","XUSNPIX4",118,0) . S XUSDATA=XUSDATA_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20)_U_XUSNV(21)_U_XUSNV(22) "RTN","XUSNPIX4",119,0) . S XUSDATA=XUSDATA_U_XUSNV(23)_U_XUSNV(24) "RTN","XUSNPIX4",120,0) . ; "RTN","XUSNPIX4",121,0) . ; Medicare Part A/B "RTN","XUSNPIX4",122,0) . S XUSNV(25)=670899 "RTN","XUSNPIX4",123,0) . S XUSNV(26)="VA"_$E(SITE+10000,2,5) "RTN","XUSNPIX4",124,0) . ; "RTN","XUSNPIX4",125,0) . ; State Lic and DEA (place holder) "RTN","XUSNPIX4",126,0) . S XUSNV(27)="" "RTN","XUSNPIX4",127,0) . S XUSNV(28)="" "RTN","XUSNPIX4",128,0) . ; "RTN","XUSNPIX4",129,0) . ; Status and Creation/Termination Date (place holder) "RTN","XUSNPIX4",130,0) . S XUSNV(29)="" "RTN","XUSNPIX4",131,0) . S XUSNV(30)="" "RTN","XUSNPIX4",132,0) . ; VISN Station "RTN","XUSNPIX4",133,0) . S XUSNV(31)=SITE "RTN","XUSNPIX4",134,0) . ; "RTN","XUSNPIX4",135,0) . S XUSDATA=XUSDATA_U_XUSNV(25)_U_XUSNV(26)_U_XUSNV(27) "RTN","XUSNPIX4",136,0) . S XUSDATA=XUSDATA_U_XUSNV(28)_U_XUSNV(29)_U_XUSNV(30)_U_XUSNV(31) "RTN","XUSNPIX4",137,0) . ; "RTN","XUSNPIX4",138,0) . ;BCBS info "RTN","XUSNPIX4",139,0) . K XUSBXID "RTN","XUSNPIX4",140,0) . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID) "RTN","XUSNPIX4",141,0) . ; "RTN","XUSNPIX4",142,0) . ;Update counter and save Entry "RTN","XUSNPIX4",143,0) . N XUSB,XUSB1 "RTN","XUSNPIX4",144,0) . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1 "RTN","XUSNPIX4",145,0) . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL "RTN","XUSNPIX4",146,0) . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT)) "RTN","XUSNPIX4",147,0) . I $D(XUSBXID) D "RTN","XUSNPIX4",148,0) . . S XUSB="" "RTN","XUSNPIX4",149,0) . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D "RTN","XUSNPIX4",150,0) . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528 "RTN","XUSNPIX4",151,0) . . . S XUSCNT=XUSCNT+1,TOTREC1=TOTREC1+1 "RTN","XUSNPIX4",152,0) . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528 "RTN","XUSNPIX4",153,0) . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT)) "RTN","XUSNPIX4",154,0) . I XUSIZE>MAXSIZE D "RTN","XUSNPIX4",155,0) . . D EOF1(XUSRTN) "RTN","XUSNPIX4",156,0) . . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan "RTN","XUSNPIX4",157,0) . . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX4",158,0) . . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_(XUSCNT-2) "RTN","XUSNPIX4",159,0) . . S ^TMP(XUSRTN,$J,1)=XUSHDR "RTN","XUSNPIX4",160,0) . . S XUSCNT=1,XUSIZE=0 "RTN","XUSNPIX4",161,0) . K XUSNV,XUSDATA,XUSBXID "RTN","XUSNPIX4",162,0) ; "RTN","XUSNPIX4",163,0) D EOF1(XUSRTN) "RTN","XUSNPIX4",164,0) ; "RTN","XUSNPIX4",165,0) ; Send last message (if it has records) "RTN","XUSNPIX4",166,0) I $G(XUSCNT)>1 D "RTN","XUSNPIX4",167,0) . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan "RTN","XUSNPIX4",168,0) . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX4",169,0) . S ^TMP("XUSNPIXS",$J,3,MSGCNT)="1 (Non-VA)^"_($G(XUSCNT)-2) "RTN","XUSNPIX4",170,0) ; "RTN","XUSNPIX4",171,0) ; Update Summary "RTN","XUSNPIX4",172,0) S ^XTMP("XUSNPIXT","1NV")=MSGCNT_U_TOTREC1_U_DTTM3 "RTN","XUSNPIX4",173,0) Q "RTN","XUSNPIX4",174,0) ; "RTN","XUSNPIX4",175,0) EOF1(XUSRTN) ; "RTN","XUSNPIX4",176,0) Q:$G(XUSCNT)=1 "RTN","XUSNPIX4",177,0) S MSGCNT=MSGCNT+1 "RTN","XUSNPIX4",178,0) S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL "RTN","XUSNPIX4",179,0) S XUSCNT=XUSCNT+1 "RTN","XUSNPIX4",180,0) S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX4",181,0) Q "RTN","XUSNPIX4",182,0) ; "RTN","XUSNPIX4",183,0) TYPE2(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P) ;Facility/Group "RTN","XUSNPIX4",184,0) N IBA0,NVIEN,XUSNPI,MAXSIZE,XUSEOL,XUSCNT "RTN","XUSNPIX4",185,0) N XUSNV,XUSI,XUSNM,XLFNC,MSGCNT,XUSIZE,XUSDT,XUSNEW,TOTREC2 "RTN","XUSNPIX4",186,0) ; "RTN","XUSNPIX4",187,0) ; Set Maximum Message Size "RTN","XUSNPIX4",188,0) S MAXSIZE=300000 "RTN","XUSNPIX4",189,0) ; "RTN","XUSNPIX4",190,0) ; Set end of line character "RTN","XUSNPIX4",191,0) S XUSEOL="~~" "RTN","XUSNPIX4",192,0) ; "RTN","XUSNPIX4",193,0) S XUSNPI="" "RTN","XUSNPIX4",194,0) S XUSCNT=1,(TOTREC2,MSGCNT,XUSIZE)=0 "RTN","XUSNPIX4",195,0) F S XUSNPI=$O(^TMP("XUSNPI",$J,2,XUSNPI)) Q:'XUSNPI D "RTN","XUSNPIX4",196,0) . S XUSDATA=XUSNPI "RTN","XUSNPIX4",197,0) . S NVIEN=$G(^TMP("XUSNPI",$J,2,XUSNPI)) "RTN","XUSNPIX4",198,0) . ; "RTN","XUSNPIX4",199,0) . F XUSI=1:1:24 S XUSNV(XUSI)="" "RTN","XUSNPIX4",200,0) . S IBA0=$G(^IBA(355.93,NVIEN,0)) "RTN","XUSNPIX4",201,0) . ;Get Organization name "RTN","XUSNPIX4",202,0) . S XUSNV(2)=$P(IBA0,U) "RTN","XUSNPIX4",203,0) . ;Type "RTN","XUSNPIX4",204,0) . S XUSNV(3)=2 "RTN","XUSNPIX4",205,0) . ; "RTN","XUSNPIX4",206,0) . S XUSDATA=XUSDATA_U_XUSNV(2)_U_XUSNV(3) "RTN","XUSNPIX4",207,0) . ; "RTN","XUSNPIX4",208,0) . ; Pay to Provider Address (4-9) "RTN","XUSNPIX4",209,0) . S XUSDATA=XUSDATA_U_XUSP2P "RTN","XUSNPIX4",210,0) . ; "RTN","XUSNPIX4",211,0) . ; Servicing Provider Address "RTN","XUSNPIX4",212,0) . S XUSNV(10)=$P(IBA0,U,5) "RTN","XUSNPIX4",213,0) . S XUSNV(11)=$P(IBA0,U,10) "RTN","XUSNPIX4",214,0) . S XUSNV(12)=$P(IBA0,U,6) "RTN","XUSNPIX4",215,0) . S XUSNV(13)=$P(IBA0,U,7) "RTN","XUSNPIX4",216,0) . I XUSNV(13) S XUSNV(13)=$P($G(^DIC(5,XUSNV(13),0)),U,2) ;SLT 9/23/10 "RTN","XUSNPIX4",217,0) . S XUSNV(14)=$P(IBA0,U,8) "RTN","XUSNPIX4",218,0) . S XUSDATA=XUSDATA_U_XUSNV(10)_U_XUSNV(11)_U_XUSNV(12)_U_XUSNV(13)_U_XUSNV(14) "RTN","XUSNPIX4",219,0) . ; "RTN","XUSNPIX4",220,0) . ;Office Phone number (place holder) "RTN","XUSNPIX4",221,0) . S XUSNV(15)="" "RTN","XUSNPIX4",222,0) . ; "RTN","XUSNPIX4",223,0) . ; get Taxonomy and Specialty "RTN","XUSNPIX4",224,0) . N NVTX,NVSPC,NVTAX "RTN","XUSNPIX4",225,0) . S NVTX=0 "RTN","XUSNPIX4",226,0) . F S NVTX=$O(^IBA(355.93,NVIEN,"TAXONOMY","B",NVTX)) Q:'NVTX D "RTN","XUSNPIX4",227,0) . . S NVSPC=$P($G(^USC(8932.1,NVTX,0)),U,9) "RTN","XUSNPIX4",228,0) . . S NVTAX=$P($G(^USC(8932.1,NVTX,0)),U,7) "RTN","XUSNPIX4",229,0) . . I NVSPC'="" D "RTN","XUSNPIX4",230,0) . . . I XUSNV(16)="" S XUSNV(16)=NVSPC Q "RTN","XUSNPIX4",231,0) . . . S XUSNV(16)=XUSNV(16)_";"_NVSPC "RTN","XUSNPIX4",232,0) . . I NVTAX'="" D "RTN","XUSNPIX4",233,0) . . . I XUSNV(17)="" S XUSNV(17)=NVTAX Q "RTN","XUSNPIX4",234,0) . . . ; "RTN","XUSNPIX4",235,0) . . . ; *** Start XU*8.0*548 - RBN *** "RTN","XUSNPIX4",236,0) . . . ; "RTN","XUSNPIX4",237,0) . . . ;S XUSNV(17)=XUSNV(17)_";"_NVTAX "RTN","XUSNPIX4",238,0) . . . S:(XUSNV(17)'[NVTAX) XUSNV(17)=XUSNV(17)_";"_NVTAX "RTN","XUSNPIX4",239,0) . . . ; "RTN","XUSNPIX4",240,0) . . . ; *** End XU*8.0*548 - RBN *** "RTN","XUSNPIX4",241,0) . ; "RTN","XUSNPIX4",242,0) . ; Fed Tax ID "RTN","XUSNPIX4",243,0) . S XUSNV(18)=$P($G(IBA0),U,9) "RTN","XUSNPIX4",244,0) . ; "RTN","XUSNPIX4",245,0) . ;Medicare A/B "RTN","XUSNPIX4",246,0) . S XUSNV(19)=670899 "RTN","XUSNPIX4",247,0) . S XUSNV(20)="VA"_$E(SITE+10000,2,5) "RTN","XUSNPIX4",248,0) . ; "RTN","XUSNPIX4",249,0) . S XUSDATA=XUSDATA_U_XUSNV(15)_U_XUSNV(16)_U_XUSNV(17)_U_XUSNV(18)_U_XUSNV(19)_U_XUSNV(20) "RTN","XUSNPIX4",250,0) . ; "RTN","XUSNPIX4",251,0) . ;State License Number "RTN","XUSNPIX4",252,0) . ;S XUSNV(20)=$P($G(IBA0),U,12) "RTN","XUSNPIX4",253,0) . ; "RTN","XUSNPIX4",254,0) . ;DEA Number (place holder) "RTN","XUSNPIX4",255,0) . S XUSNV(21)="" "RTN","XUSNPIX4",256,0) . ; "RTN","XUSNPIX4",257,0) . ;NCPDP # "RTN","XUSNPIX4",258,0) . S XUSNV(22)="" "RTN","XUSNPIX4",259,0) . ; "RTN","XUSNPIX4",260,0) . ;VISN STATION ID "RTN","XUSNPIX4",261,0) . S XUSNV(23)=SITE "RTN","XUSNPIX4",262,0) . ; "RTN","XUSNPIX4",263,0) . S XUSDATA=XUSDATA_U_XUSNV(21)_U_XUSNV(22)_U_XUSNV(23) "RTN","XUSNPIX4",264,0) . ; "RTN","XUSNPIX4",265,0) . ;BCBS info "RTN","XUSNPIX4",266,0) . K XUSBXID "RTN","XUSNPIX4",267,0) . D NNVAID^XUSNPIXU(NVIEN,.XUSBXID) "RTN","XUSNPIX4",268,0) . ; "RTN","XUSNPIX4",269,0) . ;Update counter and save Entry "RTN","XUSNPIX4",270,0) . N XUSB,XUSB1 "RTN","XUSNPIX4",271,0) . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1 "RTN","XUSNPIX4",272,0) . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_XUSEOL "RTN","XUSNPIX4",273,0) . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT)) "RTN","XUSNPIX4",274,0) . I $D(XUSBXID) D "RTN","XUSNPIX4",275,0) . . S XUSB="" "RTN","XUSNPIX4",276,0) . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D "RTN","XUSNPIX4",277,0) . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p 528 "RTN","XUSNPIX4",278,0) . . . S XUSCNT=XUSCNT+1,TOTREC2=TOTREC2+1 "RTN","XUSNPIX4",279,0) . . . S ^TMP(XUSRTN,$J,XUSCNT)=XUSDATA_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528 "RTN","XUSNPIX4",280,0) . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,XUSCNT)) "RTN","XUSNPIX4",281,0) . I XUSIZE>MAXSIZE D "RTN","XUSNPIX4",282,0) . . D EOF2(XUSRTN) "RTN","XUSNPIX4",283,0) . . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan "RTN","XUSNPIX4",284,0) . . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX4",285,0) . . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_(XUSCNT-2) "RTN","XUSNPIX4",286,0) . . S ^TMP(XUSRTN,$J,1)=XUSHDR "RTN","XUSNPIX4",287,0) . . S XUSCNT=1,XUSIZE=0 "RTN","XUSNPIX4",288,0) . K XUSNV,XUSDATA,XUSB,XUSBXID "RTN","XUSNPIX4",289,0) ; "RTN","XUSNPIX4",290,0) D EOF2(XUSRTN) "RTN","XUSNPIX4",291,0) ; "RTN","XUSNPIX4",292,0) ; Send last message (if it has records) "RTN","XUSNPIX4",293,0) I $G(XUSCNT)>1 D "RTN","XUSNPIX4",294,0) . D EMAIL^XUSNPIX3(XUSRTN) ;sending the extracted data via MailMan "RTN","XUSNPIX4",295,0) . K ^TMP(XUSRTN,$J) "RTN","XUSNPIX4",296,0) . S ^TMP("XUSNPIXS",$J,4,MSGCNT)="2 (Non-VA)^"_($G(XUSCNT)-2) "RTN","XUSNPIX4",297,0) ; "RTN","XUSNPIX4",298,0) ; Update Summary "RTN","XUSNPIX4",299,0) S ^XTMP("XUSNPIXT","2NV")=MSGCNT_U_TOTREC2_U_DTTM3 "RTN","XUSNPIX4",300,0) Q "RTN","XUSNPIX4",301,0) ; "RTN","XUSNPIX4",302,0) EOF2(XUSRTN) ; "RTN","XUSNPIX4",303,0) Q:$G(XUSCNT)=1 "RTN","XUSNPIX4",304,0) S MSGCNT=MSGCNT+1 "RTN","XUSNPIX4",305,0) S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_XUSCNT_U_DTTM3_U_$G(XUSPROD)_U_XUSEOL "RTN","XUSNPIX4",306,0) S XUSCNT=XUSCNT+1 "RTN","XUSNPIX4",307,0) S ^TMP(XUSRTN,$J,XUSCNT)="END OF FILE"_U_XUSEOL "RTN","XUSNPIX4",308,0) Q "RTN","XUSNPIX5") 0^5^B15963770^B15950901 "RTN","XUSNPIX5",1,0) XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:45 "RTN","XUSNPIX5",2,0) ;;8.0;KERNEL;**453,481,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIX5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUSNPIX5",4,0) ; "RTN","XUSNPIX5",5,0) ; NPI Extract Report Mailer routine "RTN","XUSNPIX5",6,0) ; "RTN","XUSNPIX5",7,0) ; Input parameter: XUSRTN "RTN","XUSNPIX5",8,0) ; "RTN","XUSNPIX5",9,0) ; Other relevant variables: "RTN","XUSNPIX5",10,0) ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP "RTN","XUSNPIX5",11,0) ; storage subscript) "RTN","XUSNPIX5",12,0) ; Storage Global: "RTN","XUSNPIX5",13,0) ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 "RTN","XUSNPIX5",14,0) ; where: "RTN","XUSNPIX5",15,0) ; Piece 1 => Purge Date - 1 year in future "RTN","XUSNPIX5",16,0) ; Piece 2 => Create Date - Today "RTN","XUSNPIX5",17,0) ; Piece 3 => Description "RTN","XUSNPIX5",18,0) ; Piece 4 => Last Date Compiled "RTN","XUSNPIX5",19,0) ; Piece 5 => $H last run start time "RTN","XUSNPIX5",20,0) ; Piece 6 => $H last run completion time "RTN","XUSNPIX5",21,0) ; "RTN","XUSNPIX5",22,0) ; ^XTMP("XUSNPIX1",1) = DATA "RTN","XUSNPIX5",23,0) ; "RTN","XUSNPIX5",24,0) ; XUSNPI => Unique NPI of entry "RTN","XUSNPIX5",25,0) ; LDT => Last Date Run, VA Fileman Format "RTN","XUSNPIX5",26,0) ; "RTN","XUSNPIX5",27,0) Q "RTN","XUSNPIX5",28,0) ; "RTN","XUSNPIX5",29,0) EMAIL(XUSRTN) ; EMAIL THE MESSAGE "RTN","XUSNPIX5",30,0) ; Add domain name if it does not exist "RTN","XUSNPIX5",31,0) N XUSFOC,DLAYGO,DA,DIC,DIE,DR,X,Y "RTN","XUSNPIX5",32,0) I '$$FIND1^DIC(4.2,,"QX","Q-NPS.VA.GOV","B") D "RTN","XUSNPIX5",33,0) . S XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.VA.GOV",0)) I 'XUSFOC Q "RTN","XUSNPIX5",34,0) . I XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.VA.GOV",""),-1) D "RTN","XUSNPIX5",35,0) . . S DIC="^DIC(4.2,",X="Q-NPS.VA.GOV",DIC(0)="L",DLAYGO=4.2 D ^DIC K DLAYGO "RTN","XUSNPIX5",36,0) . . S DIE=DIC,DA=+Y "RTN","XUSNPIX5",37,0) . . S DR="1///NS;2///^S X=XUSFOC;1.7///YES;6.2///NPS;" "RTN","XUSNPIX5",38,0) . . D ^DIE "RTN","XUSNPIX5",39,0) ; "RTN","XUSNPIX5",40,0) N XMY "RTN","XUSNPIX5",41,0) ; Send email to designated recipient for live release "RTN","XUSNPIX5",42,0) D MAILTO^XUSNPIX1(.XMY) ;p548 "RTN","XUSNPIX5",43,0) D ESEND "RTN","XUSNPIX5",44,0) Q "RTN","XUSNPIX5",45,0) ; "RTN","XUSNPIX5",46,0) SMAIL(XUSRTN,XUSPROD,XUSVER,DTTM) ; Summary email "RTN","XUSNPIX5",47,0) N HYPHEN,L,M,N,T,TMP,T1,T2,T1NV,T2NV,XMY "RTN","XUSNPIX5",48,0) K ^TMP(XUSRTN,$J) "RTN","XUSNPIX5",49,0) S T1=$G(^XTMP(XUSRTN,1)) "RTN","XUSNPIX5",50,0) S T2=$G(^XTMP(XUSRTN,2)) "RTN","XUSNPIX5",51,0) S T1NV=$G(^XTMP(XUSRTN,"1NV")) "RTN","XUSNPIX5",52,0) S T2NV=$G(^XTMP(XUSRTN,"2NV")) "RTN","XUSNPIX5",53,0) S ^TMP(XUSRTN,$J,1)="SUMMARY" "RTN","XUSNPIX5",54,0) S ^TMP(XUSRTN,$J,2)="-------" "RTN","XUSNPIX5",55,0) S ^TMP(XUSRTN,$J,3)=^XTMP(XUSRTN,"H")_" "_DTTM "RTN","XUSNPIX5",56,0) S ^TMP(XUSRTN,$J,4)="" "RTN","XUSNPIX5",57,0) S ^TMP(XUSRTN,$J,5)="Type 1 NEW PERSON FILE (#200) "_$J(+$P(T1,U),3)_" Message(s) Totaling "_$J(+$P(T1,U,2),7)_" NPI records." "RTN","XUSNPIX5",58,0) S ^TMP(XUSRTN,$J,6)="Type 2 INSITUTION FILE (#4) "_$J(+$P(T2,U),3)_" Message(s) Totaling "_$J(+$P(T2,U,2),7)_" NPI records." "RTN","XUSNPIX5",59,0) S ^TMP(XUSRTN,$J,7)="Type 1 NON VA Individual (#355.93) "_$J(+$P(T1NV,U),3)_" Message(s) Totaling "_$J(+$P(T1NV,U,2),7)_" NPI records." "RTN","XUSNPIX5",60,0) S ^TMP(XUSRTN,$J,8)="Type 2 NON VA Facility/Group (#355.93) "_$J(+$P(T2NV,U),3)_" Message(s) Totaling "_$J(+$P(T2NV,U,2),7)_" NPI records." "RTN","XUSNPIX5",61,0) S ^TMP(XUSRTN,$J,9)="" "RTN","XUSNPIX5",62,0) S ^TMP(XUSRTN,$J,10)="Programmer Notes: "_XUSVER_" - "_$G(XUSPROD) "RTN","XUSNPIX5",63,0) ; "RTN","XUSNPIX5",64,0) ;Summary Detail "RTN","XUSNPIX5",65,0) ; "RTN","XUSNPIX5",66,0) S HYPHEN="",$P(HYPHEN,"-",84)="-" "RTN","XUSNPIX5",67,0) ; "RTN","XUSNPIX5",68,0) S ^TMP(XUSRTN,$J,11)="" "RTN","XUSNPIX5",69,0) S ^TMP(XUSRTN,$J,12)=HYPHEN "RTN","XUSNPIX5",70,0) S ^TMP(XUSRTN,$J,13)="" "RTN","XUSNPIX5",71,0) S ^TMP(XUSRTN,$J,14)="MESSAGE DETAILS" "RTN","XUSNPIX5",72,0) S ^TMP(XUSRTN,$J,15)="---------------" "RTN","XUSNPIX5",73,0) S ^TMP(XUSRTN,$J,16)="" "RTN","XUSNPIX5",74,0) S ^TMP(XUSRTN,$J,17)="TYPE "_$J("MESSAGE NUMBER",20)_$J("RECORD COUNT",20) "RTN","XUSNPIX5",75,0) S ^TMP(XUSRTN,$J,18)="----------"_$J("--------------",20)_$J("------------",20) "RTN","XUSNPIX5",76,0) ; "RTN","XUSNPIX5",77,0) S L=18,T="" F S T=$O(^TMP("XUSNPIXS",$J,T)) Q:'T S M=0 F S M=$O(^TMP("XUSNPIXS",$J,T,M)) Q:'M D "RTN","XUSNPIX5",78,0) .S N=$G(^TMP("XUSNPIXS",$J,T,M)) "RTN","XUSNPIX5",79,0) .S L=L+1 "RTN","XUSNPIX5",80,0) .S ^TMP(XUSRTN,$J,L)=$E($P(N,U)_" ",1,10)_$J(M,16)_$J($P(N,U,2),24) "RTN","XUSNPIX5",81,0) S L=L+1,^TMP(XUSRTN,$J,L)="" "RTN","XUSNPIX5",82,0) S L=L+1,^TMP(XUSRTN,$J,L)=HYPHEN "RTN","XUSNPIX5",83,0) ; Send verification email to local mail group and VA Outlook mail group "RTN","XUSNPIX5",84,0) S XMY("G.NPI EXTRACT VERIFICATION")="" "RTN","XUSNPIX5",85,0) N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM "RTN","XUSNPIX5",86,0) S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," "RTN","XUSNPIX5",87,0) S XMSUB=$TR($P(^XTMP(XUSRTN,"H"),U),":")_"("_$G(XUSPROD)_") NPI CROSSWALK EXTRACT SUMMARY " "RTN","XUSNPIX5",88,0) D ^XMD "RTN","XUSNPIX5",89,0) K ^TMP(XUSRTN,$J) "RTN","XUSNPIX5",90,0) Q "RTN","XUSNPIX5",91,0) ; "RTN","XUSNPIX5",92,0) ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM "RTN","XUSNPIX5",93,0) S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," "RTN","XUSNPIX5",94,0) S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 1 " "RTN","XUSNPIX5",95,0) D ^XMD "RTN","XUSNPIX5",96,0) Q "RTN","XUSNPIXU") 0^6^B28263362^B16989884 "RTN","XUSNPIXU",1,0) XUSNPIXU ;OAK_BP/DLS - NPI Extract Utilities ; 6/17/09 "RTN","XUSNPIXU",2,0) ;;8.0;KERNEL;**438,453,528,548**; Jul 10, 1995;Build 24 "RTN","XUSNPIXU",3,0) ;;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","XUSNPIXU",4,0) ; "RTN","XUSNPIXU",5,0) Q "RTN","XUSNPIXU",6,0) ; "RTN","XUSNPIXU",7,0) ; NPI Extract Functions and Utilities "RTN","XUSNPIXU",8,0) ; "RTN","XUSNPIXU",9,0) BCBSID ; This sub-routine is designed to create a string for each Blue Cross/Blue Shield Insurance Company, "RTN","XUSNPIXU",10,0) ; including the Ins Co name and an array of BCBS ID's (the ID's separated by a semi-colon sub-delimiter). "RTN","XUSNPIXU",11,0) ; "RTN","XUSNPIXU",12,0) ; Input Parameter - N/A "RTN","XUSNPIXU",13,0) ; "RTN","XUSNPIXU",14,0) ; System Parameters "RTN","XUSNPIXU",15,0) ; S ==> ";" (Semi-Colon Sub-Delimiter) "RTN","XUSNPIXU",16,0) ; U ==> "^" "RTN","XUSNPIXU",17,0) ; "RTN","XUSNPIXU",18,0) ; Variables "RTN","XUSNPIXU",19,0) ; INSCO - Insurance Company IEN "RTN","XUSNPIXU",20,0) ; INSTYP - Insurance Company Type "RTN","XUSNPIXU",21,0) ; INSNAM - Insurance Company Name "RTN","XUSNPIXU",22,0) ; INSHPR - Hospital Provider Number "RTN","XUSNPIXU",23,0) ; INSPPR - Professional Provider Number "RTN","XUSNPIXU",24,0) ; IBILP - IB Insurance Co Level Billing Provider IEN "RTN","XUSNPIXU",25,0) ; IBILF - IB Insurance Co Level Billing Facility IEN "RTN","XUSNPIXU",26,0) ; IBDFPID - Default BCBS Provider # "RTN","XUSNPIXU",27,0) ; IBILPID - IB Insurance Co Level Billing Provider ID "RTN","XUSNPIXU",28,0) ; IBILFID - IB Insurance Co Level Billing Facility ID "RTN","XUSNPIXU",29,0) ; IDSTR - Local BCBS ID String, placed into ^TMP when complete. "RTN","XUSNPIXU",30,0) ; "RTN","XUSNPIXU",31,0) K ^TMP("XUSNPIXU",$J) "RTN","XUSNPIXU",32,0) N INSCO,INSTYP,INSNAM,INSHPR,INSPPR,IBILP,IBILF,IBILPID,IBILFID,IDSTR,P,S "RTN","XUSNPIXU",33,0) ; "RTN","XUSNPIXU",34,0) S S=";" "RTN","XUSNPIXU",35,0) ; "RTN","XUSNPIXU",36,0) ; Loop through the Insurance Co file. "RTN","XUSNPIXU",37,0) S INSCO=0 "RTN","XUSNPIXU",38,0) F S INSCO=$O(^DIC(36,INSCO)) Q:'INSCO D "RTN","XUSNPIXU",39,0) . S IDSTR="" "RTN","XUSNPIXU",40,0) . S INSTYP=$$GET1^DIQ(36,INSCO_",",.13) "RTN","XUSNPIXU",41,0) . ; "RTN","XUSNPIXU",42,0) . ; If the Insurance Co type is not Blue Cross or Blue Shield, QUIT and move on to the next one. "RTN","XUSNPIXU",43,0) . I '((INSTYP="BLUE CROSS")!(INSTYP="BLUE SHIELD")) Q "RTN","XUSNPIXU",44,0) . ; "RTN","XUSNPIXU",45,0) . ; Get Insurance Company Name. "RTN","XUSNPIXU",46,0) . S INSNAM=$$GET1^DIQ(36,INSCO_",",.01) "RTN","XUSNPIXU",47,0) . ; "RTN","XUSNPIXU",48,0) . ; Get the IB Insurance Co Level Billing Prov ID's. "RTN","XUSNPIXU",49,0) . S IBILP=0 "RTN","XUSNPIXU",50,0) . F S IBILP=$O(^IBA(355.92,"B",INSCO,IBILP)) Q:'IBILP D "RTN","XUSNPIXU",51,0) . . S IBILPID=$$GET1^DIQ(355.92,IBILP_",",.07) "RTN","XUSNPIXU",52,0) . . D ADDID(.IDSTR,IBILPID) "RTN","XUSNPIXU",53,0) . ; "RTN","XUSNPIXU",54,0) . ; Get the IB Insurance Co Level Billing Facility ID's. "RTN","XUSNPIXU",55,0) . S IBILF=0 "RTN","XUSNPIXU",56,0) . F S IBILF=$O(^IBA(355.91,"B",INSCO,IBILF)) Q:'IBILF D "RTN","XUSNPIXU",57,0) . . S IBILFID=$$GET1^DIQ(355.91,IBILF_",",.07) "RTN","XUSNPIXU",58,0) . . D ADDID(.IDSTR,IBILFID) "RTN","XUSNPIXU",59,0) . ; "RTN","XUSNPIXU",60,0) . ; Remove trailing semi-colon and place local ID string into ^TMP. "RTN","XUSNPIXU",61,0) . I $E(IDSTR,$L(IDSTR))=";" S IDSTR=$E(IDSTR,1,$L(IDSTR)-1) "RTN","XUSNPIXU",62,0) . I IDSTR'="" S ^TMP("XUSNPIXU",$J,INSCO)=INSNAM_U_IDSTR "RTN","XUSNPIXU",63,0) Q "RTN","XUSNPIXU",64,0) ; "RTN","XUSNPIXU",65,0) ; "RTN","XUSNPIXU",66,0) ADDID(IDSTRING,ID) ; Append BCBS ID to local ID string, using ";" as the sub-delimiter. Called from BCBSID "RTN","XUSNPIXU",67,0) ; "RTN","XUSNPIXU",68,0) ; Input Parameters "RTN","XUSNPIXU",69,0) ; IDSTRING - Local variable ID string, passed from BCBSID "RTN","XUSNPIXU",70,0) ; ID - ID to be appended to IDSTRING, passed from BCBSID "RTN","XUSNPIXU",71,0) ; "RTN","XUSNPIXU",72,0) I '$D(ID)!('$D(IDSTRING)) Q "RTN","XUSNPIXU",73,0) I ID'="",IDSTRING'[ID S IDSTRING=IDSTRING_ID_S "RTN","XUSNPIXU",74,0) Q "RTN","XUSNPIXU",75,0) ; "RTN","XUSNPIXU",76,0) PRACID(NPIEN,INS) ; Get Practitioner IDs "RTN","XUSNPIXU",77,0) ; "RTN","XUSNPIXU",78,0) ; Output Parameter "RTN","XUSNPIXU",79,0) ; INS - Array-Passed by Reference "RTN","XUSNPIXU",80,0) N BIEN,PRAC,A,A1,A2 "RTN","XUSNPIXU",81,0) K INS "RTN","XUSNPIXU",82,0) S BIEN=NPIEN_";VA(200," "RTN","XUSNPIXU",83,0) S PRAC="" "RTN","XUSNPIXU",84,0) F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D "RTN","XUSNPIXU",85,0) . S A=$$BCBSTR(PRAC) I A="" Q ;P 528 "RTN","XUSNPIXU",86,0) . S A1=$P(A,"^"),A2=$P(A,"^",2) I A1="" Q ;add p 528 "RTN","XUSNPIXU",87,0) . I $D(INS(A1)) S INS(A1_" ")=A2 Q ;add p 528 "RTN","XUSNPIXU",88,0) . S INS(A1)=A2 ;add p 528 "RTN","XUSNPIXU",89,0) Q "RTN","XUSNPIXU",90,0) ; "RTN","XUSNPIXU",91,0) NNVAID(NPIEN,INS) ; Get Non-VA Provider IDS "RTN","XUSNPIXU",92,0) ; "RTN","XUSNPIXU",93,0) ; Output Parameter "RTN","XUSNPIXU",94,0) ; INS - Array-Passed by Reference "RTN","XUSNPIXU",95,0) N BIEN,PRAC,A,A1,A2 "RTN","XUSNPIXU",96,0) K INS "RTN","XUSNPIXU",97,0) S BIEN=NPIEN_";IBA(355.93," "RTN","XUSNPIXU",98,0) S PRAC="" "RTN","XUSNPIXU",99,0) F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D "RTN","XUSNPIXU",100,0) . S A=$$BCBSTR(PRAC) I A="" Q ;p 528 "RTN","XUSNPIXU",101,0) . S A1=$P(A,"^"),A2=$P(A,"^",2) I A1="" Q ;add p 528 "RTN","XUSNPIXU",102,0) . I $D(INS(A1)) S INS(A1_" ")=A2 Q ;add p 528 "RTN","XUSNPIXU",103,0) . S INS(A1)=A2 ;add p 528 "RTN","XUSNPIXU",104,0) Q "RTN","XUSNPIXU",105,0) ; "RTN","XUSNPIXU",106,0) INSTID(INSARRAY) ; Get Institution IDs "RTN","XUSNPIXU",107,0) ; "RTN","XUSNPIXU",108,0) ; Output Parameter "RTN","XUSNPIXU",109,0) ; INSARRAY - Array-Passed by Reference "RTN","XUSNPIXU",110,0) N INS,A "RTN","XUSNPIXU",111,0) K INSARRAY "RTN","XUSNPIXU",112,0) S INS=0 "RTN","XUSNPIXU",113,0) ; 12/13/2007 DLS - Change array structure from INSARRAY(A)="" to INSARRAY($P(A,U,1))=$P(A,U,2) "RTN","XUSNPIXU",114,0) F S INS=$O(^TMP("XUSNPIXU",$J,INS)) Q:INS="" D "RTN","XUSNPIXU",115,0) . S A=$G(^TMP("XUSNPIXU",$J,INS)) "RTN","XUSNPIXU",116,0) . I A'="" S INSARRAY($P(A,U,1))=$P(A,U,2) "RTN","XUSNPIXU",117,0) Q "RTN","XUSNPIXU",118,0) ; "RTN","XUSNPIXU",119,0) ; "RTN","XUSNPIXU",120,0) BCBSTR(PRACIEN) ; Receive an IB Billing Practitioner Provider IEN and return the string of ID's already created. "RTN","XUSNPIXU",121,0) ; "RTN","XUSNPIXU",122,0) ; Input Parameters "RTN","XUSNPIXU",123,0) ; PRACIEN - Practitioner Ins. Co. file IEN - Linked to Provider and passed from NPI Extract. "RTN","XUSNPIXU",124,0) ; "RTN","XUSNPIXU",125,0) ; System Parameters "RTN","XUSNPIXU",126,0) ; S ==> ";" (Semi-Colon Sub-Delimiter) "RTN","XUSNPIXU",127,0) ; Variables "RTN","XUSNPIXU",128,0) ; INSCO - Insurance Company IEN "RTN","XUSNPIXU",129,0) ; PRVID - Provider ID for the specific Insurance Company. This is added on to the ID string stored in TMP. "RTN","XUSNPIXU",130,0) ; "RTN","XUSNPIXU",131,0) ; Get the Ins Co IEN "RTN","XUSNPIXU",132,0) N INSCO,PRVID,P,S "RTN","XUSNPIXU",133,0) S S=";" "RTN","XUSNPIXU",134,0) S INSCO=$$GET1^DIQ(355.9,PRACIEN_",",.02,"I") "RTN","XUSNPIXU",135,0) ; "RTN","XUSNPIXU",136,0) ; Quit if this is NOT a Blue Cross/Blue Shield Insurance Company. "RTN","XUSNPIXU",137,0) I $G(^TMP("XUSNPIXU",$J,+INSCO))="" Q "" "RTN","XUSNPIXU",138,0) ; "RTN","XUSNPIXU",139,0) ; Get the Practitioner ID for this specific Insurance Company. (commented out for now) "RTN","XUSNPIXU",140,0) S PRVID=$$GET1^DIQ(355.9,PRACIEN_",",.07) "RTN","XUSNPIXU",141,0) ; "RTN","XUSNPIXU",142,0) ; If PRVID is NOT null AND the ID is NOT already in the string AND "RTN","XUSNPIXU",143,0) ; (If the string DOES NOT end with a "^", return the ID string with the sub-delimiter and PRVID appended) OR "RTN","XUSNPIXU",144,0) ; (If the string DOES end with a "^", return the ID string with only PRVID appended.) "RTN","XUSNPIXU",145,0) I PRVID'="",((^TMP("XUSNPIXU",$J,INSCO)'["^PRVID;")!(^TMP("XUSNPIXU",$J,INSCO)'[";PRVID;")) D Q ^TMP("XUSNPIXU",$J,INSCO)_PRVID "RTN","XUSNPIXU",146,0) . I $E($L(^TMP("XUSNPIXU",$J,INSCO)))'=U S PRVID=S_PRVID "RTN","XUSNPIXU",147,0) . Q "RTN","XUSNPIXU",148,0) ; "RTN","XUSNPIXU",149,0) ; If nothing needs changing, return the string unchanged. "RTN","XUSNPIXU",150,0) Q ^TMP("XUSNPIXU",$J,INSCO) "RTN","XUSNPIXU",151,0) ; "RTN","XUSNPIXU",152,0) INIT ;Initialize ^XTMP "RTN","XUSNPIXU",153,0) K ^XTMP("XUSNPIX1") "RTN","XUSNPIXU",154,0) K ^XTMP("XUSNPIX2") "RTN","XUSNPIXU",155,0) K ^XTMP("XUSNPIX1NV") "RTN","XUSNPIXU",156,0) K ^XTMP("XUSNPIX2NV") "RTN","XUSNPIXU",157,0) K ^XTMP("XUSNPIXT") "RTN","XUSNPIXU",158,0) Q "RTN","XUSNPIXU",159,0) ; "RTN","XUSNPIXU",160,0) P2PBASE(XUSTMP) ; "RTN","XUSNPIXU",161,0) N XUSNP2P,IBSIEN,ZN19,P2PVAL,XUSDEF "RTN","XUSNPIXU",162,0) S XUSNP2P=0 "RTN","XUSNPIXU",163,0) F S XUSNP2P=$O(^IBE(350.9,1,19,"B",XUSNP2P)) Q:XUSNP2P="" D "RTN","XUSNPIXU",164,0) . S IBSIEN=$O(^IBE(350.9,1,19,"B",XUSNP2P,"")) "RTN","XUSNPIXU",165,0) . S ZN19=^IBE(350.9,1,19,IBSIEN,0),P2PVAL=$P(ZN19,U,5) "RTN","XUSNPIXU",166,0) . I P2PVAL S XUSTMP("P2P",XUSNP2P)=P2PVAL "RTN","XUSNPIXU",167,0) . E S XUSTMP("P2P",XUSNP2P)=IBSIEN "RTN","XUSNPIXU",168,0) S XUSDEF=$P($G(^IBE(350.9,1,11)),U,3) "RTN","XUSNPIXU",169,0) I XUSDEF="" G P2PBASEX "RTN","XUSNPIXU",170,0) I '$D(^IBE(350.9,1,19,XUSDEF)) S XUSDEF="" "RTN","XUSNPIXU",171,0) P2PBASEX ; "RTN","XUSNPIXU",172,0) I XUSDEF'="" S XUSTMP("P2P","DEFAULT")=XUSDEF "RTN","XUSNPIXU",173,0) Q "RTN","XUSNPIXU",174,0) ; "RTN","XUSNPIXU",175,0) P2PEXP(IEN,XUSPT) ; "RTN","XUSNPIXU",176,0) N IBE35090,IBE35091,P2PVAL,I "RTN","XUSNPIXU",177,0) S IBE35090=$G(^IBE(350.9,1,19,IEN,0)) "RTN","XUSNPIXU",178,0) F I=1:1:6 S XUSPT(I)="" "RTN","XUSNPIXU",179,0) I IBE35090]"" S XUSPT(1)=$P(IBE35090,U,2) "RTN","XUSNPIXU",180,0) S IBE35091=$G(^IBE(350.9,1,19,IEN,1)) "RTN","XUSNPIXU",181,0) I IBE35091]"" D "RTN","XUSNPIXU",182,0) . S XUSPT(2)=$P(IBE35091,U,1) "RTN","XUSNPIXU",183,0) . S XUSPT(3)=$P(IBE35091,U,2) "RTN","XUSNPIXU",184,0) . S XUSPT(4)=$P(IBE35091,U,3) "RTN","XUSNPIXU",185,0) . S XUSPT(5)=$P(IBE35091,U,4) "RTN","XUSNPIXU",186,0) . I XUSPT(5)?1N.N S XUSPT(5)=$P($G(^DIC(5,XUSPT(5),0)),U,2) "RTN","XUSNPIXU",187,0) . S XUSPT(6)=$P(IBE35091,U,5) "RTN","XUSNPIXU",188,0) Q XUSPT(1)_U_XUSPT(2)_U_XUSPT(3)_U_XUSPT(4)_U_XUSPT(5)_U_XUSPT(6) "VER") 8.0^22.0 "BLD",8443,6) ^444 **END** **END**