source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIE3.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1XUSNPIE3 ;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 ;
7EDITNPI(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 ;
128CHKNPIU(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 ;
142WARNING(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 ;
163SNDMSG(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 ;
Note: See TracBrowser for help on using the repository browser.