- XUSNPIX3 ;OAK_BP/CMW - NPI EXTRACT REPORT ; Aug 30, 2022@04:12:24
- ;;8.0;KERNEL;**438,452,453,481,548,774**; Jul 10, 1995;Build 2
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; 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
- ; Integration Agreement #4964.
- ;
- ; NPI Extract Report
- ;
- ; Input parameter: N/A
- ;
- ; Other relevant variables:
- ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
- ; XUSRTN="XUSNPIX2NV" storage subscript)
- ; Storage Global:
- ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
- ; ^XTMP("XUSNPIX2VA",0)
- ; where:
- ; Piece 1 => Purge Date - 1 year in future
- ; Piece 2 => Create Date - Today
- ; Piece 3 => Description
- ; Piece 4 => Last Date Compiled
- ; Piece 5 => $H last run start time
- ; Piece 6 => $H last run completion time
- ;
- ; Entry Point - ENT called from XUSNPIX1
- ;
- Q
- ;
- ENT(XUSPROD,XUSVER) ; ENTRY POINT
- ; init variables
- N XUSRTN,XUSEOL,DTTM3,XUSP2P,INST,SITE
- N XUSNPI,XUSDATA,XUSTYP,XUST
- N NVIEN,IBA0,PROTYPE,NPIDT,NPINEW,XUSHDR,NVTYPE
- K ^TMP("XUSNPI",$J)
- ;
- ; Set end of line character
- S XUSEOL="~~"
- ;
- S DTTM3=$$HTE^XLFDT($H,"2")
- ;
- S XUST=""
- ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref
- S XUSNPI=0
- F S XUSNPI=$O(^IBA(355.93,"NPI",XUSNPI)) Q:'XUSNPI D
- . S NVIEN=$O(^IBA(355.93,"NPI",XUSNPI,""))
- . S IBA0=$G(^IBA(355.93,NVIEN,0))
- . ; Get Provider Type
- . S PROTYPE=$P(IBA0,U,2)
- . S XUSTYP=$S(PROTYPE=1:2,1:1)
- . ; setup NPI array
- . S ^TMP("XUSNPI",$J,XUSTYP,XUSNPI)=NVIEN
- ;
- I $D(^TMP("XUSNPI",$J))'>0 Q ;p774
- I $D(^TMP("XUSNPI",$J)) D INITA ; set up global variables and P2P data
- ;
- ; If Provider Type is Individual
- S XUSRTN="XUSNPIX1NV",NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)",NVTYPE="TYPE 1 (NVA)"
- I $D(^TMP("XUSNPI",$J,1)) D I XUST G EXIT
- . ; Check to see if report is in use
- . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q
- . D INITB(XUSRTN)
- . D HDR(XUSRTN)
- . D TYPE1^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
- . ;
- . ; Log Run Completion Time
- . S $P(^XTMP(XUSRTN,0),U,6)=$H
- . L -^XTMP(XUSRTN)
- ;
- I '$D(^TMP("XUSNPI",$J,1)) D
- . D INITB(XUSRTN)
- . D HDR(XUSRTN)
- . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL
- . S ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3
- . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL
- . D EMAIL(XUSRTN)
- . S ^TMP("XUSNPIXS",$J,3,1)="1 (Non-VA)^0"
- ;
- ; If Provider Type is Facility/Group
- S XUSRTN="XUSNPIX2NV",NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)",NVTYPE="TYPE 2 (NVA)"
- I $D(^TMP("XUSNPI",$J,2)) D I XUST G EXIT
- . ; Check to see if report is in use
- . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q
- . D INITB(XUSRTN)
- . D HDR(XUSRTN)
- . D TYPE2^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
- . ;
- . ; Log Run Completion Time
- . S $P(^XTMP(XUSRTN,0),U,6)=$H
- . L -^XTMP(XUSRTN)
- . ;
- I '$D(^TMP("XUSNPI",$J,2)) D
- . D INITB(XUSRTN)
- . D HDR(XUSRTN)
- . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL
- . S ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3
- . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL
- . D EMAIL(XUSRTN)
- . S ^TMP("XUSNPIXS",$J,4,1)="2 (Non-VA)^0"
- ;
- EXIT ;Standard EXIT point
- K ^TMP("XUSNPI",$J)
- K XUSNV,P,LDTCMP,SITE,NVHEADR,XUSEOL,DTTM3
- ;
- Q
- ;=============================================
- INITA ; set up global variables (site and inst info)
- N SINFO,XUSTMP,XUSP2PA,I
- K XUSTMP
- ;
- ; Pull site info
- S SINFO=$$SITE^VASITE
- ; Station Number
- S SITE=$P(SINFO,U,3)
- ; Institution
- S INST=$P(SINFO,U)
- ;
- ; Get Pay-to-Provider for all Non-VA records (type 1 & 2)
- ;
- F I=1:1:6 S $P(XUSP2P,U,I)="" ; initialize
- D P2PBASE^XUSNPIXU(.XUSTMP)
- I $D(XUSTMP("P2P",INST)) S XUSP2P=$$P2PEXP^XUSNPIXU((XUSTMP("P2P",INST)),.XUSP2PA)
- Q
- ;
- INITB(XUSRTN) ; check/init variables
- N XUSDESC
- ;
- ;Reset Temporary Scratch Global
- K ^TMP(XUSRTN)
- S XUSDESC="NPI EXTRACT NON VA - Do Not Delete"
- S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
- ;
- I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU
- Q
- ;
- HDR(XUSRTN) ;Get header
- N DIC4,XUSCITY,XUSSTATE,XUSZIP
- S (DIC4,XUSCITY,XUSSTATE,XUSZIP)=""
- ;
- ; *** Start XU*8.0*548 - RBN ***
- ; Get header for extracted data NOT email
- I $G(INST) D
- . S DIC4=$G(^DIC(4,INST,4))
- . S XUSCITY=$P(DIC4,U,3)
- . S XUSSTATE=$P(DIC4,U,4)
- . I XUSSTATE S XUSSTATE=$P($G(^DIC(5,XUSSTATE,0)),U,2)
- . S XUSZIP=$P(DIC4,U,5)
- S XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_NVTYPE_U_XUSVER
- Q
- ;
- EMAIL(XUSRTN) ; EMAIL THE MESSAGE
- N XMY
- ; Send email to designated recipient for live release (send the extracted data via MailMan)
- D MAILTO^XUSNPIX1(.XMY) ;p548
- D ESEND
- Q
- ;
- ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
- S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
- S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") "_NVHEADR
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIX3 5048 printed Feb 18, 2025@23:39:13 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; 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
- +5 ; Integration Agreement #4964.
- +6 ;
- +7 ; NPI Extract Report
- +8 ;
- +9 ; Input parameter: N/A
- +10 ;
- +11 ; Other relevant variables:
- +12 ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP
- +13 ; XUSRTN="XUSNPIX2NV" storage subscript)
- +14 ; Storage Global:
- +15 ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
- +16 ; ^XTMP("XUSNPIX2VA",0)
- +17 ; where:
- +18 ; Piece 1 => Purge Date - 1 year in future
- +19 ; Piece 2 => Create Date - Today
- +20 ; Piece 3 => Description
- +21 ; Piece 4 => Last Date Compiled
- +22 ; Piece 5 => $H last run start time
- +23 ; Piece 6 => $H last run completion time
- +24 ;
- +25 ; Entry Point - ENT called from XUSNPIX1
- +26 ;
- +27 QUIT
- +28 ;
- ENT(XUSPROD,XUSVER) ; ENTRY POINT
- +1 ; init variables
- +2 NEW XUSRTN,XUSEOL,DTTM3,XUSP2P,INST,SITE
- +3 NEW XUSNPI,XUSDATA,XUSTYP,XUST
- +4 NEW NVIEN,IBA0,PROTYPE,NPIDT,NPINEW,XUSHDR,NVTYPE
- +5 KILL ^TMP("XUSNPI",$JOB)
- +6 ;
- +7 ; Set end of line character
- +8 SET XUSEOL="~~"
- +9 ;
- +10 SET DTTM3=$$HTE^XLFDT($HOROLOG,"2")
- +11 ;
- +12 SET XUST=""
- +13 ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref
- +14 SET XUSNPI=0
- +15 FOR
- SET XUSNPI=$ORDER(^IBA(355.93,"NPI",XUSNPI))
- if 'XUSNPI
- QUIT
- Begin DoDot:1
- +16 SET NVIEN=$ORDER(^IBA(355.93,"NPI",XUSNPI,""))
- +17 SET IBA0=$GET(^IBA(355.93,NVIEN,0))
- +18 ; Get Provider Type
- +19 SET PROTYPE=$PIECE(IBA0,U,2)
- +20 SET XUSTYP=$SELECT(PROTYPE=1:2,1:1)
- +21 ; setup NPI array
- +22 SET ^TMP("XUSNPI",$JOB,XUSTYP,XUSNPI)=NVIEN
- End DoDot:1
- +23 ;
- +24 ;p774
- IF $DATA(^TMP("XUSNPI",$JOB))'>0
- QUIT
- +25 ; set up global variables and P2P data
- IF $DATA(^TMP("XUSNPI",$JOB))
- DO INITA
- +26 ;
- +27 ; If Provider Type is Individual
- +28 SET XUSRTN="XUSNPIX1NV"
- SET NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)"
- SET NVTYPE="TYPE 1 (NVA)"
- +29 IF $DATA(^TMP("XUSNPI",$JOB,1))
- Begin DoDot:1
- +30 ; Check to see if report is in use
- +31 LOCK +^XTMP(XUSRTN):5
- IF '$TEST
- SET XUST=1
- QUIT
- +32 DO INITB(XUSRTN)
- +33 DO HDR(XUSRTN)
- +34 DO TYPE1^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
- +35 ;
- +36 ; Log Run Completion Time
- +37 SET $PIECE(^XTMP(XUSRTN,0),U,6)=$HOROLOG
- +38 LOCK -^XTMP(XUSRTN)
- End DoDot:1
- IF XUST
- GOTO EXIT
- +39 ;
- +40 IF '$DATA(^TMP("XUSNPI",$JOB,1))
- Begin DoDot:1
- +41 DO INITB(XUSRTN)
- +42 DO HDR(XUSRTN)
- +43 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$GET(XUSPROD)_XUSEOL
- +44 SET ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3
- +45 SET ^TMP(XUSRTN,$JOB,2)="END OF FILE"_U_XUSEOL
- +46 DO EMAIL(XUSRTN)
- +47 SET ^TMP("XUSNPIXS",$JOB,3,1)="1 (Non-VA)^0"
- End DoDot:1
- +48 ;
- +49 ; If Provider Type is Facility/Group
- +50 SET XUSRTN="XUSNPIX2NV"
- SET NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)"
- SET NVTYPE="TYPE 2 (NVA)"
- +51 IF $DATA(^TMP("XUSNPI",$JOB,2))
- Begin DoDot:1
- +52 ; Check to see if report is in use
- +53 LOCK +^XTMP(XUSRTN):5
- IF '$TEST
- SET XUST=1
- QUIT
- +54 DO INITB(XUSRTN)
- +55 DO HDR(XUSRTN)
- +56 DO TYPE2^XUSNPIX4(DTTM3,SITE,XUSPROD,XUSHDR,XUSP2P)
- +57 ;
- +58 ; Log Run Completion Time
- +59 SET $PIECE(^XTMP(XUSRTN,0),U,6)=$HOROLOG
- +60 LOCK -^XTMP(XUSRTN)
- +61 ;
- End DoDot:1
- IF XUST
- GOTO EXIT
- +62 IF '$DATA(^TMP("XUSNPI",$JOB,2))
- Begin DoDot:1
- +63 DO INITB(XUSRTN)
- +64 DO HDR(XUSRTN)
- +65 SET ^TMP(XUSRTN,$JOB,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$GET(XUSPROD)_XUSEOL
- +66 SET ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3
- +67 SET ^TMP(XUSRTN,$JOB,2)="END OF FILE"_U_XUSEOL
- +68 DO EMAIL(XUSRTN)
- +69 SET ^TMP("XUSNPIXS",$JOB,4,1)="2 (Non-VA)^0"
- End DoDot:1
- +70 ;
- EXIT ;Standard EXIT point
- +1 KILL ^TMP("XUSNPI",$JOB)
- +2 KILL XUSNV,P,LDTCMP,SITE,NVHEADR,XUSEOL,DTTM3
- +3 ;
- +4 QUIT
- +5 ;=============================================
- INITA ; set up global variables (site and inst info)
- +1 NEW SINFO,XUSTMP,XUSP2PA,I
- +2 KILL XUSTMP
- +3 ;
- +4 ; Pull site info
- +5 SET SINFO=$$SITE^VASITE
- +6 ; Station Number
- +7 SET SITE=$PIECE(SINFO,U,3)
- +8 ; Institution
- +9 SET INST=$PIECE(SINFO,U)
- +10 ;
- +11 ; Get Pay-to-Provider for all Non-VA records (type 1 & 2)
- +12 ;
- +13 ; initialize
- FOR I=1:1:6
- SET $PIECE(XUSP2P,U,I)=""
- +14 DO P2PBASE^XUSNPIXU(.XUSTMP)
- +15 IF $DATA(XUSTMP("P2P",INST))
- SET XUSP2P=$$P2PEXP^XUSNPIXU((XUSTMP("P2P",INST)),.XUSP2PA)
- +16 QUIT
- +17 ;
- INITB(XUSRTN) ; check/init variables
- +1 NEW XUSDESC
- +2 ;
- +3 ;Reset Temporary Scratch Global
- +4 KILL ^TMP(XUSRTN)
- +5 SET XUSDESC="NPI EXTRACT NON VA - Do Not Delete"
- +6 SET ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$HOROLOG
- +7 ;
- +8 IF '$DATA(^TMP("XUSNPIXU",$JOB))
- DO BCBSID^XUSNPIXU
- +9 QUIT
- +10 ;
- HDR(XUSRTN) ;Get header
- +1 NEW DIC4,XUSCITY,XUSSTATE,XUSZIP
- +2 SET (DIC4,XUSCITY,XUSSTATE,XUSZIP)=""
- +3 ;
- +4 ; *** Start XU*8.0*548 - RBN ***
- +5 ; Get header for extracted data NOT email
- +6 IF $GET(INST)
- Begin DoDot:1
- +7 SET DIC4=$GET(^DIC(4,INST,4))
- +8 SET XUSCITY=$PIECE(DIC4,U,3)
- +9 SET XUSSTATE=$PIECE(DIC4,U,4)
- +10 IF XUSSTATE
- SET XUSSTATE=$PIECE($GET(^DIC(5,XUSSTATE,0)),U,2)
- +11 SET XUSZIP=$PIECE(DIC4,U,5)
- End DoDot:1
- +12 SET XUSHDR="Station: "_SITE_U_XUSCITY_U_XUSSTATE_U_XUSZIP_U_NVTYPE_U_XUSVER
- +13 QUIT
- +14 ;
- EMAIL(XUSRTN) ; EMAIL THE MESSAGE
- +1 NEW XMY
- +2 ; Send email to designated recipient for live release (send the extracted data via MailMan)
- +3 ;p548
- DO MAILTO^XUSNPIX1(.XMY)
- +4 DO ESEND
- +5 QUIT
- +6 ;
- ESEND NEW XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
- +1 SET XMTEXT="^TMP("""_XUSRTN_""","_$JOB_","
- +2 SET XMSUB=$TRANSLATE($PIECE($GET(^TMP(XUSRTN,$JOB,1)),U),":")_"("_$GET(XUSPROD)_") "_NVHEADR
- +3 DO ^XMD
- +4 QUIT