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

VBECRPCE.m

Go to the documentation of this file. 
  1. VBECRPCE ;HOIFO/BNT-Lookup PROVIDERS based on DIVISION ;22 March 2004
  1.  ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1.  ;
  1.  ; Note: This routine supports data exchange with an FDA registered
  1.  ; medical device. As such, it may not be changed in any way without
  1.  ; prior written approval from the medical device manufacturer.
  1.  ; 
  1.  ; Integration Agreements:
  1.  ; Reference DBIA 10076 - XUSEC GLOBAL READ
  1.  ; Reference DBIA 10060 - NEW PERSON FILE
  1.  ; Reference DBIA 10090 - INSTITUTION FILE
  1.  ; Reference DBIA 2051  - LIST^DIC
  1.  ; Reference to $$UP^XLFSTR is supported by IA: 10104
  1.  ; Reference to $$FIND1^DIC supported by IA #2051
  1.  ; Reference to $$FIND1^DIC supported by IA #2051
  1.  ; Reference to ^DIC(4 supported by IA #10090
  1.  ;
  1.  ; This routine should not be called from the top.
  1.  QUIT
  1.  ;
  1.  ; ----------------------------------------------------------------
  1.  ;       Private Method supports IA 4617
  1.  ; ----------------------------------------------------------------
  1. PROVIDER(RESULTS,DIV,DATA) ;
  1.  ; Look up and return all active providers by division
  1.  ;
  1.  ; Input: RESULTS = Passed by reference used to return data to VistALink
  1.  ;                  as XML.
  1.  ;        DIV     = (Required) Station number of Division used to
  1.  ;                   locate providers
  1.  ;        DATA    = (Optional) Text string used to perform lookup. If
  1.  ;                   null, will return all providers for division.
  1.  ;
  1.  ; Screen Logic:  Only returns users from file 200 that hold the
  1.  ;                PROVIDER Security Key, do not have a TERMINATION
  1.  ;                DATE prior to the current date, and have access to
  1.  ;                the Division passed in the DIV parameter.
  1.  ;
  1.  ;
  1.  S VBECCNT=0
  1.  S RESULTS=$NA(^TMP("VBECS_PROVIDERS",$J))
  1.  K @RESULTS
  1.  D BEGROOT^VBECRPC("Providers")
  1.  ;
  1.  ; Get INSTITUTION file pointer for DIV parameter.
  1.  K ERR S DIVIEN=$$FIND1^DIC(4,,"QX",.DIV,"D",,"ERR")
  1.  I $D(ERR) D  Q
  1.  . D ADD^VBECRPC("<Record count='0' >")
  1.  . D ERROR^VBECRPC(ERR("DIERR",1,"TEXT",1))
  1.  . D ENDROOT^VBECRPC("Record"),ENDROOT^VBECRPC("Providers")
  1.  . Q
  1.  ; Perform the search
  1.  D PRVSRCH(DATA,DIVIEN)
  1.  ;
  1.  D ENDROOT^VBECRPC("Providers")
  1.  D KILL
  1.  Q
  1.  ;
  1. PRVSRCH(DATA,DIVIEN) ;
  1.  ; Get list of PROVIDER's based on DATA and DIVIEN input
  1.  ;             
  1.  ;
  1.  N DD,ERR
  1.  I '$D(VBECCNT) S VBECCNT=0
  1.  S DD=200
  1.  I $D(DATA) S DATA=$$UP^XLFSTR(DATA)
  1.  S SCREEN="I $$PRVSCR^VBECRPCE(+Y)"
  1.  D LIST^DIC(DD,"","@;.01","P","","",.DATA,"B",.SCREEN,"","","ERR")
  1.  I $D(ERR) D  Q
  1.  . D ADD^VBECRPC("<Record count='0' >")
  1.  . D ERROR^VBECRPC(ERR("DIERR",1,"TEXT",1))
  1.  . D ENDROOT^VBECRPC("Record")
  1.  . Q
  1.  ;
  1.  D ADD^VBECRPC("<Record count='"_$$CHARCHK^XOBVLIB(+$P(^TMP("DILIST",$J,0),U))_"' >")
  1.  S X=0
  1.  F  S X=$O(^TMP("DILIST",$J,X)) Q:X=""  D
  1.  . D BEGROOT^VBECRPC("Provider")
  1.  . D ADD^VBECRPC("<ProviderIEN>"_$$CHARCHK^XOBVLIB(+$P(^TMP("DILIST",$J,X,0),U))_"</ProviderIEN>")
  1.  . D ADD^VBECRPC("<ProviderName>"_$$CHARCHK^XOBVLIB($P(^TMP("DILIST",$J,X,0),U,2))_"</ProviderName>")
  1.  . D ENDROOT^VBECRPC("Provider")
  1.  . Q
  1.  D ENDROOT^VBECRPC("Record")
  1.  Q
  1.  ;
  1. PRVSCR(IEN) ; Screens for valid providers
  1.  Q:(IEN']"")!(IEN<0)!('$D(^XUSEC("PROVIDER",IEN))) 0
  1.  Q:'$D(^VA(200,IEN,2,"B",DIVIEN)) 0
  1.  Q $$ACTIVE^XUSER(IEN)
  1.  ;
  1. KILL ; Kill variables
  1.  K VBECCNT,DIVIEN
  1.  K ^TMP("DILIST",$J)
  1.  Q