SDES2PROVSEARCH ;ALB/JAS - Get Provider based on Search String ;Sept 5, 2024
;;5.3;Scheduling;**890**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
; Reference to $$ACTIVE^XUSER is supported by IA #2343
;
Q
;
PROVIDERSEARCH(JSONRETURN,SDCONTEXT,SDINPUT) ; rpc = SDES2 SEARCH PROVIDERS
; The SDCONTEXT array is controlled by the Acheron application and its fields are
; needed for the storage of the required auditing information.
;
; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;
; SDINPUT("SEARCHSTRING") = The string to be used to search for active providers.
;
; OUTPUT - SDRETURN
; List of a providers' details from the NEW PERSON (#200) file that meets the search criteria.
;
N USERLIST,SDERRORS,SDRETURN,SEARCHSTRING,PROVIDERETURN,PROVIDERLIST
;
; Validate SDCONTEXT
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Provider",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Validate SDINPUT
S SEARCHSTRING=$G(SDINPUT("SEARCHSTRING"))
S SEARCHSTRING=$TR(SEARCHSTRING,$C(13)_$C(10)_$C(9),"")
D VALIDATEINPUT(.SDERRORS,SEARCHSTRING)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Provider",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Find list of matching users
D GETUSERLIST(.USERLIST,SEARCHSTRING)
;
; Filter out non-providers and inactive users
D BLDPROVIDERLIST(.PROVIDERLIST,.USERLIST)
;
; Prepare return array
D BUILDRETURN(.PROVIDERETURN,.PROVIDERLIST)
D BUILDJSON^SDES2JSON(.JSONRETURN,.PROVIDERETURN)
Q
;
VALIDATEINPUT(ERRORLIST,SEARCHSTRING) ; validate incoming parameters
; input - ERRORLIST = passed in by reference, represents the errors that could be generated when validating the searchstring
; SEARCHSTRING = represents the name or partial name of the provider
I ($L(SEARCHSTRING)<3)!($L(SEARCHSTRING)>35) D ERRLOG^SDES2JSON(.ERRORLIST,230)
Q
;
GETUSERLIST(USERLIST,SEARCHSTRING) ; pull matching providers using the first input parameter passed in by the RPC
; Input - SEARCHSTRING = string that represents the name of the person
; USERLIST = passed in by reference; represents the array that will be returned as output
; Output - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
N C,RESULTS,SUBIEN,USERDUZ
K USERLIST
S SUBIEN=0
D FIND^DIC(200,,"@;.01",,SEARCHSTRING,,,,,"RESULTS")
F S SUBIEN=$O(RESULTS("DILIST",2,SUBIEN)) Q:SUBIEN="" D
. S USERDUZ=RESULTS("DILIST",2,SUBIEN)
. S USERLIST(USERDUZ)=RESULTS("DILIST","ID",SUBIEN,.01)
Q
;
BLDPROVIDERLIST(PROVIDERLIST,USERLIST) ;
; input - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
; PROVIDERLIST = passed by reference, represents the screened list of actual providers that are active
; output - PROVIDERLIST = array of active providers
N USERDUZ
S USERDUZ=0
F S USERDUZ=$O(USERLIST(USERDUZ)) Q:'USERDUZ D
. I '$$ACTIVPRV^PXAPI(USERDUZ,DT)!('$$ACTIVE^XUSER(USERDUZ)) Q
. S PROVIDERLIST(USERDUZ)=""
Q
;
BUILDRETURN(PROVIDERETURN,PROVIDERLIST) ;Build return array with provider data
; input - PROVIDERLIST = array of active providers
; PROVIDERETURN = passed by reference, represents the array of providers and associated data that will be returned to the client
; output - PROVIDERETURN = provider array and their associated data to be sent back to the client
;
N PROVIDERDATA,IEN,IENS,INFO,RECORDNUMBER
S (RECORDNUMBER,IEN)=0
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
. S RECORDNUMBER=RECORDNUMBER+1
. S PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
. S PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Homephone")=INFO(200,IEN_",",.131,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Officephone")=INFO(200,IEN_",",.132,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Phone3")=INFO(200,IEN_",",.133,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Phone4")=INFO(200,IEN_",",.134,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"CommercialPhone")=INFO(200,IEN_",",.135,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Fax")=INFO(200,IEN_",",.136,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"VoicePager")=INFO(200,IEN_",",.137,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"DigitalPager")=INFO(200,IEN_",",.138,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Email")=INFO(200,IEN_",",.151,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"Title")=INFO(200,IEN_",",8,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"ProviderClass")=INFO(200,IEN_",",53.5,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"ProviderSecID")=INFO(200,IEN_",",205.1,"E")
. S PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",1)=""
. S PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",1)=""
. S IENS=0 F S IENS=$O(^VA(200,IEN,"USC1",IENS)) Q:'IENS D
. . S PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",IENS)=$$GET1^DIQ(200.05,IENS_","_IEN_",",.01)
. S IENS=0 F S IENS=$O(^VA(200,IEN,"USC3",IENS)) Q:'IENS D
. . S PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",IENS)=$$GET1^DIQ(200.07,IENS_","_IEN_",",.01)
I '$D(PROVIDERETURN("Provider")) S PROVIDERETURN("Provider",1)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2PROVSEARCH 5935 printed Sep 23, 2025@20:31:04 Page 2
SDES2PROVSEARCH ;ALB/JAS - Get Provider based on Search String ;Sept 5, 2024
+1 ;;5.3;Scheduling;**890**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
+7 ; Reference to $$ACTIVE^XUSER is supported by IA #2343
+8 ;
+9 QUIT
+10 ;
PROVIDERSEARCH(JSONRETURN,SDCONTEXT,SDINPUT) ; rpc = SDES2 SEARCH PROVIDERS
+1 ; The SDCONTEXT array is controlled by the Acheron application and its fields are
+2 ; needed for the storage of the required auditing information.
+3 ;
+4 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+5 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+6 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+7 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+8 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+9 ;
+10 ; SDINPUT("SEARCHSTRING") = The string to be used to search for active providers.
+11 ;
+12 ; OUTPUT - SDRETURN
+13 ; List of a providers' details from the NEW PERSON (#200) file that meets the search criteria.
+14 ;
+15 NEW USERLIST,SDERRORS,SDRETURN,SEARCHSTRING,PROVIDERETURN,PROVIDERLIST
+16 ;
+17 ; Validate SDCONTEXT
+18 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+19 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Provider",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+20 ;
+21 ; Validate SDINPUT
+22 SET SEARCHSTRING=$GET(SDINPUT("SEARCHSTRING"))
+23 SET SEARCHSTRING=$TRANSLATE(SEARCHSTRING,$CHAR(13)_$CHAR(10)_$CHAR(9),"")
+24 DO VALIDATEINPUT(.SDERRORS,SEARCHSTRING)
+25 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Provider",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+26 ;
+27 ; Find list of matching users
+28 DO GETUSERLIST(.USERLIST,SEARCHSTRING)
+29 ;
+30 ; Filter out non-providers and inactive users
+31 DO BLDPROVIDERLIST(.PROVIDERLIST,.USERLIST)
+32 ;
+33 ; Prepare return array
+34 DO BUILDRETURN(.PROVIDERETURN,.PROVIDERLIST)
+35 DO BUILDJSON^SDES2JSON(.JSONRETURN,.PROVIDERETURN)
+36 QUIT
+37 ;
VALIDATEINPUT(ERRORLIST,SEARCHSTRING) ; validate incoming parameters
+1 ; input - ERRORLIST = passed in by reference, represents the errors that could be generated when validating the searchstring
+2 ; SEARCHSTRING = represents the name or partial name of the provider
+3 IF ($LENGTH(SEARCHSTRING)<3)!($LENGTH(SEARCHSTRING)>35)
DO ERRLOG^SDES2JSON(.ERRORLIST,230)
+4 QUIT
+5 ;
GETUSERLIST(USERLIST,SEARCHSTRING) ; pull matching providers using the first input parameter passed in by the RPC
+1 ; Input - SEARCHSTRING = string that represents the name of the person
+2 ; USERLIST = passed in by reference; represents the array that will be returned as output
+3 ; Output - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
+4 NEW C,RESULTS,SUBIEN,USERDUZ
+5 KILL USERLIST
+6 SET SUBIEN=0
+7 DO FIND^DIC(200,,"@;.01",,SEARCHSTRING,,,,,"RESULTS")
+8 FOR
SET SUBIEN=$ORDER(RESULTS("DILIST",2,SUBIEN))
if SUBIEN=""
QUIT
Begin DoDot:1
+9 SET USERDUZ=RESULTS("DILIST",2,SUBIEN)
+10 SET USERLIST(USERDUZ)=RESULTS("DILIST","ID",SUBIEN,.01)
End DoDot:1
+11 QUIT
+12 ;
BLDPROVIDERLIST(PROVIDERLIST,USERLIST) ;
+1 ; input - USERLIST = list of USER names and internal entry numbers from NEW PERSON file (200)
+2 ; PROVIDERLIST = passed by reference, represents the screened list of actual providers that are active
+3 ; output - PROVIDERLIST = array of active providers
+4 NEW USERDUZ
+5 SET USERDUZ=0
+6 FOR
SET USERDUZ=$ORDER(USERLIST(USERDUZ))
if 'USERDUZ
QUIT
Begin DoDot:1
+7 IF '$$ACTIVPRV^PXAPI(USERDUZ,DT)!('$$ACTIVE^XUSER(USERDUZ))
QUIT
+8 SET PROVIDERLIST(USERDUZ)=""
End DoDot:1
+9 QUIT
+10 ;
BUILDRETURN(PROVIDERETURN,PROVIDERLIST) ;Build return array with provider data
+1 ; input - PROVIDERLIST = array of active providers
+2 ; PROVIDERETURN = passed by reference, represents the array of providers and associated data that will be returned to the client
+3 ; output - PROVIDERETURN = provider array and their associated data to be sent back to the client
+4 ;
+5 NEW PROVIDERDATA,IEN,IENS,INFO,RECORDNUMBER
+6 SET (RECORDNUMBER,IEN)=0
+7 FOR
SET IEN=$ORDER(PROVIDERLIST(IEN))
if 'IEN
QUIT
DO GETS^DIQ(200,IEN_",",".01;.131:.138;.151;8;53.5;205.1","IE","INFO")
Begin DoDot:1
+8 SET RECORDNUMBER=RECORDNUMBER+1
+9 SET PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
+10 SET PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
+11 SET PROVIDERETURN("Provider",RECORDNUMBER,"Homephone")=INFO(200,IEN_",",.131,"E")
+12 SET PROVIDERETURN("Provider",RECORDNUMBER,"Officephone")=INFO(200,IEN_",",.132,"E")
+13 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone3")=INFO(200,IEN_",",.133,"E")
+14 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone4")=INFO(200,IEN_",",.134,"E")
+15 SET PROVIDERETURN("Provider",RECORDNUMBER,"CommercialPhone")=INFO(200,IEN_",",.135,"E")
+16 SET PROVIDERETURN("Provider",RECORDNUMBER,"Fax")=INFO(200,IEN_",",.136,"E")
+17 SET PROVIDERETURN("Provider",RECORDNUMBER,"VoicePager")=INFO(200,IEN_",",.137,"E")
+18 SET PROVIDERETURN("Provider",RECORDNUMBER,"DigitalPager")=INFO(200,IEN_",",.138,"E")
+19 SET PROVIDERETURN("Provider",RECORDNUMBER,"Email")=INFO(200,IEN_",",.151,"E")
+20 SET PROVIDERETURN("Provider",RECORDNUMBER,"Title")=INFO(200,IEN_",",8,"E")
+21 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderClass")=INFO(200,IEN_",",53.5,"E")
+22 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderSecID")=INFO(200,IEN_",",205.1,"E")
+23 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",1)=""
+24 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",1)=""
+25 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC1",IENS))
if 'IENS
QUIT
Begin DoDot:2
+26 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",IENS)=$$GET1^DIQ(200.05,IENS_","_IEN_",",.01)
End DoDot:2
+27 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC3",IENS))
if 'IENS
QUIT
Begin DoDot:2
+28 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",IENS)=$$GET1^DIQ(200.07,IENS_","_IEN_",",.01)
End DoDot:2
End DoDot:1
+29 IF '$DATA(PROVIDERETURN("Provider"))
SET PROVIDERETURN("Provider",1)=""
+30 QUIT
+31 ;
