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

XUSNPIE3.m

Go to the documentation of this file.
  1. XUSNPIE3 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;4/8/08 18:18
  1. ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. EDITNPI(IEN) ; main entry of NPI value
  1. ; IEN is the internal entry number in file 200 for the provider
  1. ;
  1. N DATEVAL,DESCRIP,DONE,NPIVAL1,NPIVAL2,PROVNAME,I,XX,X,Y,CURRNPI,XUSFLAG
  1. N ODATEVAL,OIEN,OLDNPI,XUSNONED,DIR,ADDNPI,DELETNPI,NOOLDNPI,XUSQI,NPIUSEDX,XUSRSLT
  1. S ADDNPI=1,DELETNPI=2,NOOLDNPI=0
  1. S PROVNAME=$$GET1^DIQ(200,IEN_",",.01)
  1. ;I $$ACTIVE^XUSER(IEN) W !,"This user isn't currently active" Q
  1. 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
  1. I $$NPISTATS^XUSNPIED(IEN)="D" S XUSNONED=1
  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
  1. ; OLDNPI indicates what user wants to do with the current NPI
  1. ; OLDNPI=0 - User has no current NPI, or user asks to delete current NPI and it's valid
  1. ; OLDNPI=1 - User asked to Replace current NPI
  1. ; OLDNPI=2 - User asked to delete current NPI, and it was entered in error.
  1. ; OLDNPI="NOEDITNPI" - User doesn't want to change current NPI in any way.
  1. S OLDNPI=NOOLDNPI
  1. ; Initialize flag indicating that current NPI is in use
  1. S NPIUSEDX=0
  1. ; If user already has an NPI, ask them what they want to do with it.
  1. I $$NPISTATS^XUSNPIED(IEN)="D" D Q:OLDNPI=NOOLDNPI ; Quit if no NPI, or delete Valid NPI
  1. . N I,X,DIR
  1. . S CURRNPI=$$GET1^DIQ(200,IEN_",",41.99) I CURRNPI="" Q
  1. . S OIEN=$$SRCHNPI^XUSNPI("^VA(200,",IEN,CURRNPI)
  1. . I OIEN>0 S ODATEVAL=$P(OIEN,U,2),OIEN=$O(^VA(200,IEN,"NPISTATUS","C",CURRNPI,"A"),-1)
  1. . I '$D(ODATEVAL) S OLDNPI=2 ; can't find entry in multiple, delete entry at top
  1. . W !,"This provider already has an NPI value (",CURRNPI,") entered."
  1. . ; Check whether current NPI is already being used. If so, issue a warning.
  1. . S NPIUSEDX=$$CHKNPIU(CURRNPI,IEN,2,.XUSRSLT)
  1. . S DIR(0)="SO^D:Delete;R:Replace"
  1. . S DIR("A")="Do you want to (D)elete or (R)eplace this NPI value?"
  1. . S DIR("?")="Enter D or R, ^ to quit or <Enter> to continue without editing NPI"
  1. . S DIR("?",1)="If this NPI was entered for the incorrect individual, or is no longer valid"
  1. . S DIR("?",2)="for this individual, enter DELETE. Otherwise, the NPI can be Replaced."
  1. . S DIR("?",3)=""
  1. . D ^DIR K DIR
  1. . Q:$D(DTOUT)
  1. . ; If user enters null, set OLDNPI to "NOEDITNPI" to indicate no change to NPI
  1. . S:Y="" OLDNPI="NOEDITNPI"
  1. . I Y'="D",Y'="R" Q
  1. . I Y="R" S OLDNPI=ADDNPI Q
  1. . ; Process request to DELETE NPI.
  1. . 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"
  1. . S DIR("?",1)="If the NPI value was entered for the incorrect individual, respond E,",DIR("?",2)="otherwise enter V"
  1. . D ^DIR K DIR
  1. . Q:"EV"'[Y
  1. . ; Process DELETE NPI that was Valid for this provider
  1. . I Y="V" D S OLDNPI=NOOLDNPI Q
  1. . . S Y=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,$$NOW^XLFDT(),0)
  1. . . W !,$S(Y>-1:"Entry has been marked inactive.",1:$P(Y,U,2)),!
  1. . . Q:+Y=-1
  1. . . N XUFDA
  1. . . S XUFDA(200,IEN_",",41.98)="@",XUFDA(200,IEN_",",41.99)="@"
  1. . . D FILE^DIE("","XUFDA") S Y=$$CHEKNPI^XUSNPIED(IEN)
  1. . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
  1. . . Q
  1. . S OLDNPI=DELETNPI
  1. . Q
  1. ; If user doesn't want to edit current NPI, quit.
  1. Q:OLDNPI="NOEDITNPI"
  1. ; If user is not a provider, and has no NPI, let them know.
  1. I $$CHEKNPI^XUSNPIED(IEN)=0,OLDNPI=0 W !,"Need for an NPI value isn't indicated - but you can enter an NPI",$C(7)
  1. I IEN'=DUZ D
  1. . W !,"Provider: ",PROVNAME," ","XXX-XX-"_$E($$GET1^DIQ(200,IEN_",",9),6,9)," DOB: "
  1. . S XX=$P($G(^VA(200,IEN,1)),U,3) S:XX'="" XX=$$DATE10^XUSNPIED(XX) W XX Q
  1. ; Initialize DONE to 0. It will be set to 1 if a new NPI is entered.
  1. S DONE=0
  1. ; Allow user to add a new or replacement NPI.
  1. I OLDNPI'=DELETNPI F R !,"Enter NPI (10 digits): ",NPIVAL1:DTIME Q:'$T Q:NPIVAL1="" Q:NPIVAL1=U D Q:DONE
  1. . I NPIVAL1'?10N D Q
  1. . . W !,$C(7),"Enter a 10 digit National Provider Identifier which is obtained ",!,"from 'https://nppes.cms.hhs.gov/NPPES/Welcome.do'"
  1. . . 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
  1. . . R !,"Enter a nine (9) digit number as the base: ",Y:DTIME Q:Y'?9N
  1. . . W !,"The complete NPI value is: ",Y_$$CKDIGIT^XUSNPI(Y),!
  1. . . Q
  1. . S NPIUSED=$$CHKNPIU(NPIVAL1,IEN,3)
  1. . ; Quit if error
  1. . Q:NPIUSED=1
  1. . ; If warning, see whether they want to continue
  1. . I NPIUSED=2 D Q:Y'="Y"
  1. . . K DIR,Y,X
  1. . . S DIR(0)="SA^Y:yes;N:no",DIR("B")="N"
  1. . . S DIR("A")="Do you still want to add this NPI to Provider "_PROVNAME_"? "
  1. . . S DIR("?")="If you answer YES, make sure both the non-VA and VA Provider are the same person."
  1. . . S DIR("?",1)="A provider can serve as both a VA and a non-VA provider."
  1. . . S DIR("?",2)="That is the only case where the same NPI can be assigned to a person"
  1. . . S DIR("?",3)="in both the VA and the non-VA provider files."
  1. . . S DIR("?",4)=" "
  1. . . D ^DIR W !
  1. . . K DIR,X Q
  1. . R !,"Please re-enter NPI : ",NPIVAL2:DTIME Q:'$T I NPIVAL1'=NPIVAL2 W !,"Values do not match!" Q
  1. . S DONE=1
  1. . Q
  1. ; User asked to DELETE where NPI was entered in error.
  1. I OLDNPI=DELETNPI D
  1. . I $D(ODATEVAL) D S Y=$$CHEKNPI^XUSNPIED(IEN) Q
  1. . . 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
  1. . . D DELETNPI^XUSNPIE2(IEN,OIEN,ODATEVAL)
  1. . . D CHKOLD1^XUSNPIE2(IEN) ; check for earlier value, and activate if present
  1. . . W !,"Entry was DELETED..."
  1. . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
  1. . . Q
  1. . D DELETNPI^XUSNPIE2(IEN) ; clean up where no entry in multiple
  1. . W !,"Entry was DELETED..."
  1. . Q
  1. ; DONE will be set to 1 if a new or replacement NPI was entered by the user.
  1. I 'DONE Q
  1. ;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
  1. S DATEVAL=$$NOW^XLFDT()
  1. ; mark previous NPI value as inactive
  1. I OLDNPI=ADDNPI S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,DATEVAL,0) ; set status to INACTIVE
  1. S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,NPIVAL1,DATEVAL)
  1. I +DONE=-1 D Q
  1. . W !,"Problem writing that value into the database! -- It was **NOT** recorded."
  1. . W !,$P(DONE,U,2) Q
  1. W !!,"For provider ",PROVNAME," "_$S('$D(XUSNONED):"(who requires an NPI), ",1:"")_"the NPI ",NPIVAL1,!,"was saved to VistA successfully."
  1. ; If old NPI was in use by a non-VA provider, issue additional warning.
  1. I NPIUSEDX D WARNING("C",PROVNAME,.XUSRSLT,NPIVAL1)
  1. D EDRLNPI^XUSNPIED(IEN)
  1. Q
  1. ;
  1. CHKNPIU(XUSNPI,XUSIEN,XUSFLAG,XUSRSLT) ; Return error or warning if current or new NPI is in use
  1. N XUSQI,NPIUSED,I
  1. S XUSQI=$$QI^XUSNPI(XUSNPI)
  1. K XUSRSLT
  1. S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,"Individual_ID",XUSQI,XUSIEN,.XUSRSLT,XUSFLAG)
  1. ; Display error or warning
  1. I NPIUSED>0 D
  1. . W !!
  1. . F I=0:0 S I=$O(XUSRSLT(I)) Q:'I D
  1. . . W XUSRSLT(I),!
  1. . . K XUSRSLT(I) Q
  1. . Q
  1. Q NPIUSED
  1. ;
  1. 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
  1. ; PROVNAME = Name of provider whose NPI was changed/deleted
  1. ; XUSRSLT = text of warning message
  1. ; XUSNNPI = New NPI (if NPI was changed)
  1. N I,X
  1. ; If NPI was replaced, XUSNNPI contains the new NPI
  1. S XUSNNPI=+$G(XUSNNPI)
  1. ; Display the warning message
  1. W !!
  1. F I=0:0 S I=$O(XUSRSLT("X",I)) Q:'I W XUSRSLT("X",I),!
  1. ; Insert values into the mail message text
  1. F I=0:0 S I=$O(XUSRSLT("XMSG",I)) Q:'I S X=XUSRSLT("XMSG",I,0) I X[U D
  1. . I $G(XUSTYPE)="D" S X=$P(X,U)_"deleted"_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
  1. . E S X=$P(X,U)_"changed to "_XUSNNPI_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
  1. . S XUSRSLT("XMSG",I,0)=X
  1. . Q
  1. ; Send the mail message
  1. D SNDMSG(DUZ,XUSTYPE,.XUSRSLT)
  1. Q
  1. ;
  1. SNDMSG(XMDUZ,XUSTYPE,XUSRSLT) ;Sends msg when NPI is changed/deleted.
  1. ; XUSTYPE = flag indicating NPI was Deleted or Changed
  1. ; XUSRSLT = array containing the message text and the recipients
  1. N XMTEXT,XMSUB,XMMG,I,X
  1. S X=$S($G(XUSTYPE)="D":"deleted",1:"changed")
  1. S XMSUB="An NPI Number shared by a VA and Non-VA provider was "_X
  1. S XMTEXT="XUSRSLT(""XMSG"","
  1. F I=0:0 S I=$O(XUSRSLT("XRCPT",I)) Q:'I S XMY(XUSRSLT("XRCPT",I))=""
  1. D ^XMD
  1. I $D(XMMG) W !,XMMG,!
  1. Q
  1. ;
  1. ;