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 Apr 09, 2024@21:19:22 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
