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/XUSNPI1.m@ 738

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

initial load of WorldVistAEHR
File size: 7.6 KB
Line 
1XUSNPI1 ; OAK/TKW - NATIONAL PROVIDER IDENTIFIER UTILITIES ;6/6/08 11:27
2 ;;8.0;KERNEL;**480**; July 10, 1995;Build 38
3 ;;Per VHA Directive 2004-038, this routine should not be modified
4NPIUSED(XUSNPI,XUSQID,XUSQIL,XUSIEN,XUSRSLT,XUSFLAG) ; Evaluate cases where an NPI is already in use
5 ; and return an error or warning. Called from routines that allow an NPI to be assigned
6 ; to either an INSTITUTION (file 4) or a NEW PERSON (file 200).
7 ; XUSNPI = the NPI
8 ; XUSQID = the qualified identifier for the file being edited (ex. "Individual_ID")
9 ; XUSQIL = the delimited list of entities already using that NPI. This is output
10 ; from $$QI^XUSNPI, in the format:
11 ; Qualified_Identifier^IEN^Effective_date/time^Active/Inactive;
12 ; (Qualified_Identifier=(ex. "Individual_ID")
13 ; IEN=the IEN of the entity who owns the NPI.
14 ; If there are multiple entities who own the NPI, there will
15 ; be multiple entries in XUSQIL, delimited by ";".)
16 ; XUSIEN = IEN of entry to which NPI is being assigned
17 ; XUSRSLT = an output array returned if an error or warning message is generated.
18 ; XUSFLAG = If set to 1, indicates that routine is being called from an input transform.
19 ; If set to 2, indicates we're checking the current NPI prior to delete/replace
20 ; If set to 3, indicates we're checking a new NPI (Either ADD or REPLACE).
21 ;
22 ; The function will return:
23 ; 0 - No Error
24 ; 1 - Error
25 ; 2 - Warning
26 ;
27 N XUSGLOB,XUSERR,XUSWARN,XUSFILE,XUSCNT,XUSFILI,XUSNEWPT,ZZ,X,I
28 N XUSOU,XUSOAI,XUSOIEN,XUSOQID,XUSOPT
29 K XUSRSLT
30 ; If NPI is not already in use, quit 0 (no error)
31 I XUSQIL=0 Q 0
32 ; If NPI is malformed, quit 1 (error)
33 I +XUSQIL=0,$P(XUSQIL,U,2)="Invalid NPI" D Q 1
34 . S XUSRSLT(1)="NPI values have a specific structure to validate them..."
35 . S XUSRSLT(2)="The Checksum for this entry is not valid"
36 . Q
37 D GETLST^XPAR(.ZZ,"PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER")
38 S ZZ=""
39 F S ZZ=$O(ZZ(ZZ)) Q:ZZ'>0 I $P(ZZ(ZZ),U)=XUSQID Q
40 I ZZ'>0 S XUSRSLT(1)="Invalid 'Qualified Identifier' Input Parameter "_XUSQID_" passed." Q 1
41 S XUSFLAG=+$G(XUSFLAG)
42 S XUSIEN=+$G(XUSIEN)
43 ; If user being updated is NON-VA Provider, get their Provider Type and file name
44 S XUSNEWPT=0,XUSFILI=""
45 ; Read through list of entities that already own the NPI
46 S (XUSERR,XUSWARN,XUSCNT)=0
47 F I=1:1 S XUSOU=$P(XUSQIL,";",I) Q:XUSOU=""!(XUSERR) D
48 . ; Get Qualified Identifier, IEN and Active/Inactive flag for other entity who owns the NPI
49 . S XUSOQID=$P(XUSOU,U)
50 . S XUSOIEN=+$P(XUSOU,U,2)
51 . S XUSOAI=$P(XUSOU,U,4)
52 . ; Find Qualified Identifier of file that already owns the NPI in the list of valid QIs
53 . S ZZ="" F S ZZ=$O(ZZ(ZZ)) Q:ZZ'>0 I $P(ZZ(ZZ),U)=XUSOQID Q
54 . I ZZ'>0 D Q
55 . . S XUSERR=1
56 . . S XUSRSLT(1)="Invalid Qualified Identifier "_XUSOQID_" returned from $$QI^XUSNPI" Q
57 . ; Get global reference for file that owns NPI
58 . S XUSGLOB="^"_$P(ZZ(ZZ),U,2)
59 . ; If called from the input transform, and an entity is trying to enter an NPI they
60 . ; have previously held, it's not an error, unless NPI is inactive.
61 . I XUSFLAG=1,XUSQID=XUSOQID,XUSIEN=XUSOIEN,XUSOAI'="Inactive" Q
62 . ; Put provider type information into XUSOPT to generate error/warning
63 . S XUSOPT=0
64 . I XUSFLAG'=1 D
65 . . I XUSOQID="Individual_ID" S XUSOPT="2^"
66 . . I XUSOQID="Organization_ID" S XUSOPT="1^"
67 . . I XUSOQID="Non_VA_Provider_ID" S XUSOPT=$$GETPT(XUSOIEN)
68 . . Q
69 . ; If editing a VA Provider, and a non-VA Provider has same current NPI, build both the
70 . ; warning a user sees prior to replacing or deleting the current NPI, and the warning
71 . ; the user will see after replacing the NPI.
72 . I XUSFLAG=2 D Q
73 . . Q:XUSOQID'="Non_VA_Provider_ID"
74 . . D MSGOLD(XUSNPI,XUSGLOB,XUSOIEN,.XUSCNT,XUSOPT,XUSOAI,.XUSRSLT)
75 . . S XUSWARN=1
76 . . Q
77 . ; If an entity in the same file owns the NPI, it's an error.
78 . I $P(XUSOU,U)=XUSQID D Q
79 . . D:XUSFLAG'=1 MSGNEW(XUSNPI,XUSGLOB,XUSOIEN,.XUSCNT,.XUSRSLT,XUSOPT)
80 . . S XUSERR=1 Q
81 . ; If an entity in the INSTITUTION file (#4) already owns the NPI, it's an error.
82 . I $P(XUSOU,U)="Organization_ID" D Q
83 . . D:XUSFLAG'=1 MSGNEW(XUSNPI,XUSGLOB,XUSOIEN,.XUSCNT,.XUSRSLT,XUSOPT)
84 . . S XUSERR=1 Q
85 . ; If new entry being edited is a VA INSTITUTION and any other entity owns the NPI, it's an error
86 . I XUSQID="Organization_ID" D Q
87 . . D:XUSFLAG'=1 MSGNEW(XUSNPI,XUSGLOB,XUSOIEN,.XUSCNT,.XUSRSLT,XUSOPT)
88 . . S XUSERR=1 Q
89 . ; Providers in file 200 or 355.93 can share an NPI. If NPI in file 355.93 is Active,
90 . ; issue a warning, if inactive, issue an error
91 . I XUSFLAG'=1 D MSGNEW(XUSNPI,XUSGLOB,XUSOIEN,.XUSCNT,.XUSRSLT,XUSOPT,XUSOAI)
92 . I XUSOAI="Inactive" S XUSERR=1 Q
93 . S XUSWARN=1
94 . Q
95 I XUSERR Q 1
96 I XUSWARN Q 2
97 Q 0
98 ;
99GETPT(XUSIEN) ; Get provider type for entry in IB NON/OTHER VA BILLING PROVIDER file
100 N PT
101 S PT=+$$GET1^DIQ(355.93,XUSIEN_",",.02,"I")
102 ; Null provider type returned as 3.
103 I PT=1 S PT="1^the FACILITY/GROUP provider "
104 E I PT=2 S PT="2^the INDIVIDUAL provider "
105 E S PT="3^"
106 K ^TMP("DIERR",$J)
107 Q PT
108 ;
109GETPER(XUSOWNKY) ; Return names of people who own the security key IB PROVIDER EDIT
110 N XUSIEN,X
111 F XUSIEN=0:0 S XUSIEN=$O(^XUSEC("IB PROVIDER EDIT",XUSIEN)) Q:'XUSIEN D
112 . Q:$G(^VA(200,XUSIEN,0))=""
113 . ; Don't return TERMINATED or DISUSERed users
114 . S X=$$ACTIVE^XUSER(XUSIEN)
115 . I X=""!($P(X,U)=0) Q
116 . ; Put users IENs into output array
117 . S XUSOWNKY(XUSIEN)="" Q
118 Q
119 ;
120MSGOLD(XUSNPI,XUSGLOB,XUSIEN,XUSCNT,XUSOPT,XUSOAI,XUSRSLT) ;
121 ; Generate warning message to display prior to REPLACE/DELETE NPI prompt, when the current
122 ; NPI is also used by a non-va provider
123 N XUSFILE,XUSOWNKY,I,J,X
124 S XUSFILE=$P(@(XUSGLOB_"0)"),U)
125 S X=""
126 S:$G(XUSOPT) X=$P(XUSOPT,U,2)
127 S XUSCNT=XUSCNT+1,XUSRSLT(XUSCNT)="The NPI of "_XUSNPI_" is also associated with "_X
128 S XUSCNT=XUSCNT+1,XUSRSLT(XUSCNT)=$P(@(XUSGLOB_XUSIEN_",0)"),U)
129 I XUSOAI="Inactive" S XUSRSLT(XUSCNT)=XUSRSLT(XUSCNT)_" as INACTIVE"
130 S XUSRSLT(XUSCNT)=XUSRSLT(XUSCNT)_" in the "_XUSFILE_" file."
131 S XUSCNT=XUSCNT+2
132 ; Generate warning message to display after REPLACE NPI, when the current NPI
133 ; is also used by a non-va provider
134 ;
135 S I=$O(XUSRSLT("X",999999999999),-1)
136 S XUSRSLT("X",I+1)="Warning: NPI "_XUSNPI_" is also associated with provider "_$P(@(XUSGLOB_XUSIEN_",0)"),U)_"."
137 S XUSRSLT("X",I+2)=""
138 S XUSRSLT("X",I+3)="A Mailman message has been sent to holders of the ""IB PROVIDER EDIT"""
139 S XUSRSLT("X",I+4)="security key."
140 S I=$O(XUSRSLT("XMSG",999999999999),-1)
141 S XUSRSLT("XMSG",I+1,0)="The NPI "_XUSNPI_" was ^ for ^ in"
142 S XUSRSLT("XMSG",I+2,0)="the NEW PERSON file. The NPI "_XUSNPI_" is also associated with"
143 S XUSRSLT("XMSG",I+3,0)=$P(@(XUSGLOB_XUSIEN_",0)"),U)_" in the "_XUSFILE_" file."
144 S XUSRSLT("XMSG",I+4,0)=" "
145 S XUSRSLT("XMSG",I+5,0)="The same change may need to be made to the "_XUSFILE
146 S XUSRSLT("XMSG",I+6,0)="using the PROVIDER ID MAINTENANCE option."
147 ; Get names of persons to notify
148 D GETPER(.XUSOWNKY)
149 S I=$O(XUSRSLT("XRCPT",999999999999),-1)
150 F J=0:0 S J=$O(XUSOWNKY(J)) Q:'J S I=I+1,XUSRSLT("XRCPT",I)=J
151 Q
152 ;
153MSGNEW(XUSNPI,XUSGLOB,XUSIEN,XUSCNT,XUSRSLT,XUSOPT,XUSOAI) ;
154 ; Generate error or warning message when new NPI is in use.
155 N XUSFILE,X
156 S XUSFILE=$P(@(XUSGLOB_"0)"),U)
157 S X=""
158 S:$G(XUSOPT) X=$P(XUSOPT,U,2)
159 I $G(XUSOAI)="" D Q
160 . S XUSRSLT(XUSCNT+1)="The NPI of "_XUSNPI_" is now, or was in the past, associated with"
161 . S XUSRSLT(XUSCNT+2)=X_$P(@(XUSGLOB_XUSIEN_",0)"),U)_" in the "_XUSFILE_" file."
162 . S XUSCNT=XUSCNT+2
163 . Q
164 S XUSRSLT(XUSCNT+1)="The NPI of "_XUSNPI_" is also associated with "_X
165 S XUSRSLT(XUSCNT+2)=$P(@(XUSGLOB_XUSIEN_",0)"),U)_" in the "_XUSFILE_" file."
166 S XUSCNT=XUSCNT+2
167 I XUSOAI="Inactive" D Q
168 . S XUSCNT=XUSCNT+1,XUSRSLT(XUSCNT)="This NPI is INACTIVE and may not be used."
169 . Q
170 Q
171 ;
172 ;
Note: See TracBrowser for help on using the repository browser.