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

SDES2RECPRVSRCH.m

Go to the documentation of this file. 
  1. SDES2RECPRVSRCH  ;ALB/TJB - VISTA SCHEDULING RECALL PROVIDER USER SEARCH RPC; May 11, 2024
  1.  ;;5.3;Scheduling;**880**;Aug 13, 1993;Build 5
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;External References
  1.  ;-------------------
  1.  ; Reference to $$ACTIVE^XUSER is supported by ICR #2343
  1.  Q
  1.  ; RPC = SDES2 SEARCH RECALL PROVIDERS
  1. RECPROVSEARCH(RESULT,SDCONTEXT,SDINPUT) ;Search for Healthcare Providers and provide return of providers in JSON STRING
  1.  ;INPUT - SDINPUT("SEARCHSTRING") = free text string that represents the provider name that will be searched
  1.  ;OUTPUT - RETURN in JSON format
  1.  ; List of active Providers from the RECALL REMINDERS PROVIDERS (#403.54) file with data pulled from the NEW PERSON (#200) File.
  1.  ;
  1.  N USERLIST,ERRORS,PROVIDERETURN
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  I $D(ERRORS) S ERRORS("Provider",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
  1.  ;
  1.  S SEARCHSTRING=$$VALIDATE(.ERRORS,$G(SDINPUT("SEARCHSTRING")))
  1.  I $D(ERRORS) D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
  1.  D GETPROVLIST(SEARCHSTRING,.USERLIST)
  1.  D BUILDRETURN(.USERLIST,.PROVIDERETURN)
  1.  D BUILDJSON^SDES2JSON(.RESULT,.PROVIDERETURN)
  1.  Q
  1.  ;
  1. VALIDATE(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 search string
  1.  I ($L(SEARCHSTRING)<3)!($L(SEARCHSTRING)>35) D  Q ""
  1.  . D ERRLOG^SDES2JSON(.ERRORLIST,230)
  1.  . S ERRORLIST("Provider",1)=""
  1.  Q SEARCHSTRING
  1.  ;
  1. GETPROVLIST(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 IEN40354,RESULTS,SUB3,USERDUZ,USRISACTIVE,USERLOC,USERTEAM,CNT
  1.  K USERLIST
  1.  S SUB3=0,CNT=1
  1.  D FIND^DIC(403.54,,"@;.01IE;1IE;2IE;5IE","B",SEARCHSTRING,,,,,"RESULTS")
  1.  F  S SUB3=$O(RESULTS("DILIST",2,SUB3)) Q:SUB3=""  D
  1.  . S IEN40354=RESULTS("DILIST",2,SUB3)
  1.  . Q:$G(RESULTS("DILIST","ID",SUB3,5,"I"))="I"
  1.  . S USERDUZ=$G(RESULTS("DILIST","ID",SUB3,.01,"I"))
  1.  . S USRISACTIVE=$$ACTIVE^XUSER(USERDUZ) ;check if user is not TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
  1.  . Q:$P(USRISACTIVE,"^")'=1  ;Quit if User is TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
  1.  .;SD*5.3*827
  1.  . S USERTEAM=$G(RESULTS("DILIST","ID",SUB3,1,"E"))
  1.  . S USERLOC=$G(RESULTS("DILIST","ID",SUB3,2,"E"))
  1.  . S USERLIST(CNT)=USERDUZ_"^"_USERTEAM_"^"_USERLOC_"^"_IEN40354
  1.  . S CNT=CNT+1
  1.  Q
  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,INFO,CNT
  1.  K INFO
  1.  S (RECORDNUMBER,IEN,CNT)=0
  1.  F  S CNT=$O(PROVIDERLIST(CNT)) Q:'CNT  S IEN=$P(PROVIDERLIST(CNT),"^",1) 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,"RecallProviderIEN")=$P(PROVIDERLIST(CNT),"^",4)
  1.  . S PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
  1.  . ;
  1.  . S PROVIDERETURN("Provider",RECORDNUMBER,"Team")=$P(PROVIDERLIST(CNT),"^",2)
  1.  . S PROVIDERETURN("Provider",RECORDNUMBER,"Division")=$P(PROVIDERLIST(CNT),"^",3)
  1.  . ;
  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