Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSNPIE1

XUSNPIE1.m

Go to the documentation of this file. 
  1. XUSNPIE1 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;3/31/2021
  1.  ;;8.0;KERNEL;**420,410,435,454,462,480,753**; July 10, 1995;Build 1
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  Q
  1.  ;
  1. SET(XUSIEN,XUSNPI) ;
  1.  ; set value for NPI related fields (#41.97-41.99) in file #200
  1.  N XUSFDA,XUSIENS,X
  1.  S X=$G(^VA(200,XUSIEN,"NPI"))
  1.  S XUSIENS=XUSIEN_","
  1.  S XUSFDA(200,XUSIENS,41.99)=XUSNPI
  1.  S XUSFDA(200,XUSIENS,41.98)="D"
  1.  S XUSFDA(200,XUSIENS,41.97)=1
  1.  D FILE^DIE("","XUSFDA")
  1.  Q
  1.  ;
  1. SET1(XUSIEN,XUSNPI) ;
  1.  ; set value for NPI field (#41.99) in file #4
  1.  N OLDNPI S OLDNPI=$P($G(^DIC(4,XUSIEN,"NPI")),"^")
  1.  I OLDNPI K ^DIC(4,"ANPI",OLDNPI,XUSIEN)
  1.  S ^DIC(4,XUSIEN,"NPI")=XUSNPI,^DIC(4,"ANPI",XUSNPI,XUSIEN)=""
  1.  Q
  1.  ;
  1. SIGNON ; .ACT - run at user sign-on display message if NEEDS AN NPI
  1.  N XVAL,DATETIME,OPT,XVALTIME
  1.  I $$CHEKNPI^XUSNPIED(DUZ) W !!,"To enter your NPI value enter  NPI  at a menu prompt to jump to the",!,"edit option.",! H 1
  1.  ; following to insure CBO List is scheduled to run on first day of month
  1.  S XVALTIME=$E(DT,6,7) I '((XVALTIME="01")!(XVALTIME="15")) Q
  1.  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
  1.  . 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
  1.  . S DATETIME=$$GET1^DIQ(19.2,OPT_",",2)
  1.  . 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
  1.  . I '$$GET1^DIQ(19.2,OPT_",",99.1) L +^DIC(19.2,OPT):0 Q:'$T  D  L -^DIC(19.2,OPT)
  1.  . . D SETQUEUE(OPT,"@")
  1.  . . D SETQUEUE(OPT,DT_".2")
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. SETQUEUE(OPT,VALUE) ;
  1.  N FDA S FDA(19.2,OPT_",",2)=VALUE D FILE^DIE("","FDA")
  1.  Q
  1.  ;
  1. POSTINIT ;
  1.  N XUGLOB,XUUSER,XIEN,X,ZTDESC,ZTDTH,ZTIO,ZTRTN
  1.  ;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","")
  1.  ;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","","")
  1.  ; get global containing Taxonomy values
  1.  S XUGLOB=$$CHKGLOB^XUSNPIED()
  1.  ; go through file 200 and ma
  1.  S XUUSER=0 F  S XUUSER=$O(^VA(200,XUUSER)) Q:XUUSER'>0  I $$ACTIVE^XUSER(XUUSER) D DOUSER^XUSNPIED(XUUSER,XUGLOB)
  1.  ; and send CBO a starting point list
  1.  ;S ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="CBOLIST^XUSNPIED",ZTDESC="XUS NPI CBOLIST MESSAGE GENERATION" D ^%ZTLOAD
  1.  ; set up to generate CBO list monthly
  1.  D CBOQUEUE
  1.  Q
  1.  ;
  1. CBOQUEUE ;
  1.  N FDA,XUSVAL
  1.  ; check for already queued
  1.  S XUSVAL=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I XUSVAL>0 D  Q
  1.  . S FDA(19.2,XUSVAL_",",2)=$$SETDATE()
  1.  . S FDA(19.2,XUSVAL_",",6)="1M(1@2000,15@2000)"
  1.  . N ZTQUEUED S ZTQUEUED=1 D FILE^DIE("","FDA") K ZTQUEUED
  1.  . Q
  1.  ; no set up queued job
  1.  S XUSVAL=$$FIND1^DIC(19,"","","XUS NPI CBO LIST") Q:XUSVAL'>0  S FDA(19.2,"+1,",.01)=XUSVAL
  1.  S FDA(19.2,"+1,",2)=$$SETDATE()
  1.  S FDA(19.2,"+1,",6)="1M(1@2000,15@2000)"
  1.  N ZTQUEUED S ZTQUEUED=1 D UPDATE^DIE("","FDA") K ZTQUEUED
  1.  Q
  1.  ;
  1. SETDATE() ;
  1.  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"
  1.  ;
  1. CHKOLD1(IEN) ;
  1.  D CHKOLD1^XUSNPIE2(IEN)
  1.  Q
  1.  ;
  1. CLERXMPT ;
  1.  D CLERXMPT^XUSNPIE2
  1.  Q
  1.  ;
  1. CHKDGT(XUSNPI,XUSDA,XUSQI) ; INPUT TRANSFORM
  1.  N XUS S XUS=$$CHKDGT^XUSNPI(XUSNPI)
  1.  I XUS'>0 Q 0
  1.  N XUSQIK S XUSQIK=$$QI^XUSNPI(XUSNPI) I XUSQIK=0 Q 1
  1.  ; Check whether NPI is already being used. If so, issue error or warning.
  1.  N NPIUSED,XUSRSLT
  1.  S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,XUSQI,XUSQIK,XUSDA,.XUSRSLT,1)
  1.  ; If an error was encountered, quit 0.
  1.  I NPIUSED=1 Q 0
  1.  ; If a warning was encountered, quit 1 (Person on file 200 and 355.93 can share NPI)
  1.  I NPIUSED=2 Q 1
  1.  I XUSDA=$P(XUSQIK,"^",2) Q 1  ; p753
  1.  ; If current provider previously had this NPI, make sure the NPI being added is the most
  1.  ; current one in the EFFECTIVE DATE/TIME multiple (history).
  1.  N XUSROOT S XUSROOT=$$GET^XPAR("PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER",XUSQI)
  1.  I $E(XUSROOT)'="^" S XUSROOT="^"_XUSROOT
  1.  N XUS1 S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_"""A"""_")"
  1.  N XUS2 S XUS2=$O(@XUS1,-1) I XUS2'>0 Q 1
  1.  S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_XUS2_","_0_")"
  1.  S XUS2=$G(@XUS1) I $P(XUS2,"^",3)=XUSNPI Q 1
  1.  Q 0