Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSNPIX5

XUSNPIX5.m

Go to the documentation of this file.
  1. XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:45
  1. ;;8.0;KERNEL;**453,481,548**; Jul 10, 1995;Build 24
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; NPI Extract Report Mailer routine
  1. ;
  1. ; Input parameter: XUSRTN
  1. ;
  1. ; Other relevant variables:
  1. ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
  1. ; storage subscript)
  1. ; Storage Global:
  1. ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
  1. ; where:
  1. ; Piece 1 => Purge Date - 1 year in future
  1. ; Piece 2 => Create Date - Today
  1. ; Piece 3 => Description
  1. ; Piece 4 => Last Date Compiled
  1. ; Piece 5 => $H last run start time
  1. ; Piece 6 => $H last run completion time
  1. ;
  1. ; ^XTMP("XUSNPIX1",1) = DATA
  1. ;
  1. ; XUSNPI => Unique NPI of entry
  1. ; LDT => Last Date Run, VA Fileman Format
  1. ;
  1. Q
  1. ;
  1. EMAIL(XUSRTN) ; EMAIL THE MESSAGE
  1. ; Add domain name if it does not exist
  1. N XUSFOC,DLAYGO,DA,DIC,DIE,DR,X,Y
  1. I '$$FIND1^DIC(4.2,,"QX","Q-NPS.DOMAIN.EXT","B") D
  1. . S XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",0)) I 'XUSFOC Q
  1. . I XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",""),-1) D
  1. . . S DIC="^DIC(4.2,",X="Q-NPS.DOMAIN.EXT",DIC(0)="L",DLAYGO=4.2 D ^DIC K DLAYGO
  1. . . S DIE=DIC,DA=+Y
  1. . . S DR="1///NS;2///^S X=XUSFOC;1.7///YES;6.2///NPS;"
  1. . . D ^DIE
  1. ;
  1. N XMY
  1. ; Send email to designated recipient for live release
  1. D MAILTO^XUSNPIX1(.XMY) ;p548
  1. D ESEND
  1. Q
  1. ;
  1. SMAIL(XUSRTN,XUSPROD,XUSVER,DTTM) ; Summary email
  1. N HYPHEN,L,M,N,T,TMP,T1,T2,T1NV,T2NV,XMY
  1. K ^TMP(XUSRTN,$J)
  1. S T1=$G(^XTMP(XUSRTN,1))
  1. S T2=$G(^XTMP(XUSRTN,2))
  1. S T1NV=$G(^XTMP(XUSRTN,"1NV"))
  1. S T2NV=$G(^XTMP(XUSRTN,"2NV"))
  1. S ^TMP(XUSRTN,$J,1)="SUMMARY"
  1. S ^TMP(XUSRTN,$J,2)="-------"
  1. S ^TMP(XUSRTN,$J,3)=^XTMP(XUSRTN,"H")_" "_DTTM
  1. S ^TMP(XUSRTN,$J,4)=""
  1. 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."
  1. 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."
  1. 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."
  1. 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."
  1. S ^TMP(XUSRTN,$J,9)=""
  1. S ^TMP(XUSRTN,$J,10)="Programmer Notes: "_XUSVER_" - "_$G(XUSPROD)
  1. ;
  1. ;Summary Detail
  1. ;
  1. S HYPHEN="",$P(HYPHEN,"-",84)="-"
  1. ;
  1. S ^TMP(XUSRTN,$J,11)=""
  1. S ^TMP(XUSRTN,$J,12)=HYPHEN
  1. S ^TMP(XUSRTN,$J,13)=""
  1. S ^TMP(XUSRTN,$J,14)="MESSAGE DETAILS"
  1. S ^TMP(XUSRTN,$J,15)="---------------"
  1. S ^TMP(XUSRTN,$J,16)=""
  1. S ^TMP(XUSRTN,$J,17)="TYPE "_$J("MESSAGE NUMBER",20)_$J("RECORD COUNT",20)
  1. S ^TMP(XUSRTN,$J,18)="----------"_$J("--------------",20)_$J("------------",20)
  1. ;
  1. 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
  1. .S N=$G(^TMP("XUSNPIXS",$J,T,M))
  1. .S L=L+1
  1. .S ^TMP(XUSRTN,$J,L)=$E($P(N,U)_" ",1,10)_$J(M,16)_$J($P(N,U,2),24)
  1. S L=L+1,^TMP(XUSRTN,$J,L)=""
  1. S L=L+1,^TMP(XUSRTN,$J,L)=HYPHEN
  1. ; Send verification email to local mail group and VA Outlook mail group
  1. S XMY("G.NPI EXTRACT VERIFICATION")=""
  1. N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
  1. S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
  1. S XMSUB=$TR($P(^XTMP(XUSRTN,"H"),U),":")_"("_$G(XUSPROD)_") NPI CROSSWALK EXTRACT SUMMARY "
  1. D ^XMD
  1. K ^TMP(XUSRTN,$J)
  1. Q
  1. ;
  1. ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
  1. S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
  1. S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 1 "
  1. D ^XMD
  1. Q