| 1 | XUSNPIE1 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;05/02/07
|
|---|
| 2 | ;;8.0;KERNEL;**420,410,435,454,462**; July 10, 1995;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | SET(XUSIEN,XUSNPI) ;
|
|---|
| 7 | ; set value for NPI field (#41.99) in file #200
|
|---|
| 8 | N OLDNPI S OLDNPI=$P($G(^VA(200,XUSIEN,"NPI")),"^")
|
|---|
| 9 | I OLDNPI K ^VA(200,"ANPI",OLDNPI,XUSIEN)
|
|---|
| 10 | S ^VA(200,XUSIEN,"NPI")=XUSNPI_U_"D",^VA(200,"ANPI",XUSNPI,XUSIEN)=""
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | SET1(XUSIEN,XUSNPI) ;
|
|---|
| 14 | ; set value for NPI field (#41.99) in file #4
|
|---|
| 15 | N OLDNPI S OLDNPI=$P($G(^DIC(4,XUSIEN,"NPI")),"^")
|
|---|
| 16 | I OLDNPI K ^DIC(4,"ANPI",OLDNPI,XUSIEN)
|
|---|
| 17 | S ^DIC(4,XUSIEN,"NPI")=XUSNPI,^DIC(4,"ANPI",XUSNPI,XUSIEN)=""
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | SIGNON ; .ACT - run at user sign-on display message if NEEDS AN NPI
|
|---|
| 21 | N XVAL,DATETIME,OPT,XVALTIME
|
|---|
| 22 | I $$CHEKNPI^XUSNPIED(DUZ) W !!,"To enter your NPI value enter NPI at a menu prompt to jump to the",!,"edit option.",! H 1
|
|---|
| 23 | ; following to insure CBO List is scheduled to run on first day of month
|
|---|
| 24 | S XVALTIME=$E(DT,6,7) I '((XVALTIME="01")!(XVALTIME="15")) Q
|
|---|
| 25 | S XVAL=+$E($$NOW^XLFDT(),6,10) I XVAL>(XVALTIME_".19"),XVAL<(XVALTIME_".1958") D ; 7 PM TO 7:58 PM ON 1ST OF MONTH
|
|---|
| 26 | . S OPT=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I OPT'>0 L +^TMP("XUS NPI CBO LOCK"):0 Q:'$T D CBOQUEUE L -^TMP("XUS NPI CBO LOCK") Q
|
|---|
| 27 | . S DATETIME=$$GET1^DIQ(19.2,OPT_",",2)
|
|---|
| 28 | . I DATETIME'=$$FMTE^XLFDT(DT_".2") L +^DIC(19.2,OPT):0 Q:'$T D SETQUEUE(OPT,DT_".2") L -^DIC(19.2,OPT) Q
|
|---|
| 29 | . I '$$GET1^DIQ(19.2,OPT_",",99.1) L +^DIC(19.2,OPT):0 Q:'$T D L -^DIC(19.2,OPT)
|
|---|
| 30 | . . D SETQUEUE(OPT,"@")
|
|---|
| 31 | . . D SETQUEUE(OPT,DT_".2")
|
|---|
| 32 | . . Q
|
|---|
| 33 | . Q
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SETQUEUE(OPT,VALUE) ;
|
|---|
| 37 | N FDA S FDA(19.2,OPT_",",2)=VALUE D FILE^DIE("","FDA")
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | POSTINIT ;
|
|---|
| 41 | N XUGLOB,XUUSER,XIEN,X,ZTDESC,ZTDTH,ZTIO,ZTRTN
|
|---|
| 42 | ;S XIEN=$$FIND1^DIC(19,"","","XUCOMMAND") I XIEN>0,$$FIND1^DIC(19.01,","_XIEN_",","","XUS NPI PROVIDER SELF ENTRY")'>0 S X=$$ADD^XPDMENU("XUCOMMAND","XUS NPI PROVIDER SELF ENTRY","NPI","")
|
|---|
| 43 | ;S XIEN=$$FIND1^DIC(19,"","","XU USER SIGN-ON") I XIEN>0,$$FIND1^DIC(19.01,","_XIEN_",","","XUS NPI SIGNON CHECK")'>0 S X=$$ADD^XPDMENU("XU USER SIGN-ON","XUS NPI SIGNON CHECK","","")
|
|---|
| 44 | ; get global containing Taxonomy values
|
|---|
| 45 | S XUGLOB=$$CHKGLOB^XUSNPIED()
|
|---|
| 46 | ; go through file 200 and ma
|
|---|
| 47 | S XUUSER=0 F S XUUSER=$O(^VA(200,XUUSER)) Q:XUUSER'>0 I $$ACTIVE^XUSER(XUUSER) D DOUSER^XUSNPIED(XUUSER,XUGLOB)
|
|---|
| 48 | ; and send CBO a starting point list
|
|---|
| 49 | ;S ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="CBOLIST^XUSNPIED",ZTDESC="XUS NPI CBOLIST MESSAGE GENERATION" D ^%ZTLOAD
|
|---|
| 50 | ; set up to generate CBO list monthly
|
|---|
| 51 | D CBOQUEUE
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | CBOQUEUE ;
|
|---|
| 55 | N FDA,XUSVAL
|
|---|
| 56 | ; check for already queued
|
|---|
| 57 | S XUSVAL=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I XUSVAL>0 D Q
|
|---|
| 58 | . S FDA(19.2,XUSVAL_",",2)=$$SETDATE()
|
|---|
| 59 | . S FDA(19.2,XUSVAL_",",6)="1M(1@2000,15@2000)"
|
|---|
| 60 | . N ZTQUEUED S ZTQUEUED=1 D FILE^DIE("","FDA") K ZTQUEUED
|
|---|
| 61 | . Q
|
|---|
| 62 | ; no set up queued job
|
|---|
| 63 | S XUSVAL=$$FIND1^DIC(19,"","","XUS NPI CBO LIST") Q:XUSVAL'>0 S FDA(19.2,"+1,",.01)=XUSVAL
|
|---|
| 64 | S FDA(19.2,"+1,",2)=$$SETDATE()
|
|---|
| 65 | S FDA(19.2,"+1,",6)="1M(1@2000,15@2000)"
|
|---|
| 66 | N ZTQUEUED S ZTQUEUED=1 D UPDATE^DIE("","FDA") K ZTQUEUED
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | SETDATE() ;
|
|---|
| 70 | Q $S($E($$NOW^XLFDT(),6,10)<1.2:DT,$E($$NOW^XLFDT(),6,10)<15.2:$E(DT,1,5)_"15",$E(DT,4,5)>11:(($E(DT,1,3)+1)_"0101"),1:($E(DT,1,5)+1)_"01")_".2"
|
|---|
| 71 | ;
|
|---|
| 72 | EDITNPI(IEN) ; main entry of NPI value
|
|---|
| 73 | ; IEN is the internal entry number in file 200 for the provider
|
|---|
| 74 | ;
|
|---|
| 75 | N DATEVAL,DESCRIP,DONE,NPIVAL1,NPIVAL2,PROVNAME,XX,Y,CURRNPI
|
|---|
| 76 | N ODATEVAL,OIEN,OLDNPI,XUSNONED,DIR,ADDNPI,DELETNPI,NOOLDNPI,XUSQI
|
|---|
| 77 | S ADDNPI=1,DELETNPI=2,NOOLDNPI=0
|
|---|
| 78 | S PROVNAME=$$GET1^DIQ(200,IEN_",",.01)
|
|---|
| 79 | ;I $$ACTIVE^XUSER(IEN) W !,"This user isn't currently active" Q
|
|---|
| 80 | 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
|
|---|
| 81 | I $$NPISTATS^XUSNPIED(IEN)="D" S XUSNONED=1
|
|---|
| 82 | 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
|
|---|
| 83 | S OLDNPI=NOOLDNPI I $$NPISTATS^XUSNPIED(IEN)="D" D Q:OLDNPI=NOOLDNPI ; exit without changing
|
|---|
| 84 | . N I,X,DIR
|
|---|
| 85 | . S CURRNPI=$$GET1^DIQ(200,IEN_",",41.99) I CURRNPI="" Q
|
|---|
| 86 | . 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)
|
|---|
| 87 | . I '$D(ODATEVAL) S OLDNPI=2 ; can't find entry in multiple, delete entry at top
|
|---|
| 88 | . W !,"This provider already has an NPI value (",CURRNPI,") entered."
|
|---|
| 89 | . ;S DIR(0)="Y",DIR("A")="Do you want to ADD a new NPI value as the active one",DIR("B")="NO" D ^DIR S OLDNPI=Y Q:OLDNPI
|
|---|
| 90 | . ;K DIR S DIR(0)="Y",DIR("A")="Do you REALLY want to **DELETE** this NPI value",DIR("B")="NO" D ^DIR I Y S OLDNPI=2
|
|---|
| 91 | . S DIR(0)="S^D:Delete;R:Replace",DIR("A")="Do you want to (D)elete or (R)eplace this NPI value?",DIR("?")="Enter either D or R or ^ to quit with out editing"
|
|---|
| 92 | . S DIR("?",1)="If the value was entered for the incorrect individual, it should be Deleted.",DIR("?",2)="Otherwise it should be Replaced"
|
|---|
| 93 | . D ^DIR K DIR Q:"DR"'[Y I Y="R" S OLDNPI=ADDNPI Q
|
|---|
| 94 | . 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"
|
|---|
| 95 | . S DIR("?",1)="If the NPI value was entered for the incorrect individual, respond E,",DIR("?",2)="otherwise enter V"
|
|---|
| 96 | . D ^DIR K DIR Q:"EV"'[Y I Y="V" S Y=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,$$NOW^XLFDT(),0) D S OLDNPI=NOOLDNPI Q
|
|---|
| 97 | . . W !,$S(Y>-1:"Entry has been marked inactive.",1:$P(Y,U,2)),! Q:+Y=-1
|
|---|
| 98 | . . N XUFDA S XUFDA(200,IEN_",",41.98)="@",XUFDA(200,IEN_",",41.99)="@" D FILE^DIE("","XUFDA") S Y=$$CHEKNPI^XUSNPIED(IEN)
|
|---|
| 99 | . . Q
|
|---|
| 100 | . S OLDNPI=DELETNPI
|
|---|
| 101 | . Q
|
|---|
| 102 | I $$CHEKNPI^XUSNPIED(IEN)=0,OLDNPI=0 W !,"Need for an NPI value isn't indicated - but you can enter an NPI",$C(7)
|
|---|
| 103 | I IEN'=DUZ 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
|
|---|
| 104 | ;I IEN'=DUZ W !,"Status: Active"
|
|---|
| 105 | S DONE=0 I OLDNPI'=DELETNPI F R !,"Enter NPI (10 digits): ",NPIVAL1:DTIME Q:'$T Q:NPIVAL1="" Q:NPIVAL1=U D Q:DONE
|
|---|
| 106 | . I NPIVAL1'?10N D Q
|
|---|
| 107 | . . W !,$C(7),"Enter a 10 digit National Provider Identifier which is obtained ",!,"from 'https://nppes.cms.hhs.gov/NPPES/Welcome.do'"
|
|---|
| 108 | . . 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
|
|---|
| 109 | . . R !,"Enter a nine (9) digit number as the base: ",Y:DTIME Q:Y'?9N
|
|---|
| 110 | . . W !,"The complete NPI value is: ",Y_$$CKDIGIT^XUSNPI(Y),!
|
|---|
| 111 | . . Q
|
|---|
| 112 | . S XUSQI=$$QI^XUSNPI(NPIVAL1) I +XUSQI=0,$P(XUSQI,U,2)="Invalid NPI" W !,"NPI values have a specific structure to validate them...",!,"The Checksum for this entry is not valid",! Q
|
|---|
| 113 | . I XUSQI'=0 N ZZ,DONE1 S DONE1=0 D GETLST^XPAR(.ZZ,"PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER") D Q:DONE1
|
|---|
| 114 | . . S ZZ="" F S ZZ=$O(ZZ(ZZ)) Q:ZZ'>0 I $P(ZZ(ZZ),U)=$P(XUSQI,U) W !,"That NPI value is already associated with "_$P(@("^"_$P(ZZ(ZZ),U,2)_$P(XUSQI,U,2)_",0)"),U) S DONE1=1 Q
|
|---|
| 115 | . . Q
|
|---|
| 116 | . R !,"Please re-enter NPI : ",NPIVAL2:DTIME Q:'$T I NPIVAL1'=NPIVAL2 W !,"Values do not match!" Q
|
|---|
| 117 | . S DONE=1
|
|---|
| 118 | . Q
|
|---|
| 119 | I OLDNPI=DELETNPI D
|
|---|
| 120 | . I $D(ODATEVAL) D S Y=$$CHEKNPI^XUSNPIED(IEN) Q
|
|---|
| 121 | . . 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
|
|---|
| 122 | . . D DELETNPI^XUSNPIE2(IEN,OIEN,ODATEVAL)
|
|---|
| 123 | . . D CHKOLD1(IEN) ; check for earlier value, and activate if present
|
|---|
| 124 | . . W !,"Entry was DELETED..."
|
|---|
| 125 | . . Q
|
|---|
| 126 | . D DELETNPI^XUSNPIE2(IEN) ; clean up where no entry in multiple
|
|---|
| 127 | . W !,"Entry was DELETED..."
|
|---|
| 128 | . Q
|
|---|
| 129 | I 'DONE Q
|
|---|
| 130 | ;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
|
|---|
| 131 | S DATEVAL=$$NOW^XLFDT()
|
|---|
| 132 | ; mark previous NPI value as inactive
|
|---|
| 133 | I OLDNPI=ADDNPI S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,CURRNPI,DATEVAL,0) ; set status to INACTIVE
|
|---|
| 134 | S DONE=$$ADDNPI^XUSNPI("Individual_ID",IEN,NPIVAL1,DATEVAL) I +DONE=-1 W !,"Problem writing that value into the database! -- It was **NOT** recorded.",!,$P(DONE,U,2) Q
|
|---|
| 135 | W !!,"For provider ",PROVNAME," "_$S('$D(XUSNONED):"(who requires an NPI), ",1:"")_"the NPI ",NPIVAL1,!,"was saved to VistA successfully."
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | CHKOLD1(IEN) ;
|
|---|
| 139 | D CHKOLD1^XUSNPIE2(IEN)
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | CLERXMPT ;
|
|---|
| 143 | D CLERXMPT^XUSNPIE2
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | CHKDGT(XUSNPI,XUSDA,XUSQI) ; INPUT TRANSFORM
|
|---|
| 147 | N XUS S XUS=$$CHKDGT^XUSNPI(XUSNPI)
|
|---|
| 148 | I XUS'>0 Q 0
|
|---|
| 149 | N XUSQIK S XUSQIK=$$QI^XUSNPI(XUSNPI) I XUSQIK=0 Q 1
|
|---|
| 150 | I XUSQIK'=0,$P(XUSQIK,"^",2)'=XUSDA Q 0 ; return zero if the NPI found and not bellong to the current user
|
|---|
| 151 | N XUSQIK1 S XUSQIK1=$P(XUSQIK,"^")
|
|---|
| 152 | I XUSQI'=XUSQIK1 Q 0
|
|---|
| 153 | I $P($P(XUSQIK,"^",4),";")="Inactive" Q 0
|
|---|
| 154 | N XUSROOT S XUSROOT=$$GET^XPAR("PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER",XUSQIK1)
|
|---|
| 155 | I $E(XUSROOT)'="^" S XUSROOT="^"_XUSROOT
|
|---|
| 156 | N XUS1 S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_"""A"""_")"
|
|---|
| 157 | N XUS2 S XUS2=$O(@XUS1,-1) I XUS2'>0 Q 1
|
|---|
| 158 | S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_XUS2_","_0_")"
|
|---|
| 159 | S XUS2=$G(@XUS1) I $P(XUS2,"^",3)=XUSNPI Q 1
|
|---|
| 160 | Q 0
|
|---|
