XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:45
;;8.0;KERNEL;**453,481,548**; Jul 10, 1995;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; NPI Extract Report Mailer routine
;
; Input parameter: XUSRTN
;
; Other relevant variables:
; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
; storage subscript)
; Storage Global:
; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
; where:
; Piece 1 => Purge Date - 1 year in future
; Piece 2 => Create Date - Today
; Piece 3 => Description
; Piece 4 => Last Date Compiled
; Piece 5 => $H last run start time
; Piece 6 => $H last run completion time
;
; ^XTMP("XUSNPIX1",1) = DATA
;
; XUSNPI => Unique NPI of entry
; LDT => Last Date Run, VA Fileman Format
;
Q
;
EMAIL(XUSRTN) ; EMAIL THE MESSAGE
; Add domain name if it does not exist
N XUSFOC,DLAYGO,DA,DIC,DIE,DR,X,Y
I '$$FIND1^DIC(4.2,,"QX","Q-NPS.DOMAIN.EXT","B") D
. S XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",0)) I 'XUSFOC Q
. I XUSFOC=$O(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",""),-1) D
. . S DIC="^DIC(4.2,",X="Q-NPS.DOMAIN.EXT",DIC(0)="L",DLAYGO=4.2 D ^DIC K DLAYGO
. . S DIE=DIC,DA=+Y
. . S DR="1///NS;2///^S X=XUSFOC;1.7///YES;6.2///NPS;"
. . D ^DIE
;
N XMY
; Send email to designated recipient for live release
D MAILTO^XUSNPIX1(.XMY) ;p548
D ESEND
Q
;
SMAIL(XUSRTN,XUSPROD,XUSVER,DTTM) ; Summary email
N HYPHEN,L,M,N,T,TMP,T1,T2,T1NV,T2NV,XMY
K ^TMP(XUSRTN,$J)
S T1=$G(^XTMP(XUSRTN,1))
S T2=$G(^XTMP(XUSRTN,2))
S T1NV=$G(^XTMP(XUSRTN,"1NV"))
S T2NV=$G(^XTMP(XUSRTN,"2NV"))
S ^TMP(XUSRTN,$J,1)="SUMMARY"
S ^TMP(XUSRTN,$J,2)="-------"
S ^TMP(XUSRTN,$J,3)=^XTMP(XUSRTN,"H")_" "_DTTM
S ^TMP(XUSRTN,$J,4)=""
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."
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."
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."
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."
S ^TMP(XUSRTN,$J,9)=""
S ^TMP(XUSRTN,$J,10)="Programmer Notes: "_XUSVER_" - "_$G(XUSPROD)
;
;Summary Detail
;
S HYPHEN="",$P(HYPHEN,"-",84)="-"
;
S ^TMP(XUSRTN,$J,11)=""
S ^TMP(XUSRTN,$J,12)=HYPHEN
S ^TMP(XUSRTN,$J,13)=""
S ^TMP(XUSRTN,$J,14)="MESSAGE DETAILS"
S ^TMP(XUSRTN,$J,15)="---------------"
S ^TMP(XUSRTN,$J,16)=""
S ^TMP(XUSRTN,$J,17)="TYPE "_$J("MESSAGE NUMBER",20)_$J("RECORD COUNT",20)
S ^TMP(XUSRTN,$J,18)="----------"_$J("--------------",20)_$J("------------",20)
;
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
.S N=$G(^TMP("XUSNPIXS",$J,T,M))
.S L=L+1
.S ^TMP(XUSRTN,$J,L)=$E($P(N,U)_" ",1,10)_$J(M,16)_$J($P(N,U,2),24)
S L=L+1,^TMP(XUSRTN,$J,L)=""
S L=L+1,^TMP(XUSRTN,$J,L)=HYPHEN
; Send verification email to local mail group and VA Outlook mail group
S XMY("G.NPI EXTRACT VERIFICATION")=""
N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
S XMSUB=$TR($P(^XTMP(XUSRTN,"H"),U),":")_"("_$G(XUSPROD)_") NPI CROSSWALK EXTRACT SUMMARY "
D ^XMD
K ^TMP(XUSRTN,$J)
Q
;
ESEND N XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
S XMTEXT="^TMP("""_XUSRTN_""","_$J_","
S XMSUB=$TR($P($G(^TMP(XUSRTN,$J,1)),U),":")_"("_$G(XUSPROD)_") NPI EXTRACT TYPE 1 "
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIX5 3798 printed Sep 23, 2025@19:49:03 Page 2
XUSNPIX5 ;OAK_BP/CMW - NPI EXTRACT REPORT ;7/7/08 17:45
+1 ;;8.0;KERNEL;**453,481,548**; Jul 10, 1995;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; NPI Extract Report Mailer routine
+5 ;
+6 ; Input parameter: XUSRTN
+7 ;
+8 ; Other relevant variables:
+9 ; XUSRTN="XUSNPIX1" (current routine name, used for ^XTMP and ^TMP
+10 ; storage subscript)
+11 ; Storage Global:
+12 ; ^XTMP("XUSNPIX1",0) = Piece 1^Piece 2^Piece 3^Piece 4^Piece 5^Piece 6
+13 ; where:
+14 ; Piece 1 => Purge Date - 1 year in future
+15 ; Piece 2 => Create Date - Today
+16 ; Piece 3 => Description
+17 ; Piece 4 => Last Date Compiled
+18 ; Piece 5 => $H last run start time
+19 ; Piece 6 => $H last run completion time
+20 ;
+21 ; ^XTMP("XUSNPIX1",1) = DATA
+22 ;
+23 ; XUSNPI => Unique NPI of entry
+24 ; LDT => Last Date Run, VA Fileman Format
+25 ;
+26 QUIT
+27 ;
EMAIL(XUSRTN) ; EMAIL THE MESSAGE
+1 ; Add domain name if it does not exist
+2 NEW XUSFOC,DLAYGO,DA,DIC,DIE,DR,X,Y
+3 IF '$$FIND1^DIC(4.2,,"QX","Q-NPS.DOMAIN.EXT","B")
Begin DoDot:1
+4 SET XUSFOC=$ORDER(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",0))
IF 'XUSFOC
QUIT
+5 IF XUSFOC=$ORDER(^DIC(4.2,"B","FOC-AUSTIN.DOMAIN.EXT",""),-1)
Begin DoDot:2
+6 SET DIC="^DIC(4.2,"
SET X="Q-NPS.DOMAIN.EXT"
SET DIC(0)="L"
SET DLAYGO=4.2
DO ^DIC
KILL DLAYGO
+7 SET DIE=DIC
SET DA=+Y
+8 SET DR="1///NS;2///^S X=XUSFOC;1.7///YES;6.2///NPS;"
+9 DO ^DIE
End DoDot:2
End DoDot:1
+10 ;
+11 NEW XMY
+12 ; Send email to designated recipient for live release
+13 ;p548
DO MAILTO^XUSNPIX1(.XMY)
+14 DO ESEND
+15 QUIT
+16 ;
SMAIL(XUSRTN,XUSPROD,XUSVER,DTTM) ; Summary email
+1 NEW HYPHEN,L,M,N,T,TMP,T1,T2,T1NV,T2NV,XMY
+2 KILL ^TMP(XUSRTN,$JOB)
+3 SET T1=$GET(^XTMP(XUSRTN,1))
+4 SET T2=$GET(^XTMP(XUSRTN,2))
+5 SET T1NV=$GET(^XTMP(XUSRTN,"1NV"))
+6 SET T2NV=$GET(^XTMP(XUSRTN,"2NV"))
+7 SET ^TMP(XUSRTN,$JOB,1)="SUMMARY"
+8 SET ^TMP(XUSRTN,$JOB,2)="-------"
+9 SET ^TMP(XUSRTN,$JOB,3)=^XTMP(XUSRTN,"H")_" "_DTTM
+10 SET ^TMP(XUSRTN,$JOB,4)=""
+11 SET ^TMP(XUSRTN,$JOB,5)="Type 1 NEW PERSON FILE (#200) "_$JUSTIFY(+$PIECE(T1,U),3)_" Message(s) Totaling "_$JUSTIFY(+$PIECE(T1,U,2),7)_" NPI records."
+12 SET ^TMP(XUSRTN,$JOB,6)="Type 2 INSITUTION FILE (#4) "_$JUSTIFY(+$PIECE(T2,U),3)_" Message(s) Totaling "_$JUSTIFY(+$PIECE(T2,U,2),7)_" NPI records."
+13 SET ^TMP(XUSRTN,$JOB,7)="Type 1 NON VA Individual (#355.93) "_$JUSTIFY(+$PIECE(T1NV,U),3)_" Message(s) Totaling "_$JUSTIFY(+$PIECE(T1NV,U,2),7)_" NPI records."
+14 SET ^TMP(XUSRTN,$JOB,8)="Type 2 NON VA Facility/Group (#355.93) "_$JUSTIFY(+$PIECE(T2NV,U),3)_" Message(s) Totaling "_$JUSTIFY(+$PIECE(T2NV,U,2),7)_" NPI records."
+15 SET ^TMP(XUSRTN,$JOB,9)=""
+16 SET ^TMP(XUSRTN,$JOB,10)="Programmer Notes: "_XUSVER_" - "_$GET(XUSPROD)
+17 ;
+18 ;Summary Detail
+19 ;
+20 SET HYPHEN=""
SET $PIECE(HYPHEN,"-",84)="-"
+21 ;
+22 SET ^TMP(XUSRTN,$JOB,11)=""
+23 SET ^TMP(XUSRTN,$JOB,12)=HYPHEN
+24 SET ^TMP(XUSRTN,$JOB,13)=""
+25 SET ^TMP(XUSRTN,$JOB,14)="MESSAGE DETAILS"
+26 SET ^TMP(XUSRTN,$JOB,15)="---------------"
+27 SET ^TMP(XUSRTN,$JOB,16)=""
+28 SET ^TMP(XUSRTN,$JOB,17)="TYPE "_$JUSTIFY("MESSAGE NUMBER",20)_$JUSTIFY("RECORD COUNT",20)
+29 SET ^TMP(XUSRTN,$JOB,18)="----------"_$JUSTIFY("--------------",20)_$JUSTIFY("------------",20)
+30 ;
+31 SET L=18
SET T=""
FOR
SET T=$ORDER(^TMP("XUSNPIXS",$JOB,T))
if 'T
QUIT
SET M=0
FOR
SET M=$ORDER(^TMP("XUSNPIXS",$JOB,T,M))
if 'M
QUIT
Begin DoDot:1
+32 SET N=$GET(^TMP("XUSNPIXS",$JOB,T,M))
+33 SET L=L+1
+34 SET ^TMP(XUSRTN,$JOB,L)=$EXTRACT($PIECE(N,U)_" ",1,10)_$JUSTIFY(M,16)_$JUSTIFY($PIECE(N,U,2),24)
End DoDot:1
+35 SET L=L+1
SET ^TMP(XUSRTN,$JOB,L)=""
+36 SET L=L+1
SET ^TMP(XUSRTN,$JOB,L)=HYPHEN
+37 ; Send verification email to local mail group and VA Outlook mail group
+38 SET XMY("G.NPI EXTRACT VERIFICATION")=""
+39 NEW XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
+40 SET XMTEXT="^TMP("""_XUSRTN_""","_$JOB_","
+41 SET XMSUB=$TRANSLATE($PIECE(^XTMP(XUSRTN,"H"),U),":")_"("_$GET(XUSPROD)_") NPI CROSSWALK EXTRACT SUMMARY "
+42 DO ^XMD
+43 KILL ^TMP(XUSRTN,$JOB)
+44 QUIT
+45 ;
ESEND NEW XMTEXT,XMSUB,XMDUN,XMDUZ,XMZ,XMMG,DIFROM
+1 SET XMTEXT="^TMP("""_XUSRTN_""","_$JOB_","
+2 SET XMSUB=$TRANSLATE($PIECE($GET(^TMP(XUSRTN,$JOB,1)),U),":")_"("_$GET(XUSPROD)_") NPI EXTRACT TYPE 1 "
+3 DO ^XMD
+4 QUIT
