- XUSNPIE3 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;4/8/08 18:18
- ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
- ;;Per VHA Directive 2004-038, this routine should not be modified
- ;
- Q
- ;
- EDITNPI(IEN) ; main entry of NPI value
- ; IEN is the internal entry number in file 200 for the provider
- ;
- N DATEVAL,DESCRIP,DONE,NPIVAL1,NPIVAL2,PROVNAME,I,XX,X,Y,CURRNPI,XUSFLAG
- N ODATEVAL,OIEN,OLDNPI,XUSNONED,DIR,ADDNPI,DELETNPI,NOOLDNPI,XUSQI,NPIUSEDX,XUSRSLT
- S ADDNPI=1,DELETNPI=2,NOOLDNPI=0
- S PROVNAME=$$GET1^DIQ(200,IEN_",",.01)
- ;I $$ACTIVE^XUSER(IEN) W !,"This user isn't currently active" Q
- I $$GETTAXON^XUSNPIED(IEN,.DESCRIP)=-1 W !,"This user doesn't have a Taxonomy Code indicating a need for an NPI." S XUSNONED=1 ; but don't quit on that
- I $$NPISTATS^XUSNPIED(IEN)="D" S XUSNONED=1
- I $$NPISTATS^XUSNPIED(IEN)="E" W !,"This provider has been indicated as being EXEMPT from needing an NPI value.",!," Use Exempt option to remove it first" Q
- ; OLDNPI indicates what user wants to do with the current NPI
- ; OLDNPI=0 - User has no current NPI, or user asks to delete current NPI and it's valid
- ; OLDNPI=1 - User asked to Replace current NPI
- ; OLDNPI=2 - User asked to delete current NPI, and it was entered in error.
- ; OLDNPI="NOEDITNPI" - User doesn't want to change current NPI in any way.
- S OLDNPI=NOOLDNPI
- ; Initialize flag indicating that current NPI is in use
- S NPIUSEDX=0
- ; If user already has an NPI, ask them what they want to do with it.
- I $$NPISTATS^XUSNPIED(IEN)="D" D Q:OLDNPI=NOOLDNPI ; Quit if no NPI, or delete Valid NPI
- . N I,X,DIR
- . S CURRNPI=$$GET1^DIQ(200,IEN_",",41.99) I CURRNPI="" Q
- . S OIEN=$$SRCHNPI^XUSNPI("^VA(200,",IEN,CURRNPI)
- . I OIEN>0 S ODATEVAL=$P(OIEN,U,2),OIEN=$O(^VA(200,IEN,"NPISTATUS","C",CURRNPI,"A"),-1)
- . I '$D(ODATEVAL) S OLDNPI=2 ; can't find entry in multiple, delete entry at top
- . W !,"This provider already has an NPI value (",CURRNPI,") entered."
- . ; Check whether current NPI is already being used. If so, issue a warning.
- . S NPIUSEDX=$$CHKNPIU(CURRNPI,IEN,2,.XUSRSLT)
- . S DIR(0)="SO^D:Delete;R:Replace"
- . S DIR("A")="Do you want to (D)elete or (R)eplace this NPI value?"
- . S DIR("?")="Enter D or R, ^ to quit or <Enter> to continue without editing NPI"
- . S DIR("?",1)="If this NPI was entered for the incorrect individual, or is no longer valid"
- . S DIR("?",2)="for this individual, enter DELETE. Otherwise, the NPI can be Replaced."
- . S DIR("?",3)=""
- . D ^DIR K DIR
- . Q:$D(DTOUT)
- . ; If user enters null, set OLDNPI to "NOEDITNPI" to indicate no change to NPI
- . S:Y="" OLDNPI="NOEDITNPI"
- . I Y'="D",Y'="R" Q
- . I Y="R" S OLDNPI=ADDNPI Q
- . ; Process request to DELETE NPI.
- . S DIR(0)="S^V:VALID;E:ERROR",DIR("A",1)="Was the original NPI (V)alid for this provider",DIR("A")="or was it entered in (E)rror?",DIR("?")="Enter either V or E or ^ to quit with out editing"
- . S DIR("?",1)="If the NPI value was entered for the incorrect individual, respond E,",DIR("?",2)="otherwise enter V"
- . D ^DIR K DIR
- . Q:"EV"'[Y
- . ; Process DELETE NPI that was Valid for this provider
- . I Y="V" D S OLDNPI=NOOLDNPI Q
- . . S Y=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,$$NOW^XLFDT(),0)
- . . W !,$S(Y>-1:"Entry has been marked inactive.",1:$P(Y,U,2)),!
- . . Q:+Y=-1
- . . N XUFDA
- . . S XUFDA(200,IEN_",",41.98)="@",XUFDA(200,IEN_",",41.99)="@"
- . . D FILE^DIE("","XUFDA") S Y=$$CHEKNPI^XUSNPIED(IEN)
- . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
- . . Q
- . S OLDNPI=DELETNPI
- . Q
- ; If user doesn't want to edit current NPI, quit.
- Q:OLDNPI="NOEDITNPI"
- ; If user is not a provider, and has no NPI, let them know.
- I $$CHEKNPI^XUSNPIED(IEN)=0,OLDNPI=0 W !,"Need for an NPI value isn't indicated - but you can enter an NPI",$C(7)
- I IEN'=DUZ D
- . W !,"Provider: ",PROVNAME," ","XXX-XX-"_$E($$GET1^DIQ(200,IEN_",",9),6,9)," DOB: "
- . S XX=$P($G(^VA(200,IEN,1)),U,3) S:XX'="" XX=$$DATE10^XUSNPIED(XX) W XX Q
- ; Initialize DONE to 0. It will be set to 1 if a new NPI is entered.
- S DONE=0
- ; Allow user to add a new or replacement NPI.
- I OLDNPI'=DELETNPI F R !,"Enter NPI (10 digits): ",NPIVAL1:DTIME Q:'$T Q:NPIVAL1="" Q:NPIVAL1=U D Q:DONE
- . I NPIVAL1'?10N D Q
- . . W !,$C(7),"Enter a 10 digit National Provider Identifier which is obtained ",!,"from 'https://nppes.cms.hhs.gov/NPPES/Welcome.do'"
- . . Q:$$PROD^XUPROD() W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to generate a test NPI value" D ^DIR Q:'Y
- . . R !,"Enter a nine (9) digit number as the base: ",Y:DTIME Q:Y'?9N
- . . W !,"The complete NPI value is: ",Y_$$CKDIGIT^XUSNPI(Y),!
- . . Q
- . S NPIUSED=$$CHKNPIU(NPIVAL1,IEN,3)
- . ; Quit if error
- . Q:NPIUSED=1
- . ; If warning, see whether they want to continue
- . I NPIUSED=2 D Q:Y'="Y"
- . . K DIR,Y,X
- . . S DIR(0)="SA^Y:yes;N:no",DIR("B")="N"
- . . S DIR("A")="Do you still want to add this NPI to Provider "_PROVNAME_"? "
- . . S DIR("?")="If you answer YES, make sure both the non-VA and VA Provider are the same person."
- . . S DIR("?",1)="A provider can serve as both a VA and a non-VA provider."
- . . S DIR("?",2)="That is the only case where the same NPI can be assigned to a person"
- . . S DIR("?",3)="in both the VA and the non-VA provider files."
- . . S DIR("?",4)=" "
- . . D ^DIR W !
- . . K DIR,X Q
- . R !,"Please re-enter NPI : ",NPIVAL2:DTIME Q:'$T I NPIVAL1'=NPIVAL2 W !,"Values do not match!" Q
- . S DONE=1
- . Q
- ; User asked to DELETE where NPI was entered in error.
- I OLDNPI=DELETNPI D
- . I $D(ODATEVAL) D S Y=$$CHEKNPI^XUSNPIED(IEN) Q
- . . N DIR S DIR(0)="Y",DIR("A")="Confirm that you want to **DELETE** this incorrectly entered NPI",DIR("B")="NO" D ^DIR Q:'Y
- . . D DELETNPI^XUSNPIE2(IEN,OIEN,ODATEVAL)
- . . D CHKOLD1^XUSNPIE2(IEN) ; check for earlier value, and activate if present
- . . W !,"Entry was DELETED..."
- . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
- . . Q
- . D DELETNPI^XUSNPIE2(IEN) ; clean up where no entry in multiple
- . W !,"Entry was DELETED..."
- . Q
- ; DONE will be set to 1 if a new or replacement NPI was entered by the user.
- I 'DONE Q
- ;N DIR S DIR("A")="Enter the date the provider was issued this number from CMS: ",DIR(0)="D^:"_$$NOW^XLFDT() D ^DIR Q:Y'>0 S DATEVAL=+Y
- S DATEVAL=$$NOW^XLFDT()
- ; mark previous NPI value as inactive
- I OLDNPI=ADDNPI S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,DATEVAL,0) ; set status to INACTIVE
- S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,NPIVAL1,DATEVAL)
- I +DONE=-1 D Q
- . W !,"Problem writing that value into the database! -- It was **NOT** recorded."
- . W !,$P(DONE,U,2) Q
- W !!,"For provider ",PROVNAME," "_$S('$D(XUSNONED):"(who requires an NPI), ",1:"")_"the NPI ",NPIVAL1,!,"was saved to VistA successfully."
- ; If old NPI was in use by a non-VA provider, issue additional warning.
- I NPIUSEDX D WARNING("C",PROVNAME,.XUSRSLT,NPIVAL1)
- D EDRLNPI^XUSNPIED(IEN)
- Q
- ;
- CHKNPIU(XUSNPI,XUSIEN,XUSFLAG,XUSRSLT) ; Return error or warning if current or new NPI is in use
- N XUSQI,NPIUSED,I
- S XUSQI=$$QI^XUSNPI(XUSNPI)
- K XUSRSLT
- S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,"Individual_ID",XUSQI,XUSIEN,.XUSRSLT,XUSFLAG)
- ; Display error or warning
- I NPIUSED>0 D
- . W !!
- . F I=0:0 S I=$O(XUSRSLT(I)) Q:'I D
- . . W XUSRSLT(I),!
- . . K XUSRSLT(I) Q
- . Q
- Q NPIUSED
- ;
- WARNING(XUSTYPE,PROVNAME,XUSRSLT,XUSNNPI) ; If old NPI was in use by a non-VA provider, issue warning after REPLACE/DELETE
- ; XUSTYPE = Flag indicating whether NPI was Deleted or Changed
- ; PROVNAME = Name of provider whose NPI was changed/deleted
- ; XUSRSLT = text of warning message
- ; XUSNNPI = New NPI (if NPI was changed)
- N I,X
- ; If NPI was replaced, XUSNNPI contains the new NPI
- S XUSNNPI=+$G(XUSNNPI)
- ; Display the warning message
- W !!
- F I=0:0 S I=$O(XUSRSLT("X",I)) Q:'I W XUSRSLT("X",I),!
- ; Insert values into the mail message text
- F I=0:0 S I=$O(XUSRSLT("XMSG",I)) Q:'I S X=XUSRSLT("XMSG",I,0) I X[U D
- . I $G(XUSTYPE)="D" S X=$P(X,U)_"deleted"_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
- . E S X=$P(X,U)_"changed to "_XUSNNPI_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
- . S XUSRSLT("XMSG",I,0)=X
- . Q
- ; Send the mail message
- D SNDMSG(DUZ,XUSTYPE,.XUSRSLT)
- Q
- ;
- SNDMSG(XMDUZ,XUSTYPE,XUSRSLT) ;Sends msg when NPI is changed/deleted.
- ; XUSTYPE = flag indicating NPI was Deleted or Changed
- ; XUSRSLT = array containing the message text and the recipients
- N XMTEXT,XMSUB,XMMG,I,X
- S X=$S($G(XUSTYPE)="D":"deleted",1:"changed")
- S XMSUB="An NPI Number shared by a VA and Non-VA provider was "_X
- S XMTEXT="XUSRSLT(""XMSG"","
- F I=0:0 S I=$O(XUSRSLT("XRCPT",I)) Q:'I S XMY(XUSRSLT("XRCPT",I))=""
- D ^XMD
- I $D(XMMG) W !,XMMG,!
- Q
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIE3 8693 printed Feb 18, 2025@23:39:08 Page 2
- XUSNPIE3 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;4/8/08 18:18
- +1 ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- EDITNPI(IEN) ; main entry of NPI value
- +1 ; IEN is the internal entry number in file 200 for the provider
- +2 ;
- +3 NEW DATEVAL,DESCRIP,DONE,NPIVAL1,NPIVAL2,PROVNAME,I,XX,X,Y,CURRNPI,XUSFLAG
- +4 NEW ODATEVAL,OIEN,OLDNPI,XUSNONED,DIR,ADDNPI,DELETNPI,NOOLDNPI,XUSQI,NPIUSEDX,XUSRSLT
- +5 SET ADDNPI=1
- SET DELETNPI=2
- SET NOOLDNPI=0
- +6 SET PROVNAME=$$GET1^DIQ(200,IEN_",",.01)
- +7 ;I $$ACTIVE^XUSER(IEN) W !,"This user isn't currently active" Q
- +8 ; but don't quit on that
- IF $$GETTAXON^XUSNPIED(IEN,.DESCRIP)=-1
- WRITE !,"This user doesn't have a Taxonomy Code indicating a need for an NPI."
- SET XUSNONED=1
- +9 IF $$NPISTATS^XUSNPIED(IEN)="D"
- SET XUSNONED=1
- +10 IF $$NPISTATS^XUSNPIED(IEN)="E"
- WRITE !,"This provider has been indicated as being EXEMPT from needing an NPI value.",!," Use Exempt option to remove it first"
- QUIT
- +11 ; OLDNPI indicates what user wants to do with the current NPI
- +12 ; OLDNPI=0 - User has no current NPI, or user asks to delete current NPI and it's valid
- +13 ; OLDNPI=1 - User asked to Replace current NPI
- +14 ; OLDNPI=2 - User asked to delete current NPI, and it was entered in error.
- +15 ; OLDNPI="NOEDITNPI" - User doesn't want to change current NPI in any way.
- +16 SET OLDNPI=NOOLDNPI
- +17 ; Initialize flag indicating that current NPI is in use
- +18 SET NPIUSEDX=0
- +19 ; If user already has an NPI, ask them what they want to do with it.
- +20 ; Quit if no NPI, or delete Valid NPI
- IF $$NPISTATS^XUSNPIED(IEN)="D"
- Begin DoDot:1
- +21 NEW I,X,DIR
- +22 SET CURRNPI=$$GET1^DIQ(200,IEN_",",41.99)
- IF CURRNPI=""
- QUIT
- +23 SET OIEN=$$SRCHNPI^XUSNPI("^VA(200,",IEN,CURRNPI)
- +24 IF OIEN>0
- SET ODATEVAL=$PIECE(OIEN,U,2)
- SET OIEN=$ORDER(^VA(200,IEN,"NPISTATUS","C",CURRNPI,"A"),-1)
- +25 ; can't find entry in multiple, delete entry at top
- IF '$DATA(ODATEVAL)
- SET OLDNPI=2
- +26 WRITE !,"This provider already has an NPI value (",CURRNPI,") entered."
- +27 ; Check whether current NPI is already being used. If so, issue a warning.
- +28 SET NPIUSEDX=$$CHKNPIU(CURRNPI,IEN,2,.XUSRSLT)
- +29 SET DIR(0)="SO^D:Delete;R:Replace"
- +30 SET DIR("A")="Do you want to (D)elete or (R)eplace this NPI value?"
- +31 SET DIR("?")="Enter D or R, ^ to quit or <Enter> to continue without editing NPI"
- +32 SET DIR("?",1)="If this NPI was entered for the incorrect individual, or is no longer valid"
- +33 SET DIR("?",2)="for this individual, enter DELETE. Otherwise, the NPI can be Replaced."
- +34 SET DIR("?",3)=""
- +35 DO ^DIR
- KILL DIR
- +36 if $DATA(DTOUT)
- QUIT
- +37 ; If user enters null, set OLDNPI to "NOEDITNPI" to indicate no change to NPI
- +38 if Y=""
- SET OLDNPI="NOEDITNPI"
- +39 IF Y'="D"
- IF Y'="R"
- QUIT
- +40 IF Y="R"
- SET OLDNPI=ADDNPI
- QUIT
- +41 ; Process request to DELETE NPI.
- +42 SET DIR(0)="S^V:VALID;E:ERROR"
- SET DIR("A",1)="Was the original NPI (V)alid for this provider"
- SET DIR("A")="or was it entered in (E)rror?"
- SET DIR("?")="Enter either V or E or ^ to quit with out editing"
- +43 SET DIR("?",1)="If the NPI value was entered for the incorrect individual, respond E,"
- SET DIR("?",2)="otherwise enter V"
- +44 DO ^DIR
- KILL DIR
- +45 if "EV"'[Y
- QUIT
- +46 ; Process DELETE NPI that was Valid for this provider
- +47 IF Y="V"
- Begin DoDot:2
- +48 SET Y=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,$$NOW^XLFDT(),0)
- +49 WRITE !,$SELECT(Y>-1:"Entry has been marked inactive.",1:$PIECE(Y,U,2)),!
- +50 if +Y=-1
- QUIT
- +51 NEW XUFDA
- +52 SET XUFDA(200,IEN_",",41.98)="@"
- SET XUFDA(200,IEN_",",41.99)="@"
- +53 DO FILE^DIE("","XUFDA")
- SET Y=$$CHEKNPI^XUSNPIED(IEN)
- +54 IF NPIUSEDX
- DO WARNING("D",PROVNAME,.XUSRSLT)
- +55 QUIT
- End DoDot:2
- SET OLDNPI=NOOLDNPI
- QUIT
- +56 SET OLDNPI=DELETNPI
- +57 QUIT
- End DoDot:1
- if OLDNPI=NOOLDNPI
- QUIT
- +58 ; If user doesn't want to edit current NPI, quit.
- +59 if OLDNPI="NOEDITNPI"
- QUIT
- +60 ; If user is not a provider, and has no NPI, let them know.
- +61 IF $$CHEKNPI^XUSNPIED(IEN)=0
- IF OLDNPI=0
- WRITE !,"Need for an NPI value isn't indicated - but you can enter an NPI",$CHAR(7)
- +62 IF IEN'=DUZ
- Begin DoDot:1
- +63 WRITE !,"Provider: ",PROVNAME," ","XXX-XX-"_$EXTRACT($$GET1^DIQ(200,IEN_",",9),6,9)," DOB: "
- +64 SET XX=$PIECE($GET(^VA(200,IEN,1)),U,3)
- if XX'=""
- SET XX=$$DATE10^XUSNPIED(XX)
- WRITE XX
- QUIT
- End DoDot:1
- +65 ; Initialize DONE to 0. It will be set to 1 if a new NPI is entered.
- +66 SET DONE=0
- +67 ; Allow user to add a new or replacement NPI.
- +68 IF OLDNPI'=DELETNPI
- FOR
- READ !,"Enter NPI (10 digits): ",NPIVAL1:DTIME
- if '$TEST
- QUIT
- if NPIVAL1=""
- QUIT
- if NPIVAL1=U
- QUIT
- Begin DoDot:1
- +69 IF NPIVAL1'?10N
- Begin DoDot:2
- +70 WRITE !,$CHAR(7),"Enter a 10 digit National Provider Identifier which is obtained ",!,"from 'https://nppes.cms.hhs.gov/NPPES/Welcome.do'"
- +71 if $$PROD^XUPROD()
- QUIT
- WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to generate a test NPI value"
- DO ^DIR
- if 'Y
- QUIT
- +72 READ !,"Enter a nine (9) digit number as the base: ",Y:DTIME
- if Y'?9N
- QUIT
- +73 WRITE !,"The complete NPI value is: ",Y_$$CKDIGIT^XUSNPI(Y),!
- +74 QUIT
- End DoDot:2
- QUIT
- +75 SET NPIUSED=$$CHKNPIU(NPIVAL1,IEN,3)
- +76 ; Quit if error
- +77 if NPIUSED=1
- QUIT
- +78 ; If warning, see whether they want to continue
- +79 IF NPIUSED=2
- Begin DoDot:2
- +80 KILL DIR,Y,X
- +81 SET DIR(0)="SA^Y:yes;N:no"
- SET DIR("B")="N"
- +82 SET DIR("A")="Do you still want to add this NPI to Provider "_PROVNAME_"? "
- +83 SET DIR("?")="If you answer YES, make sure both the non-VA and VA Provider are the same person."
- +84 SET DIR("?",1)="A provider can serve as both a VA and a non-VA provider."
- +85 SET DIR("?",2)="That is the only case where the same NPI can be assigned to a person"
- +86 SET DIR("?",3)="in both the VA and the non-VA provider files."
- +87 SET DIR("?",4)=" "
- +88 DO ^DIR
- WRITE !
- +89 KILL DIR,X
- QUIT
- End DoDot:2
- if Y'="Y"
- QUIT
- +90 READ !,"Please re-enter NPI : ",NPIVAL2:DTIME
- if '$TEST
- QUIT
- IF NPIVAL1'=NPIVAL2
- WRITE !,"Values do not match!"
- QUIT
- +91 SET DONE=1
- +92 QUIT
- End DoDot:1
- if DONE
- QUIT
- +93 ; User asked to DELETE where NPI was entered in error.
- +94 IF OLDNPI=DELETNPI
- Begin DoDot:1
- +95 IF $DATA(ODATEVAL)
- Begin DoDot:2
- +96 NEW DIR
- SET DIR(0)="Y"
- SET DIR("A")="Confirm that you want to **DELETE** this incorrectly entered NPI"
- SET DIR("B")="NO"
- DO ^DIR
- if 'Y
- QUIT
- +97 DO DELETNPI^XUSNPIE2(IEN,OIEN,ODATEVAL)
- +98 ; check for earlier value, and activate if present
- DO CHKOLD1^XUSNPIE2(IEN)
- +99 WRITE !,"Entry was DELETED..."
- +100 IF NPIUSEDX
- DO WARNING("D",PROVNAME,.XUSRSLT)
- +101 QUIT
- End DoDot:2
- SET Y=$$CHEKNPI^XUSNPIED(IEN)
- QUIT
- +102 ; clean up where no entry in multiple
- DO DELETNPI^XUSNPIE2(IEN)
- +103 WRITE !,"Entry was DELETED..."
- +104 QUIT
- End DoDot:1
- +105 ; DONE will be set to 1 if a new or replacement NPI was entered by the user.
- +106 IF 'DONE
- QUIT
- +107 ;N DIR S DIR("A")="Enter the date the provider was issued this number from CMS: ",DIR(0)="D^:"_$$NOW^XLFDT() D ^DIR Q:Y'>0 S DATEVAL=+Y
- +108 SET DATEVAL=$$NOW^XLFDT()
- +109 ; mark previous NPI value as inactive
- +110 ; set status to INACTIVE
- IF OLDNPI=ADDNPI
- SET DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,DATEVAL,0)
- +111 SET DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,NPIVAL1,DATEVAL)
- +112 IF +DONE=-1
- Begin DoDot:1
- +113 WRITE !,"Problem writing that value into the database! -- It was **NOT** recorded."
- +114 WRITE !,$PIECE(DONE,U,2)
- QUIT
- End DoDot:1
- QUIT
- +115 WRITE !!,"For provider ",PROVNAME," "_$SELECT('$DATA(XUSNONED):"(who requires an NPI), ",1:"")_"the NPI ",NPIVAL1,!,"was saved to VistA successfully."
- +116 ; If old NPI was in use by a non-VA provider, issue additional warning.
- +117 IF NPIUSEDX
- DO WARNING("C",PROVNAME,.XUSRSLT,NPIVAL1)
- +118 DO EDRLNPI^XUSNPIED(IEN)
- +119 QUIT
- +120 ;
- CHKNPIU(XUSNPI,XUSIEN,XUSFLAG,XUSRSLT) ; Return error or warning if current or new NPI is in use
- +1 NEW XUSQI,NPIUSED,I
- +2 SET XUSQI=$$QI^XUSNPI(XUSNPI)
- +3 KILL XUSRSLT
- +4 SET NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,"Individual_ID",XUSQI,XUSIEN,.XUSRSLT,XUSFLAG)
- +5 ; Display error or warning
- +6 IF NPIUSED>0
- Begin DoDot:1
- +7 WRITE !!
- +8 FOR I=0:0
- SET I=$ORDER(XUSRSLT(I))
- if 'I
- QUIT
- Begin DoDot:2
- +9 WRITE XUSRSLT(I),!
- +10 KILL XUSRSLT(I)
- QUIT
- End DoDot:2
- +11 QUIT
- End DoDot:1
- +12 QUIT NPIUSED
- +13 ;
- WARNING(XUSTYPE,PROVNAME,XUSRSLT,XUSNNPI) ; If old NPI was in use by a non-VA provider, issue warning after REPLACE/DELETE
- +1 ; XUSTYPE = Flag indicating whether NPI was Deleted or Changed
- +2 ; PROVNAME = Name of provider whose NPI was changed/deleted
- +3 ; XUSRSLT = text of warning message
- +4 ; XUSNNPI = New NPI (if NPI was changed)
- +5 NEW I,X
- +6 ; If NPI was replaced, XUSNNPI contains the new NPI
- +7 SET XUSNNPI=+$GET(XUSNNPI)
- +8 ; Display the warning message
- +9 WRITE !!
- +10 FOR I=0:0
- SET I=$ORDER(XUSRSLT("X",I))
- if 'I
- QUIT
- WRITE XUSRSLT("X",I),!
- +11 ; Insert values into the mail message text
- +12 FOR I=0:0
- SET I=$ORDER(XUSRSLT("XMSG",I))
- if 'I
- QUIT
- SET X=XUSRSLT("XMSG",I,0)
- IF X[U
- Begin DoDot:1
- +13 IF $GET(XUSTYPE)="D"
- SET X=$PIECE(X,U)_"deleted"_$PIECE(X,U,2)_$GET(PROVNAME)_$PIECE(X,U,3)
- +14 IF '$TEST
- SET X=$PIECE(X,U)_"changed to "_XUSNNPI_$PIECE(X,U,2)_$GET(PROVNAME)_$PIECE(X,U,3)
- +15 SET XUSRSLT("XMSG",I,0)=X
- +16 QUIT
- End DoDot:1
- +17 ; Send the mail message
- +18 DO SNDMSG(DUZ,XUSTYPE,.XUSRSLT)
- +19 QUIT
- +20 ;
- SNDMSG(XMDUZ,XUSTYPE,XUSRSLT) ;Sends msg when NPI is changed/deleted.
- +1 ; XUSTYPE = flag indicating NPI was Deleted or Changed
- +2 ; XUSRSLT = array containing the message text and the recipients
- +3 NEW XMTEXT,XMSUB,XMMG,I,X
- +4 SET X=$SELECT($GET(XUSTYPE)="D":"deleted",1:"changed")
- +5 SET XMSUB="An NPI Number shared by a VA and Non-VA provider was "_X
- +6 SET XMTEXT="XUSRSLT(""XMSG"","
- +7 FOR I=0:0
- SET I=$ORDER(XUSRSLT("XRCPT",I))
- if 'I
- QUIT
- SET XMY(XUSRSLT("XRCPT",I))=""
- +8 DO ^XMD
- +9 IF $DATA(XMMG)
- WRITE !,XMMG,!
- +10 QUIT
- +11 ;
- +12 ;