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

SDESPROVSEARCH.m

Go to the documentation of this file.
  1. SDESPROVSEARCH ;BAYPINES/KML,MGD,JAS - Get Provider based on Search String ;Apr 5, 2024
  1. ;;5.3;Scheduling;**819,826,877**;Aug 13, 1993;Build 14
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
  1. ; Reference to $$ACTIVE^XUSER is supported by IA #2343
  1. Q
  1. ; rpc = SDES SEARCH PROVIDERS
  1. PROVIDERSEARCH(JSONRETURN,SEARCHSTRING) ;Search for Healthcare Providers and provide return of providers in JSON STRING
  1. ;INPUT - SEARCHSTRING = free text string that represents the provider name that will be searched
  1. ;OUTPUT - JSONRETURN
  1. ; List of Providers from NEW PERSON (#200) File.
  1. ; Field List:
  1. ; (1) Provider Name
  1. ; (2) Provider IEN
  1. ; (3) Office Phone
  1. ; (4) Email Address
  1. ; (5) Title
  1. ; (6) Provider Class
  1. ; (7) Security ID (SECID)
  1. ; (8) Fax
  1. ; (9) Home Phone
  1. ; (10) Commercial Phone
  1. ; (11) Digital Pager
  1. ; (12) Voice Pager
  1. ; (13) Person Class
  1. ; (14) Provider Class
  1. ; (15) User Class
  1. ;
  1. ;
  1. N USERLIST,ERROREXISTS,ERRORLIST,PROVIDERETURN,PROVIDERLIST
  1. K JSONRETURN
  1. S SEARCHSTRING=$G(SEARCHSTRING)
  1. S SEARCHSTRING=$TR(SEARCHSTRING,$C(13)_$C(10)_$C(9),"")
  1. S ERROREXISTS=0
  1. S ERROREXISTS=$$VALIDATEINPUT(.ERRORLIST,SEARCHSTRING)
  1. I ERROREXISTS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.ERRORLIST) Q
  1. D GETUSERLIST(SEARCHSTRING,.USERLIST)
  1. D BLDPROVIDERLIST(.USERLIST,.PROVIDERLIST)
  1. D BUILDRETURN(.PROVIDERLIST,.PROVIDERETURN)
  1. D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.PROVIDERETURN)
  1. Q
  1. ;
  1. VALIDATEINPUT(ERRORLIST,SEARCHSTRING) ; validate incoming parameters
  1. ; input - ERRORLIST = passed in by reference, represents the errors that could be generated when validating the searchstring
  1. ; SEARCHSTRING = represents the name or partial name of the provider
  1. ; returns 0 or 1
  1. ; 0 = no validation errors
  1. ; 1 = validation errors
  1. I ($L(SEARCHSTRING)<3)!($L(SEARCHSTRING)>35) D Q 1
  1. . D ERRLOG^SDESJSON(.ERRORLIST,230)
  1. . S ERRORLIST("Provider",1)=""
  1. Q 0
  1. ;
  1. BLDPROVIDERLIST(USERLIST,PROVIDERLIST) ;
  1. ; input - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
  1. ; PROVIDERLIST = passed by reference, represents the screened list of actual providers that are active
  1. ; output - PROVIDERLIST = array of active providers
  1. N USERDUZ
  1. S USERDUZ=0
  1. F S USERDUZ=$O(USERLIST(USERDUZ)) Q:'USERDUZ I $$SCREEN(USERDUZ,DT) S PROVIDERLIST(USERDUZ)=""
  1. Q
  1. ;
  1. SCREEN(USERDUZ,DATE) ;
  1. ;
  1. ; Selects active providers with an active entry in the NEW PERSON
  1. ; file (#200) for PERSON CLASS.
  1. ;
  1. ; INPUT: USERDUZ = ien of file 200
  1. ; DATE = today's date
  1. ; OUTPUT: 1 to select; 0 to not select
  1. ;
  1. ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
  1. ; The TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
  1. ; will be used to determine if selection is active in the
  1. ; NEW PERSON (#200) file for a given date.
  1. ;
  1. I '+$G(USERDUZ) Q 0
  1. S:'+$G(DATE) DATE=DT
  1. S DATE=$P(DATE,".")
  1. I $$ACTIVPRV^PXAPI(USERDUZ,DATE)&($$ACTIVE^XUSER(USERDUZ)) Q 1
  1. Q 0
  1. ;
  1. BUILDRETURN(PROVIDERLIST,PROVIDERETURN) ;Build return array with provider data
  1. ; input - PROVIDERLIST = array of active providers
  1. ; PROVIDERETURN = passed by reference, represents the array of providers and associated data that will be returned to the client
  1. ; output - PROVIDERETURN = provider array and their associated data to be sent back to the client
  1. ;
  1. N PROVIDERDATA,IEN,IENS,RECORDNUMBER
  1. K INFO
  1. S (RECORDNUMBER,IEN)=0
  1. F S IEN=$O(PROVIDERLIST(IEN)) Q:'IEN D GETS^DIQ(200,IEN_",",".01;.131:.138;.151;8;53.5;205.1","IE","INFO") D
  1. . S RECORDNUMBER=RECORDNUMBER+1
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Homephone")=INFO(200,IEN_",",.131,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Officephone")=INFO(200,IEN_",",.132,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Phone3")=INFO(200,IEN_",",.133,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Phone4")=INFO(200,IEN_",",.134,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"CommercialPhone")=INFO(200,IEN_",",.135,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Fax")=INFO(200,IEN_",",.136,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"VoicePager")=INFO(200,IEN_",",.137,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"DigitalPager")=INFO(200,IEN_",",.138,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Email")=INFO(200,IEN_",",.151,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"Title")=INFO(200,IEN_",",8,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"ProviderClass")=INFO(200,IEN_",",53.5,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"ProviderSecID")=INFO(200,IEN_",",205.1,"E")
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",1)=""
  1. . S PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",1)=""
  1. . S IENS=0 F S IENS=$O(^VA(200,IEN,"USC1",IENS)) Q:'IENS D
  1. . . S PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",IENS)=$$GET1^DIQ(200.05,IENS_","_IEN_",",.01)
  1. . S IENS=0 F S IENS=$O(^VA(200,IEN,"USC3",IENS)) Q:'IENS D
  1. . . S PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",IENS)=$$GET1^DIQ(200.07,IENS_","_IEN_",",.01)
  1. I '$D(PROVIDERETURN("Provider")) S PROVIDERETURN("Provider",1)=""
  1. Q
  1. ;
  1. GETUSERLIST(SEARCHSTRING,USERLIST) ; pull matching providers using the first input parameter passed in by the RPC
  1. ; Input - SEARCHSTRING = string that represents the name of the person
  1. ; USERLIST = passed in by reference; represents the array that will be returned as output
  1. ; Output - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
  1. N RESULTS,SUB3,USERDUZ
  1. K USERLIST
  1. S SUB3=0
  1. D FIND^DIC(200,,"@;.01",,SEARCHSTRING,,,,,"RESULTS")
  1. F S SUB3=$O(RESULTS("DILIST",2,SUB3)) Q:SUB3="" D
  1. . S USERDUZ=RESULTS("DILIST",2,SUB3)
  1. . S USERLIST(USERDUZ)=RESULTS("DILIST","ID",SUB3,.01)
  1. Q
  1. ;