| [613] | 1 | XUSNPIE3 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;4/8/08 18:18
|
|---|
| 2 | ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | EDITNPI(IEN) ; main entry of NPI value
|
|---|
| 8 | ; IEN is the internal entry number in file 200 for the provider
|
|---|
| 9 | ;
|
|---|
| 10 | N DATEVAL,DESCRIP,DONE,NPIVAL1,NPIVAL2,PROVNAME,I,XX,X,Y,CURRNPI,XUSFLAG
|
|---|
| 11 | N ODATEVAL,OIEN,OLDNPI,XUSNONED,DIR,ADDNPI,DELETNPI,NOOLDNPI,XUSQI,NPIUSEDX,XUSRSLT
|
|---|
| 12 | S ADDNPI=1,DELETNPI=2,NOOLDNPI=0
|
|---|
| 13 | S PROVNAME=$$GET1^DIQ(200,IEN_",",.01)
|
|---|
| 14 | ;I $$ACTIVE^XUSER(IEN) W !,"This user isn't currently active" Q
|
|---|
| 15 | 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
|
|---|
| 16 | I $$NPISTATS^XUSNPIED(IEN)="D" S XUSNONED=1
|
|---|
| 17 | 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
|
|---|
| 18 | ; OLDNPI indicates what user wants to do with the current NPI
|
|---|
| 19 | ; OLDNPI=0 - User has no current NPI, or user asks to delete current NPI and it's valid
|
|---|
| 20 | ; OLDNPI=1 - User asked to Replace current NPI
|
|---|
| 21 | ; OLDNPI=2 - User asked to delete current NPI, and it was entered in error.
|
|---|
| 22 | ; OLDNPI="NOEDITNPI" - User doesn't want to change current NPI in any way.
|
|---|
| 23 | S OLDNPI=NOOLDNPI
|
|---|
| 24 | ; Initialize flag indicating that current NPI is in use
|
|---|
| 25 | S NPIUSEDX=0
|
|---|
| 26 | ; If user already has an NPI, ask them what they want to do with it.
|
|---|
| 27 | I $$NPISTATS^XUSNPIED(IEN)="D" D Q:OLDNPI=NOOLDNPI ; Quit if no NPI, or delete Valid NPI
|
|---|
| 28 | . N I,X,DIR
|
|---|
| 29 | . S CURRNPI=$$GET1^DIQ(200,IEN_",",41.99) I CURRNPI="" Q
|
|---|
| 30 | . S OIEN=$$SRCHNPI^XUSNPI("^VA(200,",IEN,CURRNPI)
|
|---|
| 31 | . I OIEN>0 S ODATEVAL=$P(OIEN,U,2),OIEN=$O(^VA(200,IEN,"NPISTATUS","C",CURRNPI,"A"),-1)
|
|---|
| 32 | . I '$D(ODATEVAL) S OLDNPI=2 ; can't find entry in multiple, delete entry at top
|
|---|
| 33 | . W !,"This provider already has an NPI value (",CURRNPI,") entered."
|
|---|
| 34 | . ; Check whether current NPI is already being used. If so, issue a warning.
|
|---|
| 35 | . S NPIUSEDX=$$CHKNPIU(CURRNPI,IEN,2,.XUSRSLT)
|
|---|
| 36 | . S DIR(0)="SO^D:Delete;R:Replace"
|
|---|
| 37 | . S DIR("A")="Do you want to (D)elete or (R)eplace this NPI value?"
|
|---|
| 38 | . S DIR("?")="Enter D or R, ^ to quit or <Enter> to continue without editing NPI"
|
|---|
| 39 | . S DIR("?",1)="If this NPI was entered for the incorrect individual, or is no longer valid"
|
|---|
| 40 | . S DIR("?",2)="for this individual, enter DELETE. Otherwise, the NPI can be Replaced."
|
|---|
| 41 | . S DIR("?",3)=""
|
|---|
| 42 | . D ^DIR K DIR
|
|---|
| 43 | . Q:$D(DTOUT)
|
|---|
| 44 | . ; If user enters null, set OLDNPI to "NOEDITNPI" to indicate no change to NPI
|
|---|
| 45 | . S:Y="" OLDNPI="NOEDITNPI"
|
|---|
| 46 | . I Y'="D",Y'="R" Q
|
|---|
| 47 | . I Y="R" S OLDNPI=ADDNPI Q
|
|---|
| 48 | . ; Process request to DELETE NPI.
|
|---|
| 49 | . 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"
|
|---|
| 50 | . S DIR("?",1)="If the NPI value was entered for the incorrect individual, respond E,",DIR("?",2)="otherwise enter V"
|
|---|
| 51 | . D ^DIR K DIR
|
|---|
| 52 | . Q:"EV"'[Y
|
|---|
| 53 | . ; Process DELETE NPI that was Valid for this provider
|
|---|
| 54 | . I Y="V" D S OLDNPI=NOOLDNPI Q
|
|---|
| 55 | . . S Y=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,$$NOW^XLFDT(),0)
|
|---|
| 56 | . . W !,$S(Y>-1:"Entry has been marked inactive.",1:$P(Y,U,2)),!
|
|---|
| 57 | . . Q:+Y=-1
|
|---|
| 58 | . . N XUFDA
|
|---|
| 59 | . . S XUFDA(200,IEN_",",41.98)="@",XUFDA(200,IEN_",",41.99)="@"
|
|---|
| 60 | . . D FILE^DIE("","XUFDA") S Y=$$CHEKNPI^XUSNPIED(IEN)
|
|---|
| 61 | . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
|
|---|
| 62 | . . Q
|
|---|
| 63 | . S OLDNPI=DELETNPI
|
|---|
| 64 | . Q
|
|---|
| 65 | ; If user doesn't want to edit current NPI, quit.
|
|---|
| 66 | Q:OLDNPI="NOEDITNPI"
|
|---|
| 67 | ; If user is not a provider, and has no NPI, let them know.
|
|---|
| 68 | I $$CHEKNPI^XUSNPIED(IEN)=0,OLDNPI=0 W !,"Need for an NPI value isn't indicated - but you can enter an NPI",$C(7)
|
|---|
| 69 | I IEN'=DUZ D
|
|---|
| 70 | . W !,"Provider: ",PROVNAME," ","XXX-XX-"_$E($$GET1^DIQ(200,IEN_",",9),6,9)," DOB: "
|
|---|
| 71 | . S XX=$P($G(^VA(200,IEN,1)),U,3) S:XX'="" XX=$$DATE10^XUSNPIED(XX) W XX Q
|
|---|
| 72 | ; Initialize DONE to 0. It will be set to 1 if a new NPI is entered.
|
|---|
| 73 | S DONE=0
|
|---|
| 74 | ; Allow user to add a new or replacement NPI.
|
|---|
| 75 | I OLDNPI'=DELETNPI F R !,"Enter NPI (10 digits): ",NPIVAL1:DTIME Q:'$T Q:NPIVAL1="" Q:NPIVAL1=U D Q:DONE
|
|---|
| 76 | . I NPIVAL1'?10N D Q
|
|---|
| 77 | . . W !,$C(7),"Enter a 10 digit National Provider Identifier which is obtained ",!,"from 'https://nppes.cms.hhs.gov/NPPES/Welcome.do'"
|
|---|
| 78 | . . 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
|
|---|
| 79 | . . R !,"Enter a nine (9) digit number as the base: ",Y:DTIME Q:Y'?9N
|
|---|
| 80 | . . W !,"The complete NPI value is: ",Y_$$CKDIGIT^XUSNPI(Y),!
|
|---|
| 81 | . . Q
|
|---|
| 82 | . S NPIUSED=$$CHKNPIU(NPIVAL1,IEN,3)
|
|---|
| 83 | . ; Quit if error
|
|---|
| 84 | . Q:NPIUSED=1
|
|---|
| 85 | . ; If warning, see whether they want to continue
|
|---|
| 86 | . I NPIUSED=2 D Q:Y'="Y"
|
|---|
| 87 | . . K DIR,Y,X
|
|---|
| 88 | . . S DIR(0)="SA^Y:yes;N:no",DIR("B")="N"
|
|---|
| 89 | . . S DIR("A")="Do you still want to add this NPI to Provider "_PROVNAME_"? "
|
|---|
| 90 | . . S DIR("?")="If you answer YES, make sure both the non-VA and VA Provider are the same person."
|
|---|
| 91 | . . S DIR("?",1)="A provider can serve as both a VA and a non-VA provider."
|
|---|
| 92 | . . S DIR("?",2)="That is the only case where the same NPI can be assigned to a person"
|
|---|
| 93 | . . S DIR("?",3)="in both the VA and the non-VA provider files."
|
|---|
| 94 | . . S DIR("?",4)=" "
|
|---|
| 95 | . . D ^DIR W !
|
|---|
| 96 | . . K DIR,X Q
|
|---|
| 97 | . R !,"Please re-enter NPI : ",NPIVAL2:DTIME Q:'$T I NPIVAL1'=NPIVAL2 W !,"Values do not match!" Q
|
|---|
| 98 | . S DONE=1
|
|---|
| 99 | . Q
|
|---|
| 100 | ; User asked to DELETE where NPI was entered in error.
|
|---|
| 101 | I OLDNPI=DELETNPI D
|
|---|
| 102 | . I $D(ODATEVAL) D S Y=$$CHEKNPI^XUSNPIED(IEN) Q
|
|---|
| 103 | . . 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
|
|---|
| 104 | . . D DELETNPI^XUSNPIE2(IEN,OIEN,ODATEVAL)
|
|---|
| 105 | . . D CHKOLD1^XUSNPIE2(IEN) ; check for earlier value, and activate if present
|
|---|
| 106 | . . W !,"Entry was DELETED..."
|
|---|
| 107 | . . I NPIUSEDX D WARNING("D",PROVNAME,.XUSRSLT)
|
|---|
| 108 | . . Q
|
|---|
| 109 | . D DELETNPI^XUSNPIE2(IEN) ; clean up where no entry in multiple
|
|---|
| 110 | . W !,"Entry was DELETED..."
|
|---|
| 111 | . Q
|
|---|
| 112 | ; DONE will be set to 1 if a new or replacement NPI was entered by the user.
|
|---|
| 113 | I 'DONE Q
|
|---|
| 114 | ;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
|
|---|
| 115 | S DATEVAL=$$NOW^XLFDT()
|
|---|
| 116 | ; mark previous NPI value as inactive
|
|---|
| 117 | I OLDNPI=ADDNPI S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,DATEVAL,0) ; set status to INACTIVE
|
|---|
| 118 | S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,NPIVAL1,DATEVAL)
|
|---|
| 119 | I +DONE=-1 D Q
|
|---|
| 120 | . W !,"Problem writing that value into the database! -- It was **NOT** recorded."
|
|---|
| 121 | . W !,$P(DONE,U,2) Q
|
|---|
| 122 | W !!,"For provider ",PROVNAME," "_$S('$D(XUSNONED):"(who requires an NPI), ",1:"")_"the NPI ",NPIVAL1,!,"was saved to VistA successfully."
|
|---|
| 123 | ; If old NPI was in use by a non-VA provider, issue additional warning.
|
|---|
| 124 | I NPIUSEDX D WARNING("C",PROVNAME,.XUSRSLT,NPIVAL1)
|
|---|
| 125 | D EDRLNPI^XUSNPIED(IEN)
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | CHKNPIU(XUSNPI,XUSIEN,XUSFLAG,XUSRSLT) ; Return error or warning if current or new NPI is in use
|
|---|
| 129 | N XUSQI,NPIUSED,I
|
|---|
| 130 | S XUSQI=$$QI^XUSNPI(XUSNPI)
|
|---|
| 131 | K XUSRSLT
|
|---|
| 132 | S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,"Individual_ID",XUSQI,XUSIEN,.XUSRSLT,XUSFLAG)
|
|---|
| 133 | ; Display error or warning
|
|---|
| 134 | I NPIUSED>0 D
|
|---|
| 135 | . W !!
|
|---|
| 136 | . F I=0:0 S I=$O(XUSRSLT(I)) Q:'I D
|
|---|
| 137 | . . W XUSRSLT(I),!
|
|---|
| 138 | . . K XUSRSLT(I) Q
|
|---|
| 139 | . Q
|
|---|
| 140 | Q NPIUSED
|
|---|
| 141 | ;
|
|---|
| 142 | WARNING(XUSTYPE,PROVNAME,XUSRSLT,XUSNNPI) ; If old NPI was in use by a non-VA provider, issue warning after REPLACE/DELETE
|
|---|
| 143 | ; XUSTYPE = Flag indicating whether NPI was Deleted or Changed
|
|---|
| 144 | ; PROVNAME = Name of provider whose NPI was changed/deleted
|
|---|
| 145 | ; XUSRSLT = text of warning message
|
|---|
| 146 | ; XUSNNPI = New NPI (if NPI was changed)
|
|---|
| 147 | N I,X
|
|---|
| 148 | ; If NPI was replaced, XUSNNPI contains the new NPI
|
|---|
| 149 | S XUSNNPI=+$G(XUSNNPI)
|
|---|
| 150 | ; Display the warning message
|
|---|
| 151 | W !!
|
|---|
| 152 | F I=0:0 S I=$O(XUSRSLT("X",I)) Q:'I W XUSRSLT("X",I),!
|
|---|
| 153 | ; Insert values into the mail message text
|
|---|
| 154 | F I=0:0 S I=$O(XUSRSLT("XMSG",I)) Q:'I S X=XUSRSLT("XMSG",I,0) I X[U D
|
|---|
| 155 | . I $G(XUSTYPE)="D" S X=$P(X,U)_"deleted"_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
|
|---|
| 156 | . E S X=$P(X,U)_"changed to "_XUSNNPI_$P(X,U,2)_$G(PROVNAME)_$P(X,U,3)
|
|---|
| 157 | . S XUSRSLT("XMSG",I,0)=X
|
|---|
| 158 | . Q
|
|---|
| 159 | ; Send the mail message
|
|---|
| 160 | D SNDMSG(DUZ,XUSTYPE,.XUSRSLT)
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | SNDMSG(XMDUZ,XUSTYPE,XUSRSLT) ;Sends msg when NPI is changed/deleted.
|
|---|
| 164 | ; XUSTYPE = flag indicating NPI was Deleted or Changed
|
|---|
| 165 | ; XUSRSLT = array containing the message text and the recipients
|
|---|
| 166 | N XMTEXT,XMSUB,XMMG,I,X
|
|---|
| 167 | S X=$S($G(XUSTYPE)="D":"deleted",1:"changed")
|
|---|
| 168 | S XMSUB="An NPI Number shared by a VA and Non-VA provider was "_X
|
|---|
| 169 | S XMTEXT="XUSRSLT(""XMSG"","
|
|---|
| 170 | F I=0:0 S I=$O(XUSRSLT("XRCPT",I)) Q:'I S XMY(XUSRSLT("XRCPT",I))=""
|
|---|
| 171 | D ^XMD
|
|---|
| 172 | I $D(XMMG) W !,XMMG,!
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | ;
|
|---|
