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/XUSNPIX5.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/XUSNPIX5.m
r613 r623 1 XUSNPIX5 ;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 ; 29 EMAIL(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 ; 46 SMAIL(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 ; 92 ESEND 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 1 XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;01-OCT-06 2 ;;8.0;KERNEL;**453**; Jul 10, 1995;Build 36 3 ;;Per VHA Directive 10-93-142, 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 ; 29 EMAIL(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 ;S XMY(DUZ)="" ;use for testing - remove before live 44 D ESEND 45 Q 46 ; 47 VMAIL(XUSRTN) ; Verification email 48 N TMP 49 S TMP=^TMP(XUSRTN,$J,1) 50 K ^TMP(XUSRTN,$J) 51 S ^TMP(XUSRTN,$J,1)=$P(TMP,U,1,4) 52 S ^TMP(XUSRTN,$J,2)="" 53 S ^TMP(XUSRTN,$J,3)="TYPE 1 : NEW PERSON FILE (#200)" 54 S ^TMP(XUSRTN,$J,4)="" 55 S ^TMP(XUSRTN,$J,5)="Date/Time of Extract: "_$P(TMP,U,9) 56 S ^TMP(XUSRTN,$J,6)="" 57 S ^TMP(XUSRTN,$J,7)="Message number: "_MSGCNT_" Total NPI records: "_(COUNT-2) 58 S ^TMP(XUSRTN,$J,8)="" 59 S ^TMP(XUSRTN,$J,9)="Programmer Notes: "_XUSVER_" - "_$P(TMP,U,10) 60 ; 61 ; Send verification email to local mail group and VA Outlook mail group. 62 S XMY("G.NPI EXTRACT VERIFICATION")="" 63 D ESEND 64 K ^TMP(XUSRTN) 65 Q 66 ; 67 SMAIL(XUSRTN) ; Summary email 68 N TMP,T1,T2,T1NV,T2NV 69 K ^TMP(XUSRTN,$J) 70 S T1=$G(^XTMP(XUSRTN,1)) 71 S T2=$G(^XTMP(XUSRTN,2)) 72 S T1NV=$G(^XTMP(XUSRTN,"1NV")) 73 S T2NV=$G(^XTMP(XUSRTN,"2NV")) 74 S ^TMP(XUSRTN,$J,1)=^XTMP(XUSRTN,"H")_" - SUMMARY for "_DTTM 75 S ^TMP(XUSRTN,$J,2)="" 76 S ^TMP(XUSRTN,$J,3)="NEW PERSON FILE (#200) "_+$P(T1,U)_" Message(s) Totaling "_+$P(T1,U,2)_" NPI records." 77 S ^TMP(XUSRTN,$J,4)="" 78 S ^TMP(XUSRTN,$J,5)="INSITUTION FILE (#4) "_+$P(T2,U)_" Message(s) Totaling "_+$P(T2,U,2)_" NPI records." 79 S ^TMP(XUSRTN,$J,6)="" 80 S ^TMP(XUSRTN,$J,7)="NON VA Individual (#355.93) "_+$P(T1NV,U)_" Message(s) Totaling "_+$P(T1NV,U,2)_" NPI records." 81 S ^TMP(XUSRTN,$J,8)="" 82 S ^TMP(XUSRTN,$J,9)="NON VA Facility/Group (#355.93) "_+$P(T2NV,U)_" Message(s) Totaling "_+$P(T2NV,U,2)_" NPI records." 83 S ^TMP(XUSRTN,$J,10)="" 84 S ^TMP(XUSRTN,$J,11)="Programmer Notes: "_XUSVER_" - "_$G(XUSPROD) 85 ; 86 ; Send verification email to local mail group and VA Outlook mail group 87 S XMY("G.NPI EXTRACT VERIFICATION")="" 88 N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ 89 S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," 90 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT SUMMARY " 91 D ^XMD 92 Q 93 K ^TMP(XUSRTN) 94 Q 95 ; 96 ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ 97 S XMTEXT="^TMP("""_XUSRTN_""","_$J_"," 98 S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 1 " 99 D ^XMD 100 Q
Note:
See TracChangeset
for help on using the changeset viewer.
