SDES2PROVSEARCH ;ALB/JAS,JHC,LAB - Get Provider based on Search String ;JULY 9, 2026
;;5.3;Scheduling;**890,909,951**;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
;
; Reference to DUZ^XUP is supported by IA #7487
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
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
; 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
;
D NEWPROVLIST(SEARCHSTRING,.PROVIDERLIST)
D BUILDRETURN(.PROVIDERLIST,.PROVIDERETURN)
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
;
NEWPROVLIST(SEARCHSTRING,PROVIDERLIST) ;Loop through "B" cross reference for providers
N USERDUZ,PROVIDERNAME,STRINGLENGTH,DATE
S USERDUZ=""
S DATE=$P(DT,".")
S STRINGLENGTH=$L(SEARCHSTRING)
S PROVIDERNAME=$O(^VA(200,"B",SEARCHSTRING),-1)
I $E(PROVIDERNAME,1,STRINGLENGTH)=SEARCHSTRING D
. S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME),-1)
F S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME)) Q:PROVIDERNAME=""!($E(PROVIDERNAME,1,STRINGLENGTH)'=SEARCHSTRING) D
. S USERDUZ=""
. F S USERDUZ=$O(^VA(200,"B",PROVIDERNAME,USERDUZ)) Q:USERDUZ="" D
. . I $$ACTIVPRV^PXAPI(USERDUZ,DATE)&($$ACTIVE^XUSER(USERDUZ)) S PROVIDERLIST(USERDUZ)=""
Q
;
BUILDRETURN(PROVIDERLIST,PROVIDERETURN) ;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,IE
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)
. K INFO,IE
I '$D(PROVIDERETURN("Provider")) S PROVIDERETURN("Provider",1)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2PROVSEARCH 5449 printed Sep 17, 2026@21:40:56 Page 2
SDES2PROVSEARCH ;ALB/JAS,JHC,LAB - Get Provider based on Search String ;JULY 9, 2026
+1 ;;5.3;Scheduling;**890,909,951**;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 ; Reference to DUZ^XUP is supported by IA #7487
+10 QUIT
+11 ;
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 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+21 ;
+22 ; Validate SDINPUT
+23 SET SEARCHSTRING=$GET(SDINPUT("SEARCHSTRING"))
+24 SET SEARCHSTRING=$TRANSLATE(SEARCHSTRING,$CHAR(13)_$CHAR(10)_$CHAR(9),"")
+25 DO VALIDATEINPUT(.SDERRORS,SEARCHSTRING)
+26 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Provider",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+27 ;
+28 DO NEWPROVLIST(SEARCHSTRING,.PROVIDERLIST)
+29 DO BUILDRETURN(.PROVIDERLIST,.PROVIDERETURN)
+30 DO BUILDJSON^SDES2JSON(.JSONRETURN,.PROVIDERETURN)
+31 QUIT
+32 ;
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 ;
NEWPROVLIST(SEARCHSTRING,PROVIDERLIST) ;Loop through "B" cross reference for providers
+1 NEW USERDUZ,PROVIDERNAME,STRINGLENGTH,DATE
+2 SET USERDUZ=""
+3 SET DATE=$PIECE(DT,".")
+4 SET STRINGLENGTH=$LENGTH(SEARCHSTRING)
+5 SET PROVIDERNAME=$ORDER(^VA(200,"B",SEARCHSTRING),-1)
+6 IF $EXTRACT(PROVIDERNAME,1,STRINGLENGTH)=SEARCHSTRING
Begin DoDot:1
+7 SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME),-1)
End DoDot:1
+8 FOR
SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME))
if PROVIDERNAME=""!($EXTRACT(PROVIDERNAME,1,STRINGLENGTH)'=SEARCHSTRING)
QUIT
Begin DoDot:1
+9 SET USERDUZ=""
+10 FOR
SET USERDUZ=$ORDER(^VA(200,"B",PROVIDERNAME,USERDUZ))
if USERDUZ=""
QUIT
Begin DoDot:2
+11 IF $$ACTIVPRV^PXAPI(USERDUZ,DATE)&($$ACTIVE^XUSER(USERDUZ))
SET PROVIDERLIST(USERDUZ)=""
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
BUILDRETURN(PROVIDERLIST,PROVIDERETURN) ;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,IE
+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
+29 KILL INFO,IE
End DoDot:1
+30 IF '$DATA(PROVIDERETURN("Provider"))
SET PROVIDERETURN("Provider",1)=""
+31 QUIT
+32 ;
