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/XUSNPIX5.m@ 613

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:45
2 ;;8.0;KERNEL;**453,481**; Jul 10, 1995;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; NPI Extract Report Mailer routine
6 ;
7 ; Input parameter: XUSRTN
8 ;
9 ; Other relevant variables:
10 ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
11 ; storage subscript)
12 ; Storage Global:
13 ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
14 ; where:
15 ; Piece 1 => Purge Date - 1 year in future
16 ; Piece 2 => Create Date - Today
17 ; Piece 3 => Description
18 ; Piece 4 => Last Date Compiled
19 ; Piece 5 => $H last run start time
20 ; Piece 6 => $H last run completion time
21 ;
22 ; ^XTMP("XUSNPIX1",1) = DATA
23 ;
24 ; XUSNPI => Unique NPI of entry
25 ; LDT => Last Date Run, VA Fileman Format
26 ;
27 Q
28 ;
29EMAIL(XUSRTN) ; EMAIL THE MESSAGE
30 ; Add domain name if it does not exist
31 N XUSFOC,DLAYGO,DA,DIC,DIE,DR,X,Y
32 I '$$FIND1^DIC(4.2,,"QX","Q-NPS.VA.GOV","B") D
33 . S XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.VA.GOV",0)) I 'XUSFOC Q
34 . I XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.VA.GOV",""),-1) D
35 . . S DIC="^DIC(4.2,",X="Q-NPS.VA.GOV",DIC(0)="L",DLAYGO=4.2 D ^DIC K DLAYGO
36 . . S DIE=DIC,DA=+Y
37 . . S DR="1///NS;2///^S X=XUSFOC;1.7///YES;6.2///NPS;"
38 . . D ^DIE
39 ;
40 N XMY
41 ; Send email to designated recipient for live release
42 S XMY("XXX@Q-NPS.VA.GOV")=""
43 D ESEND
44 Q
45 ;
46SMAIL(XUSRTN,XUSPROD,XUSVER,DTTM) ; Summary email
47 N HYPHEN,L,M,N,T,TMP,T1,T2,T1NV,T2NV,XMY
48 K ^TMP(XUSRTN,$J)
49 S T1=$G(^XTMP(XUSRTN,1))
50 S T2=$G(^XTMP(XUSRTN,2))
51 S T1NV=$G(^XTMP(XUSRTN,"1NV"))
52 S T2NV=$G(^XTMP(XUSRTN,"2NV"))
53 S ^TMP(XUSRTN,$J,1)="SUMMARY"
54 S ^TMP(XUSRTN,$J,2)="-------"
55 S ^TMP(XUSRTN,$J,3)=^XTMP(XUSRTN,"H")_" "_DTTM
56 S ^TMP(XUSRTN,$J,4)=""
57 S ^TMP(XUSRTN,$J,5)="Type 1 NEW PERSON FILE (#200) "_$J(+$P(T1,U),3)_" Message(s) Totaling "_$J(+$P(T1,U,2),7)_" NPI records."
58 S ^TMP(XUSRTN,$J,6)="Type 2 INSITUTION FILE (#4) "_$J(+$P(T2,U),3)_" Message(s) Totaling "_$J(+$P(T2,U,2),7)_" NPI records."
59 S ^TMP(XUSRTN,$J,7)="Type 1 NON VA Individual (#355.93) "_$J(+$P(T1NV,U),3)_" Message(s) Totaling "_$J(+$P(T1NV,U,2),7)_" NPI records."
60 S ^TMP(XUSRTN,$J,8)="Type 2 NON VA Facility/Group (#355.93) "_$J(+$P(T2NV,U),3)_" Message(s) Totaling "_$J(+$P(T2NV,U,2),7)_" NPI records."
61 S ^TMP(XUSRTN,$J,9)=""
62 S ^TMP(XUSRTN,$J,10)="Programmer Notes: "_XUSVER_" - "_$G(XUSPROD)
63 ;
64 ;Summary Detail
65 ;
66 S HYPHEN="",$P(HYPHEN,"-",84)="-"
67 ;
68 S ^TMP(XUSRTN,$J,11)=""
69 S ^TMP(XUSRTN,$J,12)=HYPHEN
70 S ^TMP(XUSRTN,$J,13)=""
71 S ^TMP(XUSRTN,$J,14)="MESSAGE DETAILS"
72 S ^TMP(XUSRTN,$J,15)="---------------"
73 S ^TMP(XUSRTN,$J,16)=""
74 S ^TMP(XUSRTN,$J,17)="TYPE "_$J("MESSAGE NUMBER",20)_$J("RECORD COUNT",20)
75 S ^TMP(XUSRTN,$J,18)="----------"_$J("--------------",20)_$J("------------",20)
76 ;
77 S L=18,T="" F S T=$O(^TMP("XUSNPIXS",$J,T)) Q:'T S M=0 F S M=$O(^TMP("XUSNPIXS",$J,T,M)) Q:'M D
78 .S N=$G(^TMP("XUSNPIXS",$J,T,M))
79 .S L=L+1
80 .S ^TMP(XUSRTN,$J,L)=$E($P(N,U)_" ",1,10)_$J(M,16)_$J($P(N,U,2),24)
81 S L=L+1,^TMP(XUSRTN,$J,L)=""
82 S L=L+1,^TMP(XUSRTN,$J,L)=HYPHEN
83 ; Send verification email to local mail group and VA Outlook mail group
84 S XMY("G.NPI EXTRACT VERIFICATION")=""
85 N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
86 S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
87 S XMSUB=$TR($P(^XTMP(XUSRTN,"H"),U),":")_"("_$G(XUSPROD)_") NPI CROSSWALK EXTRACT SUMMARY "
88 D ^XMD
89 K ^TMP(XUSRTN,$J)
90 Q
91 ;
92ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
93 S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
94 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 1 "
95 D ^XMD
96 Q
Note: See TracBrowser for help on using the repository browser.