[613] | 1 | XUSNPIE1 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;5/13/08 17:32
|
---|
| 2 | ;;8.0;KERNEL;**420,410,435,454,462,480**; July 10, 1995;Build 38
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | SET(XUSIEN,XUSNPI) ;
|
---|
| 7 | ; set value for NPI related fields (#41.97-41.99) in file #200
|
---|
| 8 | N XUSFDA,XUSIENS,X
|
---|
| 9 | S X=$G(^VA(200,XUSIEN,"NPI"))
|
---|
| 10 | S XUSIENS=XUSIEN_","
|
---|
| 11 | S XUSFDA(200,XUSIENS,41.99)=XUSNPI
|
---|
| 12 | S XUSFDA(200,XUSIENS,41.98)="D"
|
---|
| 13 | S XUSFDA(200,XUSIENS,41.97)=1
|
---|
| 14 | D FILE^DIE("","XUSFDA")
|
---|
| 15 | Q
|
---|
| 16 | ;
|
---|
| 17 | SET1(XUSIEN,XUSNPI) ;
|
---|
| 18 | ; set value for NPI field (#41.99) in file #4
|
---|
| 19 | N OLDNPI S OLDNPI=$P($G(^DIC(4,XUSIEN,"NPI")),"^")
|
---|
| 20 | I OLDNPI K ^DIC(4,"ANPI",OLDNPI,XUSIEN)
|
---|
| 21 | S ^DIC(4,XUSIEN,"NPI")=XUSNPI,^DIC(4,"ANPI",XUSNPI,XUSIEN)=""
|
---|
| 22 | Q
|
---|
| 23 | ;
|
---|
| 24 | SIGNON ; .ACT - run at user sign-on display message if NEEDS AN NPI
|
---|
| 25 | N XVAL,DATETIME,OPT,XVALTIME
|
---|
| 26 | I $$CHEKNPI^XUSNPIED(DUZ) W !!,"To enter your NPI value enter NPI at a menu prompt to jump to the",!,"edit option.",! H 1
|
---|
| 27 | ; following to insure CBO List is scheduled to run on first day of month
|
---|
| 28 | S XVALTIME=$E(DT,6,7) I '((XVALTIME="01")!(XVALTIME="15")) Q
|
---|
| 29 | 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
|
---|
| 30 | . 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
|
---|
| 31 | . S DATETIME=$$GET1^DIQ(19.2,OPT_",",2)
|
---|
| 32 | . 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
|
---|
| 33 | . I '$$GET1^DIQ(19.2,OPT_",",99.1) L +^DIC(19.2,OPT):0 Q:'$T D L -^DIC(19.2,OPT)
|
---|
| 34 | . . D SETQUEUE(OPT,"@")
|
---|
| 35 | . . D SETQUEUE(OPT,DT_".2")
|
---|
| 36 | . . Q
|
---|
| 37 | . Q
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | SETQUEUE(OPT,VALUE) ;
|
---|
| 41 | N FDA S FDA(19.2,OPT_",",2)=VALUE D FILE^DIE("","FDA")
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | POSTINIT ;
|
---|
| 45 | N XUGLOB,XUUSER,XIEN,X,ZTDESC,ZTDTH,ZTIO,ZTRTN
|
---|
| 46 | ;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","")
|
---|
| 47 | ;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","","")
|
---|
| 48 | ; get global containing Taxonomy values
|
---|
| 49 | S XUGLOB=$$CHKGLOB^XUSNPIED()
|
---|
| 50 | ; go through file 200 and ma
|
---|
| 51 | S XUUSER=0 F S XUUSER=$O(^VA(200,XUUSER)) Q:XUUSER'>0 I $$ACTIVE^XUSER(XUUSER) D DOUSER^XUSNPIED(XUUSER,XUGLOB)
|
---|
| 52 | ; and send CBO a starting point list
|
---|
| 53 | ;S ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="CBOLIST^XUSNPIED",ZTDESC="XUS NPI CBOLIST MESSAGE GENERATION" D ^%ZTLOAD
|
---|
| 54 | ; set up to generate CBO list monthly
|
---|
| 55 | D CBOQUEUE
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|
| 58 | CBOQUEUE ;
|
---|
| 59 | N FDA,XUSVAL
|
---|
| 60 | ; check for already queued
|
---|
| 61 | S XUSVAL=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I XUSVAL>0 D Q
|
---|
| 62 | . S FDA(19.2,XUSVAL_",",2)=$$SETDATE()
|
---|
| 63 | . S FDA(19.2,XUSVAL_",",6)="1M(1@2000,15@2000)"
|
---|
| 64 | . N ZTQUEUED S ZTQUEUED=1 D FILE^DIE("","FDA") K ZTQUEUED
|
---|
| 65 | . Q
|
---|
| 66 | ; no set up queued job
|
---|
| 67 | S XUSVAL=$$FIND1^DIC(19,"","","XUS NPI CBO LIST") Q:XUSVAL'>0 S FDA(19.2,"+1,",.01)=XUSVAL
|
---|
| 68 | S FDA(19.2,"+1,",2)=$$SETDATE()
|
---|
| 69 | S FDA(19.2,"+1,",6)="1M(1@2000,15@2000)"
|
---|
| 70 | N ZTQUEUED S ZTQUEUED=1 D UPDATE^DIE("","FDA") K ZTQUEUED
|
---|
| 71 | Q
|
---|
| 72 | ;
|
---|
| 73 | SETDATE() ;
|
---|
| 74 | 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"
|
---|
| 75 | ;
|
---|
| 76 | CHKOLD1(IEN) ;
|
---|
| 77 | D CHKOLD1^XUSNPIE2(IEN)
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | CLERXMPT ;
|
---|
| 81 | D CLERXMPT^XUSNPIE2
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | CHKDGT(XUSNPI,XUSDA,XUSQI) ; INPUT TRANSFORM
|
---|
| 85 | N XUS S XUS=$$CHKDGT^XUSNPI(XUSNPI)
|
---|
| 86 | I XUS'>0 Q 0
|
---|
| 87 | N XUSQIK S XUSQIK=$$QI^XUSNPI(XUSNPI) I XUSQIK=0 Q 1
|
---|
| 88 | ; Check whether NPI is already being used. If so, issue error or warning.
|
---|
| 89 | N NPIUSED,XUSRSLT
|
---|
| 90 | S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,XUSQI,XUSQIK,XUSDA,.XUSRSLT,1)
|
---|
| 91 | ; If an error was encountered, quit 0.
|
---|
| 92 | I NPIUSED=1 Q 0
|
---|
| 93 | ; If a warning was encountered, quit 1 (Person on file 200 and 355.93 can share NPI)
|
---|
| 94 | I NPIUSED=2 Q 1
|
---|
| 95 | ; If current provider previously had this NPI, make sure the NPI being added is the most
|
---|
| 96 | ; current one in the EFFECTIVE DATE/TIME multiple (history).
|
---|
| 97 | N XUSROOT S XUSROOT=$$GET^XPAR("PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER",XUSQI)
|
---|
| 98 | I $E(XUSROOT)'="^" S XUSROOT="^"_XUSROOT
|
---|
| 99 | N XUS1 S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_"""A"""_")"
|
---|
| 100 | N XUS2 S XUS2=$O(@XUS1,-1) I XUS2'>0 Q 1
|
---|
| 101 | S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_XUS2_","_0_")"
|
---|
| 102 | S XUS2=$G(@XUS1) I $P(XUS2,"^",3)=XUSNPI Q 1
|
---|
| 103 | Q 0
|
---|