Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIX3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIX3.m
r613 r623 1 XUSNPIX3 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06 2 ;;8.0;KERNEL;**438,452,453,481**; Jul 10, 1995;Build 21 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; NPI Extract Report 6 ; 7 ; Input parameter: N/A 8 ; 9 ; Other relevant variables: 10 ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP 11 ; XUSRTN="XUSNPIX2NV" storage subscript) 12 ; Storage Global: 13 ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 14 ; ^XTMP("XUSNPIX2VA",0) 15 ; where: 16 ; Piece 1 => Purge Date - 1 year in future 17 ; Piece 2 => Create Date - Today 18 ; Piece 3 => Description 19 ; Piece 4 => Last Date Compiled 20 ; Piece 5 => $H last run start time 21 ; Piece 6 => $H last run completion time 22 ; 23 ; Entry Point - ENT called from XUSNPIX1 24 ; 25 Q 26 ; 27 ENT(XUSPROD,XUSVER) ; ENTRY POINT 28 ; init variables 29 N XUSRTN,XUSEOL,DTTM3 30 N XUSNPI,XUSDATA,XUSTYP,XUST 31 N NVIEN,IBA0,PROTYPE,NPIDT,NPINEW 32 K ^TMP("XUSNPI",$J) 33 ; 34 ; Set end of line character 35 S XUSEOL="~~" 36 ; 37 S DTTM3=$$HTE^XLFDT($H,"2") 38 ; 39 S XUST="" 40 ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref 41 S XUSNPI=0 42 F S XUSNPI=$O(^IBA(355.93,"NPI",XUSNPI)) Q:'XUSNPI D 43 . S NVIEN=$O(^IBA(355.93,"NPI",XUSNPI,"")) 44 . S IBA0=$G(^IBA(355.93,NVIEN,0)) 45 . ; Get Provider Type 46 . S PROTYPE=$P(IBA0,U,2) 47 . S XUSTYP=$S(PROTYPE=1:2,1:1) 48 . ; setup NPI array 49 . S ^TMP("XUSNPI",$J,XUSTYP,XUSNPI)=NVIEN 50 . ; 51 ; If Provider Type is Individual 52 S XUSRTN="XUSNPIX1NV",NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)",NVTYPE="TYPE 1 (NVA)" 53 I $D(^TMP("XUSNPI",$J,1)) D I XUST G EXIT 54 . ; Check to see if report is in use 55 . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q 56 . D INIT(XUSRTN) 57 . D INST(XUSRTN) 58 . D TYPE1^XUSNPIX4(DTTM3,PTPMAIL,SITE,XUSPROD,XUSHDR) 59 . ; 60 . ; Log Run Completion Time 61 . S $P(^XTMP(XUSRTN,0),U,6)=$H 62 . L -^XTMP(XUSRTN) 63 ; 64 I '$D(^TMP("XUSNPI",$J,1)) D 65 . D INIT(XUSRTN) 66 . D INST(XUSRTN) 67 . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL 68 . S ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3 69 . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL 70 . D EMAIL(XUSRTN) 71 . S ^TMP("XUSNPIXS",$J,3,1)="1 (Non-VA)^0" 72 ; 73 ; If Provider Type is Facility/Group 74 S XUSRTN="XUSNPIX2NV",NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)",NVTYPE="TYPE 2 (NVA)" 75 I $D(^TMP("XUSNPI",$J,2)) D I XUST G EXIT 76 . ; Check to see if report is in use 77 . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q 78 . D INIT(XUSRTN) 79 . D INST(XUSRTN) 80 . D TYPE2^XUSNPIX4(DTTM3,PTPMAIL,SITE,XUSPROD,XUSHDR) 81 . ; 82 . ; Log Run Completion Time 83 . S $P(^XTMP(XUSRTN,0),U,6)=$H 84 . L -^XTMP(XUSRTN) 85 . ; 86 I '$D(^TMP("XUSNPI",$J,2)) D 87 . D INIT(XUSRTN) 88 . D INST(XUSRTN) 89 . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL 90 . S ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3 91 . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL 92 . D EMAIL(XUSRTN) 93 . S ^TMP("XUSNPIXS",$J,4,1)="2 (Non-VA)^0" 94 ; 95 EXIT ;Standard EXIT point 96 K ^TMP("XUSNPI",$J) 97 K XUSNV,P,LDTCMP,PTPMAIL,SITE,NVHEADR,NVTYPE,XUSEOL,DTTM3 98 K XUSHDR 99 ; 100 Q 101 ; 102 INIT(XUSRTN) ; check/init variables 103 N XUSDESC 104 ; 105 ;Reset Temporary Scratch Global 106 K ^TMP(XUSRTN) 107 S XUSDESC="NPI EXTRACT NON VA - Do Not Delete" 108 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H 109 ; 110 I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU 111 Q 112 ; 113 INST(XUSRTN) ;Pull station and Institution info 114 N INST,SINFO,DIC4 115 ; Pull site info 116 S SINFO=$$SITE^VASITE 117 ; Station Number 118 S SITE=$P(SINFO,U,3) 119 ; Institution 120 S INST=$P(SINFO,U) 121 ; 122 ; Get institution mailing address 123 I INST D 124 . S DIC4=$G(^DIC(4,INST,4)) 125 . S XUSNV(7)=$P(DIC4,U) 126 . S XUSNV(8)=$P(DIC4,U,2) 127 . S XUSNV(9)=$P(DIC4,U,3) 128 . S XUSNV(10)=$P(DIC4,U,4) 129 . I XUSNV(10) S XUSNV(10)=$P($G(^DIC(5,XUSNV(10),0)),U,2) 130 . S XUSNV(11)=$P(DIC4,U,5) 131 . S PTPMAIL=XUSNV(7)_U_XUSNV(8)_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11) 132 S XUSHDR="Station: "_SITE_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11)_U_NVTYPE_U_XUSVER 133 Q 134 ; 135 EMAIL(XUSRTN) ; EMAIL THE MESSAGE 136 N XMY 137 ; Send email to designated recipient for live release 138 S XMY("XXX@Q-NPS.VA.GOV")="" 139 D ESEND 140 Q 141 ; 142 ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM 143 S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," 144 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") "_NVHEADR 145 D ^XMD 146 Q 1 XUSNPIX3 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06 2 ;;8.0;KERNEL;**438,452,453**; Jul 10, 1995;Build 36 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ; NPI Extract Report 6 ; 7 ; Input parameter: N/A 8 ; 9 ; Other relevant variables: 10 ; XUSRTN="XUSNPIX1NV" (current routine name, used for ^XTMP and ^TMP 11 ; XUSRTN="XUSNPIX2NV" storage subscript) 12 ; Storage Global: 13 ; ^XTMP("XUSNPIX1VA",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6 14 ; ^XTMP("XUSNPIX2VA",0) 15 ; where: 16 ; Piece 1 => Purge Date - 1 year in future 17 ; Piece 2 => Create Date - Today 18 ; Piece 3 => Description 19 ; Piece 4 => Last Date Compiled 20 ; Piece 5 => $H last run start time 21 ; Piece 6 => $H last run completion time 22 ; 23 ; Entry Point - ENT called from XUSNPIX1 24 ; 25 Q 26 ; 27 ENT ; ENTRY POINT 28 ; init variables 29 N XUSRTN 30 N XUSNPI,XUSDATA,XUSTYP,XUST 31 N NVIEN,IBA0,PROTYPE,NPIDT,NPINEW 32 K ^TMP("XUSNPI",$J) 33 S XUST="",XUSCNT=2,MSGCNT=0 34 ; Loop through IB NON/OTHER VA BILLING PROVIDER records NPI xref 35 S XUSNPI=0 36 F S XUSNPI=$O(^IBA(355.93,"NPI",XUSNPI)) Q:'XUSNPI D 37 . S NVIEN=$O(^IBA(355.93,"NPI",XUSNPI,"")) 38 . S IBA0=$G(^IBA(355.93,NVIEN,0)) 39 . ; Get Provider Type 40 . S PROTYPE=$P(IBA0,U,2) 41 . S XUSTYP=$S(PROTYPE=1:2,1:1) 42 . ; setup NPI array 43 . S ^TMP("XUSNPI",$J,XUSTYP,XUSNPI)=NVIEN 44 . ; 45 ; If Provider Type is Individual 46 S XUSRTN="XUSNPIX1NV",NVHEADR=" NPI EXTRACT TYPE 1 (NON VA)",NVTYPE="TYPE 1 (NVA)" 47 I $D(^TMP("XUSNPI",$J,1)) D I XUST G EXIT 48 . ; Check to see if report is in use 49 . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q 50 . D INIT(XUSRTN) 51 . D INST(XUSRTN) 52 . D TYPE1^XUSNPIX4 53 . D EMAIL(XUSRTN) 54 . D VMAIL(XUSRTN) 55 . ; Log Run Completion Time 56 . S $P(^XTMP(XUSRTN,0),U,6)=$H 57 . L -^XTMP(XUSRTN) 58 ; 59 I '$D(^TMP("XUSNPI",$J,1)) D 60 . D INIT(XUSRTN) 61 . D INST(XUSRTN) 62 . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL 63 . S ^XTMP("XUSNPIXT","1NV")=1_U_0_U_DTTM3 64 . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL 65 . D EMAIL(XUSRTN),VMAIL(XUSRTN) 66 ; 67 ; If Provider Type is Facility/Group 68 S XUSRTN="XUSNPIX2NV",NVHEADR=" NPI EXTRACT TYPE 2 (NON VA)",NVTYPE="TYPE 2 (NVA)" 69 I $D(^TMP("XUSNPI",$J,2)) D I XUST G EXIT 70 . ; Check to see if report is in use 71 . L +^XTMP(XUSRTN):5 I '$T S XUST=1 Q 72 . D INIT(XUSRTN) 73 . D INST(XUSRTN) 74 . D TYPE2^XUSNPIX4 75 . D EMAIL(XUSRTN) 76 . D VMAIL(XUSRTN) 77 . ; Log Run Completion Time 78 . S $P(^XTMP(XUSRTN,0),U,6)=$H 79 . L -^XTMP(XUSRTN) 80 . ; 81 I '$D(^TMP("XUSNPI",$J,2)) D 82 . D INIT(XUSRTN) 83 . D INST(XUSRTN) 84 . S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_1_U_"Line Count: "_1_U_DTTM3_U_$G(XUSPROD)_XUSEOL 85 . S ^XTMP("XUSNPIXT","2NV")=1_U_0_U_DTTM3 86 . S ^TMP(XUSRTN,$J,2)="END OF FILE"_U_XUSEOL 87 . D EMAIL(XUSRTN),VMAIL(XUSRTN) 88 ; 89 EXIT ;Standard EXIT point 90 K ^TMP("XUSNPI",$J) 91 K XUSNV,P,LDTCMP,PTPMAIL,SITE,NVHEADR,NVTYPE,XUSEOL,DTTM3 92 K MAXSIZE,XUSHDR,XUSCNT,MSGCNT 93 ; 94 Q 95 ; 96 INIT(XUSRTN) ; check/init variables 97 N XUSDESC 98 ; Set end of line character 99 S XUSEOL="~~" 100 ; Set to 300000 for live 101 S MAXSIZE=300000 102 S DTTM3=$$HTE^XLFDT($H,"2") 103 ; 104 ;Reset Temporary Scratch Global 105 K ^TMP(XUSRTN) 106 S XUSDESC="NPI EXTRACT NON VA - Do Not Delete" 107 S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H 108 ; 109 I '$D(^TMP("XUSNPIXU",$J)) D BCBSID^XUSNPIXU 110 Q 111 ; 112 INST(XUSRTN) ;Pull station and Institution info 113 N INST,SINFO,DIC4 114 ; Pull site info 115 S SINFO=$$SITE^VASITE 116 ; Station Number 117 S SITE=$P(SINFO,U,3) 118 ; Institution 119 S INST=$P(SINFO,U) 120 ; 121 ; Get institution mailing address 122 I INST D 123 . S DIC4=$G(^DIC(4,INST,4)) 124 . S XUSNV(7)=$P(DIC4,U) 125 . S XUSNV(8)=$P(DIC4,U,2) 126 . S XUSNV(9)=$P(DIC4,U,3) 127 . S XUSNV(10)=$P(DIC4,U,4) 128 . I XUSNV(10) S XUSNV(10)=$P($G(^DIC(5,XUSNV(10),0)),U,2) 129 . S XUSNV(11)=$P(DIC4,U,5) 130 . S PTPMAIL=XUSNV(7)_U_XUSNV(8)_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11) 131 S XUSHDR="Station: "_SITE_U_XUSNV(9)_U_XUSNV(10)_U_XUSNV(11)_U_NVTYPE_U_XUSVER 132 Q 133 ; 134 EMAIL(XUSRTN) ; EMAIL THE MESSAGE 135 N XMY 136 ; Send email to designated recipient for live release 137 S XMY("XXX@Q-NPS.VA.GOV")="" 138 ;S XMY(DUZ)="" ;use for testing - remove before live 139 D ESEND 140 Q 141 ; 142 VMAIL(XUSRTN) ; Verification email 143 N TMP 144 S TMP=^TMP(XUSRTN,$J,1) 145 K ^TMP(XUSRTN,$J) 146 S ^TMP(XUSRTN,$J,1)=$P(TMP,U,1,4) 147 S ^TMP(XUSRTN,$J,2)="" 148 S ^TMP(XUSRTN,$J,3)=NVHEADR_" (FILE #355.93)" 149 S ^TMP(XUSRTN,$J,4)="" 150 S ^TMP(XUSRTN,$J,5)="Date/Time of Extract: "_$P(TMP,U,9) 151 S ^TMP(XUSRTN,$J,6)="" 152 S ^TMP(XUSRTN,$J,7)="Message number: "_$S(MSGCNT>0:MSGCNT,1:1)_" Total NPI records: "_(XUSCNT-2) 153 S ^TMP(XUSRTN,$J,8)="" 154 S ^TMP(XUSRTN,$J,9)="Programmer Notes: "_XUSVER_" - "_$P(TMP,U,10) 155 ; 156 ; Send verification email to local mail group and VA Outlook mail group 157 S XMY("G.NPI EXTRACT VERIFICATION")="" 158 D ESEND 159 K ^TMP(XUSRTN) 160 Q 161 ; 162 ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ 163 S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," 164 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") "_NVHEADR 165 D ^XMD 166 Q
Note:
See TracChangeset
for help on using the changeset viewer.
