[613] | 1 | XUSNPI1 ; 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
|
---|
| 4 | NPIUSED(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 | ;
|
---|
| 99 | GETPT(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 | ;
|
---|
| 109 | GETPER(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 | ;
|
---|
| 120 | MSGOLD(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 | ;
|
---|
| 153 | MSGNEW(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 | ;
|
---|