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

XUSNPIX1.m

Go to the documentation of this file.
  1. XUSNPIX1 ;OAK_BP/CMW - NPI EXTRACT REPORT ; Aug 30, 2022@04:49:29
  1. ;;8.0;KERNEL;**438,452,453,481,528,548,774,689**; Jul 10, 1995;Build 113
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Direct access to ^IBE(350.9, fields .02, 1.05, 19;.02, 19;1.01, 19;1.02, 19;1.03, 19;,1.04, 19;1.05 authorized by
  1. ; Integration Agreement #4964.
  1. ;
  1. ;
  1. ; NPI Extract Report
  1. ;
  1. ; Input parameter: N/A
  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. ; Entry Point - TASKMAN => Run report in background using TASKMAN
  1. ;
  1. Q
  1. ;
  1. TASKMAN ;TASKMAN ENTRY POINT
  1. ; Process Report
  1. N XUSRTN,DTTM,XUSPROD,XUSVER,INSMAIL,XUSNP2P,XUSTMP
  1. ;
  1. ; Check for required variables
  1. I $G(U)=""!($G(DT)="") G EXIT
  1. S XUSRTN="XUSNPIX1"
  1. S DTTM=$$HTE^XLFDT($H,"2")
  1. ; Check to see if report is in use
  1. L +^XTMP(XUSRTN):5 I '$T G EXIT
  1. ;
  1. ;Reset Summary Scratch Globals
  1. K ^TMP("XUSNPIXS",$J)
  1. K ^TMP("XUSNPIXT",$J)
  1. ;
  1. ; Initialize variables
  1. D INIT(XUSRTN)
  1. ;
  1. ; Pull Station(Institution) data
  1. D INST(XUSRTN,XUSVER,.INSMAIL)
  1. ;
  1. ;Process New Person File
  1. D PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL)
  1. ;
  1. ; Process Institution File
  1. D ENT^XUSNPIX2(XUSPROD,XUSVER)
  1. ;
  1. ; Process Non VA File
  1. D ENT^XUSNPIX3(XUSPROD,XUSVER)
  1. ;
  1. ; Send summary message
  1. D SMAIL^XUSNPIX5("XUSNPIXT",XUSPROD,XUSVER,DTTM)
  1. ;
  1. ;Standard EXIT point
  1. EXIT ;
  1. K DTTM,XUSVER,XUSHDR,XUSPROD,INSMAIL
  1. ;
  1. ;Kill off Scratch Globals
  1. K ^TMP("XUSNPIXS",$J)
  1. K ^TMP("XUSNPIXT",$J)
  1. K ^TMP("XUSNPIXU",$J)
  1. K ^TMP("P2P")
  1. ; Log Run Completion Time
  1. S $P(^XTMP(XUSRTN,0),U,6)=$H
  1. L -^XTMP(XUSRTN)
  1. ;
  1. Q
  1. ;
  1. INIT(XUSRTN) ; check/init variables
  1. N XUSDESC,IBSIEN,ZN19,P2PVAL
  1. ; Set to NEXT release version from NPM
  1. ; Update the build number here.
  1. S XUSVER="548.14" ; last patch to update the structure of the data extract (XU*8.0*548)
  1. ;
  1. ; Get production/test account flag
  1. S XUSPROD=$S($$PROD^XUPROD(1):"PROD",1:"TEST")
  1. ;
  1. ; Reset Temporary Scratch Global
  1. D INIT^XUSNPIXU
  1. K ^TMP(XUSRTN)
  1. S XUSDESC="NPI EXTRACT TYPE 1 - Do Not Delete"
  1. S ^XTMP(XUSRTN,0)=(DT+10000)_U_DT_U_XUSDESC_U_DT_U_$H
  1. ; Generate TMP BCBS Array
  1. D BCBSID^XUSNPIXU
  1. D P2PBASE^XUSNPIXU(.XUSTMP) ;XUSTMP array used for Type 1 and 2 VA
  1. Q
  1. ;
  1. MAILTO(XMY) ;sets the MailMan recipients based on need (XU*8.0*548)
  1. ;
  1. ;When you don't want data to go out to Austin's FSC but you need it to
  1. ;stay within the VistA's MailMan for internal testing, comment out setting
  1. ;the XMY("XXX@Q-NPS.DOMAIN.EXT) array and add your own MailMan address that
  1. ;is present in the VistA account your are on.
  1. ;When you want data to go out to Austin's FSC group, uncomment this line.
  1. ;S XMY("XXX@Q-NPS.DOMAIN.EXT")="" ;uncomment to run for live ***
  1. S XUWHO606=$G(XUWHO606,"XXX@Q-NPS.DOMAIN.EXT") ;p774
  1. S XMY(XUWHO606)=""
  1. Q
  1. ;
  1. INST(XUSRTN,XUSVER,INSMAIL) ;Pull station and Institution info
  1. N INST,SINFO,DIC4
  1. ; Pull site info
  1. S SINFO=$$SITE^VASITE
  1. ; Station Number
  1. S SITE=$P(SINFO,U,3)
  1. ; Institution
  1. S INST=$P(SINFO,U)
  1. ;
  1. ; Get institution mailing address
  1. I INST D
  1. . S DIC4=$G(^DIC(4,INST,4))
  1. . S XUSNP(7)=$P(DIC4,U)
  1. . S XUSNP(8)=$P(DIC4,U,2)
  1. . S XUSNP(9)=$P(DIC4,U,3)
  1. . S XUSNP(10)=$P(DIC4,U,4)
  1. . I XUSNP(10) S XUSNP(10)=$P($G(^DIC(5,XUSNP(10),0)),U,2)
  1. . S XUSNP(11)=$P(DIC4,U,5)
  1. . S INSMAIL=XUSNP(7)_U_XUSNP(8)_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)
  1. S XUSHDR="Station: "_SITE_U_XUSNP(9)_U_XUSNP(10)_U_XUSNP(11)_U_"TYPE 1"_U_XUSVER
  1. ;
  1. Q
  1. ;
  1. PROC1(XUSRTN,XUSPROD,XUSVER,DTTM,INSMAIL) ;Process all New Person records
  1. N XUSNPI,XUSDT,XUSNEW,XUSI,XUSDATA,XUSVA0,XUSVA0,XUSVA1,XUSNAME,XUSDOB,XUSDIV,XUSSTL,XUSSTLN,XUSOPN
  1. N XUSPER,XUSSPC,XUSTAX,XUSTAXID,XUSIZE,NPIEN,DIC4,SPDIV,VA12,VA13,COUNT,MSGCNT,MAXSIZE,TOTREC,XUSEOL
  1. N FND,XUSUSCT,XUSUSC1,I
  1. ;
  1. ; Set to 300000 for live
  1. S MAXSIZE=300000
  1. ;
  1. ; Set end of line character
  1. S XUSEOL="~~"
  1. ;
  1. ; set counter
  1. S COUNT=1,(TOTREC,MSGCNT,XUSIZE)=0
  1. ;
  1. ; Loop through NEW PERSON NPI records NPI cross ref
  1. S XUSNPI=0
  1. F S XUSNPI=$O(^VA(200,"ANPI",XUSNPI)) Q:'XUSNPI D
  1. . S NPIEN=$O(^VA(200,"ANPI",XUSNPI,""))
  1. . ;
  1. . ; Init columns
  1. . ;F XUSI=1:1:29 S XUSNP(XUSI)=""
  1. . F XUSI=1:1:33 S XUSNP(XUSI)=""
  1. . S XUSNP(1)=XUSNPI S XUSDATA1=XUSNP(1)
  1. . ;
  1. . S XUSVA0=$G(^VA(200,NPIEN,0))
  1. . S XUSVA1=$G(^VA(200,NPIEN,1))
  1. . S XUSNAME=$P(XUSVA0,U)
  1. . ;
  1. . ; Break name into components
  1. . I XUSNAME'="" D
  1. . . S XLFNC=XUSNAME D FORMAT^XLFNAME7(.XLFNC,,,,0)
  1. . . I $G(XLFNC("FAMILY"))="" S XLFNC("FAMILY")=$G(XUSNAME) ;p774
  1. . . S XUSNP(2)=$G(XLFNC("GIVEN")),XUSNP(3)=$G(XLFNC("MIDDLE")),XUSNP(4)=$G(XLFNC("FAMILY")) ;p774
  1. . . I $G(XLFNC("SUFFIX"))'="" S XUSNP(4)=XUSNP(4)_" "_XLFNC("SUFFIX")
  1. . . K XLFNC
  1. . S XUSDATA1=XUSDATA1_U_XUSNP(2)_U_XUSNP(3)_U_XUSNP(4)
  1. . ;
  1. . S XUSNP(5)=1 ;type
  1. . S XUSDOB=$P(XUSVA1,U,3)
  1. . ; dob formatted as mm/dd/yyyy
  1. . I XUSDOB D
  1. . . S XUSNP(6)=$$FMTE^XLFDT(XUSDOB,5)
  1. . S XUSDATA1=XUSDATA1_U_XUSNP(5)_U_XUSNP(6)
  1. . ;
  1. . ; Office Phone number
  1. . S XUSOPN=$P($G(^VA(200,NPIEN,.13)),U,2)
  1. . ;I XUSOPN'="" S XUSNP(17)=XUSOPN
  1. . I XUSOPN'="" S XUSNP(18)=XUSOPN
  1. . ;
  1. . ; Servicing Provider Address
  1. . S (XUSDIV)=0
  1. . ; Loop through Division multiple
  1. . F S XUSDIV=$O(^VA(200,NPIEN,2,XUSDIV)) Q:'XUSDIV D
  1. . . S DIC4=$G(^DIC(4,XUSDIV,4))
  1. . . S XUSNP(13)=$P(DIC4,U)
  1. . . S XUSNP(14)=$P(DIC4,U,2)
  1. . . S XUSNP(15)=$P(DIC4,U,3)
  1. . . S XUSNP(16)=$P(DIC4,U,4)
  1. . . I XUSNP(16) S XUSNP(16)=$P($G(^DIC(5,XUSNP(16),0)),U,2)
  1. . . S XUSNP(17)=$P(DIC4,U,5)
  1. . . S XUSSTA(XUSDIV)=$P($G(^DIC(4,XUSDIV,99)),U)
  1. . . S SPADR(XUSDIV)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
  1. . ;
  1. . ; If no divisions found
  1. . I '$D(SPADR) D
  1. . . S XUSSTA(9999)="N/A",SPADR(9999)=XUSNP(13)_U_XUSNP(14)_U_XUSNP(15)_U_XUSNP(16)_U_XUSNP(17)_U_XUSNP(18)
  1. . ;
  1. . ; Degree
  1. . S XUSNP(19)=$P($G(^VA(200,NPIEN,3.1)),U,6)
  1. . ; Degree Code (place holder, currently empty)
  1. . S XUSNP(20)=""
  1. . ;
  1. . ; get primary specialty
  1. . S XUSPER=0
  1. . F S XUSPER=$O(^VA(200,NPIEN,"USC1","B",XUSPER)) Q:'XUSPER D
  1. . . S XUSSPC=$P($G(^USC(8932.1,XUSPER,0)),U,9)
  1. . . ;S XUSTAX=$P($G(^USC(8932.1,XUSPER,0)),U,7)
  1. . . I XUSSPC'="" D
  1. . . . ;I XUSNP(20)="" S XUSNP(20)=XUSSPC Q
  1. . . . ;S XUSNP(20)=XUSNP(20)_";"_XUSSPC
  1. . . . I XUSNP(21)="" S XUSNP(21)=XUSSPC Q
  1. . . . S XUSNP(21)=XUSNP(21)_";"_XUSSPC
  1. . . . Q
  1. . . Q
  1. . ;get taxonomy (primary and all secondaries)
  1. . N XUSCLASS,XUSEXPDT ; ptr to Person class, expiration date
  1. . S XUSPER=0
  1. . K ^XTMP("USC1",$J)
  1. . F S XUSPER=$O(^VA(200,NPIEN,"USC1","AD",XUSPER)) Q:'XUSPER D
  1. . . S XUSUSC1=""
  1. . . F S XUSUSC1=$O(^VA(200,NPIEN,"USC1","AD",XUSPER,XUSUSC1)) Q:XUSUSC1="" D
  1. . . . S XUSCLASS=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U),XUSEXPDT=$P($G(^VA(200,NPIEN,"USC1",XUSUSC1,0)),U,3)
  1. . . . S ^XTMP("USC1",$J,XUSUSC1)=XUSEXPDT_U_XUSCLASS
  1. . . . Q
  1. . . Q
  1. . ;find primary taxonomy code
  1. . S XUSUSC1="",FND=0,XUSUSCT=""
  1. . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1),-1) Q:XUSUSC1=""!(FND=1) D
  1. . . I $P($G(^XTMP("USC1",$J,XUSUSC1)),U)'="" Q ; not active, expiration dt exists
  1. . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2)
  1. . . I XUSCLASS="" Q
  1. . . S XUSNP(22)=$P($G(^USC(8932.1,XUSCLASS,0)),U,7),FND=1,XUSUSCT=XUSUSC1
  1. . . Q
  1. . I $D(^XTMP("USC1",$J))&$G(XUSUSCT) K ^XTMP("USC1",$J,XUSUSCT) ;remove the active taxonomy code
  1. . S XUSUSC1=""
  1. . F S XUSUSC1=$O(^XTMP("USC1",$J,XUSUSC1)) Q:XUSUSC1="" D
  1. . . S XUSCLASS=$P($G(^XTMP("USC1",$J,XUSUSC1)),U,2)
  1. . . I XUSCLASS="" Q
  1. . . S XUSTAX=$P($G(^USC(8932.1,XUSCLASS,0)),U,7)
  1. . . I XUSTAX'="" D
  1. . . . ;
  1. . . . I XUSNP(23)="" S XUSNP(23)=XUSTAX Q
  1. . . . ;
  1. . . . ; *** Start ^XU*8.0*548 - RBN ***
  1. . . . ;
  1. . . . ;S XUSNP(23)=XUSNP(23)_";"_XUSTAX
  1. . . . S:(XUSNP(23)'[XUSTAX&(XUSTAX'=XUSNP(22))) XUSNP(23)=XUSNP(23)_";"_XUSTAX
  1. . . . ;
  1. . . . ; *** End ^XU*8.0*548 - RBN ***
  1. . . . ;
  1. . ;
  1. . ; Tax ID
  1. . S XUSTAXID=$P($G(^VA(200,NPIEN,"TPB")),U,2)
  1. . I XUSTAXID="" S XUSTAXID=$P($G(^VA(200,NPIEN,1)),U,9)
  1. . ;S XUSNP(22)=XUSTAXID
  1. . S XUSNP(24)=XUSTAXID
  1. . ;
  1. . ;S XUSDATA2=XUSNP(17)_U_XUSNP(18)_U_XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)
  1. . S XUSDATA2=XUSNP(19)_U_XUSNP(20)_U_XUSNP(21)_U_XUSNP(22)_U_XUSNP(23)_U_XUSNP(24)
  1. . ;
  1. . ; Medicare Part A/B
  1. . ;S XUSNP(23)=670899
  1. . ;S XUSNP(24)="VA"_$E(SITE+10000,2,5)
  1. . S XUSNP(25)=670899
  1. . S XUSNP(26)="VA"_$E(SITE+10000,2,5)
  1. . ;
  1. . ; State License
  1. . S XUSSTL=0
  1. . F S XUSSTL=$O(^VA(200,NPIEN,"PS1",XUSSTL)) Q:'XUSSTL D
  1. . . S XUSSTLN=$P($G(^VA(200,NPIEN,"PS1",XUSSTL,0)),U,2)
  1. . . I XUSSTLN'="" D
  1. . . . ;I XUSNP(25)="" S XUSNP(25)=XUSSTLN Q
  1. . . . ;S XUSNP(25)=XUSNP(25)_";"_XUSSTLN
  1. . . . I XUSNP(27)="" S XUSNP(27)=XUSSTLN Q
  1. . . . ;S XUSNP(27)=XUSNP(27)_";"_XUSSTLN
  1. . ;S XUSNP(28)=$P($G(^VA(200,NPIEN,"PS")),U,2)
  1. . ; *689 - DEA #
  1. . S XUSNP(28)=$$PRDEA^XUSER(NPIEN)
  1. . ;
  1. . ;S XUSDATA2=XUSDATA2_U_XUSNP(23)_U_XUSNP(24)_U_XUSNP(25)_U_XUSNP(26)
  1. . S XUSDATA2=XUSDATA2_U_XUSNP(25)_U_XUSNP(26)_U_XUSNP(27)_U_XUSNP(28)
  1. . ;
  1. . ; Add logic for STATUS and CREATION/TERMINATION DATE from file #200
  1. . S XUSNP(29)="",XUSNP(30)=""
  1. . S XUSNP(29)=$P($G(^VA(200,NPIEN,0)),U,11)
  1. . I $G(XUSNP(29))'="" S XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="TERMINATED"
  1. . I $G(XUSNP(29))="" S XUSNP(29)=$P($G(^VA(200,NPIEN,1)),U,7),XUSNP(30)=$$FMTE^XLFDT(XUSNP(29),5),XUSNP(29)="ACTIVE"
  1. . ;
  1. . S XUSDATA2=XUSDATA2_U_XUSNP(29)_U_XUSNP(30)
  1. . ;
  1. . ; Get BCBS Payer ID Array
  1. . K XUSBXID
  1. . D PRACID^XUSNPIXU(NPIEN,.XUSBXID)
  1. . ;
  1. . ; Save entry to ^TMP and update count
  1. . N XUSB,XUSB1
  1. . S XUSDIV=0
  1. . F S XUSDIV=$O(SPADR(XUSDIV)) Q:'XUSDIV D
  1. . . ;
  1. . . ; Pay to Provider Address NP7-12
  1. . . I $D(XUSTMP("P2P",XUSDIV)) D
  1. . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),0)),U,2)
  1. . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,1)
  1. . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,2)
  1. . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,3)
  1. . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,4)
  1. . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2)
  1. . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,$G(XUSTMP("P2P",XUSDIV)),1)),U,5)
  1. . . . Q
  1. . . I '$D(XUSTMP("P2P",XUSDIV)) D
  1. . . . I '$D(XUSTMP("P2P","DEFAULT")) D Q
  1. . . . . F I=7:1:12 S $P(XUSDATA1,U,I)=""
  1. . . . N XUSDEF
  1. . . . S XUSDEF=$G(XUSTMP("P2P","DEFAULT"))
  1. . . . S $P(XUSDATA1,U,7)=$P($G(^IBE(350.9,1,19,XUSDEF,0)),U,2)
  1. . . . S $P(XUSDATA1,U,8)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,1)
  1. . . . S $P(XUSDATA1,U,9)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,2)
  1. . . . S $P(XUSDATA1,U,10)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,3)
  1. . . . S $P(XUSDATA1,U,11)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,4)
  1. . . . I $P(XUSDATA1,U,11)?1N.N S $P(XUSDATA1,U,11)=$P($G(^DIC(5,$P(XUSDATA1,U,11),0)),U,2)
  1. . . . S $P(XUSDATA1,U,12)=$P($G(^IBE(350.9,1,19,XUSDEF,1)),U,5)
  1. . . . Q
  1. . . ;
  1. . . S COUNT=COUNT+1,TOTREC=TOTREC+1
  1. . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_XUSEOL
  1. . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
  1. . . ; Check BCBS Id array
  1. . . I $D(XUSBXID) D
  1. . . . S XUSB=""
  1. . . . F S XUSB=$O(XUSBXID(XUSB)) Q:XUSB="" D
  1. . . . . S XUSB1=$G(XUSBXID(XUSB)) I XUSB1'="" S XUSB1="^"_XUSB1 ;add p528
  1. . . . . S COUNT=COUNT+1,TOTREC=TOTREC+1
  1. . . . . S ^TMP(XUSRTN,$J,COUNT)=XUSDATA1_U_SPADR(XUSDIV)_U_XUSDATA2_U_XUSSTA(XUSDIV)_U_$$TRIM^XLFSTR(XUSB)_XUSB1_U_XUSEOL ;add _XUSB1 p 528
  1. . . . . S XUSIZE=XUSIZE+$L(^TMP(XUSRTN,$J,COUNT))
  1. . K XUSNP,XUSDATA1,XUSDATA2,XUSDATA3,SPADR,XUSBXID,CNT,XUSSTA
  1. . I XUSIZE>MAXSIZE D
  1. . . D EOF(XUSRTN)
  1. . . D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan
  1. . . K ^TMP(XUSRTN,$J)
  1. . . S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2)
  1. . . S ^TMP(XUSRTN,$J,1)=XUSHDR
  1. . . S COUNT=1,XUSIZE=0
  1. D EOF(XUSRTN)
  1. ;
  1. ; Send the last message (if it has records)
  1. I $G(COUNT)>1 D
  1. .D EMAIL^XUSNPIX5(XUSRTN) ;transmitting extract data via MailMan
  1. .K ^TMP(XUSRTN,$J)
  1. .S ^TMP("XUSNPIXS",$J,1,MSGCNT)="1^"_(COUNT-2)
  1. ;
  1. ; Set summary totals
  1. S ^XTMP("XUSNPIXT",0)=(DT+10000)_U_DT_U_"NPI EXTRACT SUMMARY TOTALS"_U_DT_U_$H
  1. S ^XTMP("XUSNPIXT","H")=$P(XUSHDR,U,1,4)
  1. S ^XTMP("XUSNPIXT",1)=MSGCNT_U_TOTREC_U_DTTM
  1. K INSMAIL,SITE
  1. Q
  1. ;
  1. EOF(XUSRTN) ;
  1. Q:COUNT=1
  1. S MSGCNT=MSGCNT+1
  1. S ^TMP(XUSRTN,$J,1)=XUSHDR_U_"Message Number: "_MSGCNT_U_"Line Count: "_COUNT_U_DTTM_U_$G(XUSPROD)_U_XUSEOL
  1. S COUNT=COUNT+1
  1. S ^TMP(XUSRTN,$J,COUNT)="END OF FILE"_U_XUSEOL
  1. Q