source: 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@ 1800

Last change on this file since 1800 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 4.8 KB
RevLine 
[623]1XUSNPIX3 ;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 ;
27ENT ; 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 ;
89EXIT ;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 ;
96INIT(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 ;
112INST(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 ;
134EMAIL(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 ;
142VMAIL(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 ;
162ESEND 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 TracBrowser for help on using the repository browser.