176 lines
8.3 KiB
Mathematica
176 lines
8.3 KiB
Mathematica
|
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
|
||
|
|
;
|
||
|
|
;
|