- 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 Feb 18, 2025@23:39:15 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