Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSNPIX3

XUSNPIX3.m

Go to the documentation of this file.
  1. XUSNPIX3 ;OAK_BP/CMW - NPI EXTRACT REPORT ; Aug 30, 2022@04:12:24
  1. ;;8.0;KERNEL;**438,452,453,481,548,774**; Jul 10, 1995;Build 2
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; 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
  1. ; Integration Agreement #4964.
  1. ;
  1. ; NPI Extract Report
  1. ;
  1. ; Input parameter: N/A
  1. ;
  1. ; Other relevant variables:
  1. ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
  1. ; XUSRTN="XUSNPIX2NV" storage subscript)
  1. ; Storage Global:
  1. ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
  1. ; ^XTMP("XUSNPIX2VA",0)
  1. ; where:
  1. ; Piece 1 => Purge Date - 1 year in future
  1. ; Piece 2 => Create Date - Today
  1. ; Piece 3 => Description
  1. ; Piece 4 => Last Date Compiled
  1. ; Piece 5 => $H last run start time
  1. ; Piece 6 => $H last run completion time
  1. ;
  1. ; Entry Point - ENT called from XUSNPIX1
  1. ;
  1. Q
  1. ;
  1. ENT(XUSPROD,XUSVER) ; ENTRY POINT
  1. ; init variables
  1. N XUSRTN,XUSEOL,DTTM3,XUSP2P,INST,SITE
  1. N XUSNPI,XUSDATA,XUSTYP,XUST
  1. N NVIEN,IBA0,PROTYPE,NPIDT,NPINEW,XUSHDR,NVTYPE
  1. K ^TMP("XUSNPI",$J)
  1. ;
  1. ; Set end of line character
  1. S XUSEOL="~~"
  1. ;
  1. S DTTM3=$$HTE^XLFDT($H,"2")
  1. ;
  1. S XUST=""
  1. ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref
  1. S XUSNPI=0
  1. F S XUSNPI=$O(^IBA(355.93,"NPI",XUSNPI)) Q:'XUSNPI D
  1. . S NVIEN=$O(^IBA(355.93,"NPI",XUSNPI,""))
  1. . S IBA0=$G(^IBA(355.93,NVIEN,0))
  1. . ; Get Provider Type
  1. . S PROTYPE=$P(IBA0,U,2)
  1. . S XUSTYP=$S(PROTYPE=1:2,1:1)
  1. . ; setup NPI array
  1. . S ^TMP("XUSNPI",$J,XUSTYP,XUSNPI)=NVIEN
  1. ;
  1. I $D(^TMP("XUSNPI",$J))'>0 Q ;p774
  1. I $D(^TMP("XUSNPI",$J)) D INITA ; set up global variables and P2P data
  1. ;
  1. ; If Provider Type is Individual
  1. S XUSRTN="XUSNPIX1NV",NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)",NVTYPE="TYPE 1 (NVA)"
  1. I $D(^TMP("XUSNPI",$J,1)) D I XUST G EXIT
  1. . ; Check to see if report is in use
  1. . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q
  1. . D INITB(XUSRTN)
  1. . D HDR(XUSRTN)
  1. . D TYPE1^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
  1. . ;
  1. . ; Log Run Completion Time
  1. . S $P(^XTMP(XUSRTN,0),U,6)=$H
  1. . L -^XTMP(XUSRTN)
  1. ;
  1. I '$D(^TMP("XUSNPI",$J,1)) D
  1. . D INITB(XUSRTN)
  1. . D HDR(XUSRTN)
  1. . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL
  1. . S ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3
  1. . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL
  1. . D EMAIL(XUSRTN)
  1. . S ^TMP("XUSNPIXS",$J,3,1)="1 (Non-VA)^0"
  1. ;
  1. ; If Provider Type is Facility/Group
  1. S XUSRTN="XUSNPIX2NV",NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)",NVTYPE="TYPE 2 (NVA)"
  1. I $D(^TMP("XUSNPI",$J,2)) D I XUST G EXIT
  1. . ; Check to see if report is in use
  1. . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q
  1. . D INITB(XUSRTN)
  1. . D HDR(XUSRTN)
  1. . D TYPE2^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
  1. . ;
  1. . ; Log Run Completion Time
  1. . S $P(^XTMP(XUSRTN,0),U,6)=$H
  1. . L -^XTMP(XUSRTN)
  1. . ;
  1. I '$D(^TMP("XUSNPI",$J,2)) D
  1. . D INITB(XUSRTN)
  1. . D HDR(XUSRTN)
  1. . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL
  1. . S ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3
  1. . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL
  1. . D EMAIL(XUSRTN)
  1. . S ^TMP("XUSNPIXS",$J,4,1)="2 (Non-VA)^0"
  1. ;
  1. EXIT ;Standard EXIT point
  1. K ^TMP("XUSNPI",$J)
  1. K XUSNV,P,LDTCMP,SITE,NVHEADR,XUSEOL,DTTM3
  1. ;
  1. Q
  1. ;=============================================
  1. INITA ; set up global variables (site and inst info)
  1. N SINFO,XUSTMP,XUSP2PA,I
  1. K XUSTMP
  1. ;
  1. ; Pull site info
  1. S SINFO=$$SITE^VASITE
  1. ; Station Number
  1. S SITE=$P(SINFO,U,3)
  1. ; Institution
  1. S INST=$P(SINFO,U)
  1. ;
  1. ; Get Pay-to-Provider for all Non-VA records (type 1 & 2)
  1. ;
  1. F I=1:1:6 S $P(XUSP2P,U,I)="" ; initialize
  1. D P2PBASE^XUSNPIXU(.XUSTMP)
  1. I $D(XUSTMP("P2P",INST)) S XUSP2P=$$P2PEXP^XUSNPIXU((XUSTMP("P2P",INST)),.XUSP2PA)
  1. Q
  1. ;
  1. INITB(XUSRTN) ; check/init variables
  1. N XUSDESC
  1. ;
  1. ;Reset Temporary Scratch Global
  1. K ^TMP(XUSRTN)
  1. S XUSDESC="NPI EXTRACT NON VA - Do Not Delete"
  1. S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
  1. ;
  1. I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
  1. Q
  1. ;
  1. HDR(XUSRTN) ;Get header
  1. N DIC4,XUSCITY,XUSSTATE,XUSZIP
  1. S (DIC4,XUSCITY,XUSSTATE,XUSZIP)=""
  1. ;
  1. ; *** Start XU*8.0*548 - RBN ***
  1. ; Get header for extracted data NOT email
  1. I $G(INST) D
  1. . S DIC4=$G(^DIC(4,INST,4))
  1. . S XUSCITY=$P(DIC4,U,3)
  1. . S XUSSTATE=$P(DIC4,U,4)
  1. . I XUSSTATE S XUSSTATE=$P($G(^DIC(5,XUSSTATE,0)),U,2)
  1. . S XUSZIP=$P(DIC4,U,5)
  1. S XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_NVTYPE_U_XUSVER
  1. Q
  1. ;
  1. EMAIL(XUSRTN) ; EMAIL THE MESSAGE
  1. N XMY
  1. ; Send email to designated recipient for live release (send the extracted data via MailMan)
  1. D MAILTO^XUSNPIX1(.XMY) ;p548
  1. D ESEND
  1. Q
  1. ;
  1. ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
  1. S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
  1. S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") "_NVHEADR
  1. D ^XMD
  1. Q