SDES2RECPRVSRCH ;ALB/TJB - VISTA SCHEDULING RECALL PROVIDER USER SEARCH RPC; May 11, 2024
;;5.3;Scheduling;**880**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$ACTIVE^XUSER is supported by ICR #2343
Q
; RPC = SDES2 SEARCH RECALL PROVIDERS
RECPROVSEARCH(RESULT,SDCONTEXT,SDINPUT) ;Search for Healthcare Providers and provide return of providers in JSON STRING
;INPUT - SDINPUT("SEARCHSTRING") = free text string that represents the provider name that will be searched
;OUTPUT - RETURN in JSON format
; List of active Providers from the RECALL REMINDERS PROVIDERS (#403.54) file with data pulled from the NEW PERSON (#200) File.
;
N USERLIST,ERRORS,PROVIDERETURN
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Provider",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
;
S SEARCHSTRING=$$VALIDATE(.ERRORS,$G(SDINPUT("SEARCHSTRING")))
I $D(ERRORS) D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
D GETPROVLIST(SEARCHSTRING,.USERLIST)
D BUILDRETURN(.USERLIST,.PROVIDERETURN)
D BUILDJSON^SDES2JSON(.RESULT,.PROVIDERETURN)
Q
;
VALIDATE(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
; returns search string
I ($L(SEARCHSTRING)<3)!($L(SEARCHSTRING)>35) D Q ""
. D ERRLOG^SDES2JSON(.ERRORLIST,230)
. S ERRORLIST("Provider",1)=""
Q SEARCHSTRING
;
GETPROVLIST(SEARCHSTRING,USERLIST) ; 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 IEN40354,RESULTS,SUB3,USERDUZ,USRISACTIVE,USERLOC,USERTEAM,CNT
K USERLIST
S SUB3=0,CNT=1
D FIND^DIC(403.54,,"@;.01IE;1IE;2IE;5IE","B",SEARCHSTRING,,,,,"RESULTS")
F S SUB3=$O(RESULTS("DILIST",2,SUB3)) Q:SUB3="" D
. S IEN40354=RESULTS("DILIST",2,SUB3)
. Q:$G(RESULTS("DILIST","ID",SUB3,5,"I"))="I"
. S USERDUZ=$G(RESULTS("DILIST","ID",SUB3,.01,"I"))
. S USRISACTIVE=$$ACTIVE^XUSER(USERDUZ) ;check if user is not TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
. Q:$P(USRISACTIVE,"^")'=1 ;Quit if User is TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
.;SD*5.3*827
. S USERTEAM=$G(RESULTS("DILIST","ID",SUB3,1,"E"))
. S USERLOC=$G(RESULTS("DILIST","ID",SUB3,2,"E"))
. S USERLIST(CNT)=USERDUZ_"^"_USERTEAM_"^"_USERLOC_"^"_IEN40354
. S CNT=CNT+1
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,RECORDNUMBER,INFO,CNT
K INFO
S (RECORDNUMBER,IEN,CNT)=0
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
. S RECORDNUMBER=RECORDNUMBER+1
. S PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
. S PROVIDERETURN("Provider",RECORDNUMBER,"RecallProviderIEN")=$P(PROVIDERLIST(CNT),"^",4)
. S PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
. ;
. S PROVIDERETURN("Provider",RECORDNUMBER,"Team")=$P(PROVIDERLIST(CNT),"^",2)
. S PROVIDERETURN("Provider",RECORDNUMBER,"Division")=$P(PROVIDERLIST(CNT),"^",3)
. ;
. 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[HSDES2RECPRVSRCH 5423 printed Oct 16, 2024@18:55:03 Page 2
SDES2RECPRVSRCH ;ALB/TJB - VISTA SCHEDULING RECALL PROVIDER USER SEARCH RPC; May 11, 2024
+1 ;;5.3;Scheduling;**880**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$ACTIVE^XUSER is supported by ICR #2343
+7 QUIT
+8 ; RPC = SDES2 SEARCH RECALL PROVIDERS
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
+2 ;OUTPUT - RETURN in JSON format
+3 ; List of active Providers from the RECALL REMINDERS PROVIDERS (#403.54) file with data pulled from the NEW PERSON (#200) File.
+4 ;
+5 NEW USERLIST,ERRORS,PROVIDERETURN
+6 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+7 IF $DATA(ERRORS)
SET ERRORS("Provider",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+8 ;
+9 SET SEARCHSTRING=$$VALIDATE(.ERRORS,$GET(SDINPUT("SEARCHSTRING")))
+10 IF $DATA(ERRORS)
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+11 DO GETPROVLIST(SEARCHSTRING,.USERLIST)
+12 DO BUILDRETURN(.USERLIST,.PROVIDERETURN)
+13 DO BUILDJSON^SDES2JSON(.RESULT,.PROVIDERETURN)
+14 QUIT
+15 ;
VALIDATE(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 ; returns search string
+4 IF ($LENGTH(SEARCHSTRING)<3)!($LENGTH(SEARCHSTRING)>35)
Begin DoDot:1
+5 DO ERRLOG^SDES2JSON(.ERRORLIST,230)
+6 SET ERRORLIST("Provider",1)=""
End DoDot:1
QUIT ""
+7 QUIT SEARCHSTRING
+8 ;
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
+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 IEN40354,RESULTS,SUB3,USERDUZ,USRISACTIVE,USERLOC,USERTEAM,CNT
+5 KILL USERLIST
+6 SET SUB3=0
SET CNT=1
+7 DO FIND^DIC(403.54,,"@;.01IE;1IE;2IE;5IE","B",SEARCHSTRING,,,,,"RESULTS")
+8 FOR
SET SUB3=$ORDER(RESULTS("DILIST",2,SUB3))
if SUB3=""
QUIT
Begin DoDot:1
+9 SET IEN40354=RESULTS("DILIST",2,SUB3)
+10 if $GET(RESULTS("DILIST","ID",SUB3,5,"I"))="I"
QUIT
+11 SET USERDUZ=$GET(RESULTS("DILIST","ID",SUB3,.01,"I"))
+12 ;check if user is not TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
SET USRISACTIVE=$$ACTIVE^XUSER(USERDUZ)
+13 ;Quit if User is TERMINATED or DIUSER'ed or User cannot sign-on (no AC/VC assigned)
if $PIECE(USRISACTIVE,"^")'=1
QUIT
+14 ;SD*5.3*827
+15 SET USERTEAM=$GET(RESULTS("DILIST","ID",SUB3,1,"E"))
+16 SET USERLOC=$GET(RESULTS("DILIST","ID",SUB3,2,"E"))
+17 SET USERLIST(CNT)=USERDUZ_"^"_USERTEAM_"^"_USERLOC_"^"_IEN40354
+18 SET CNT=CNT+1
End DoDot:1
+19 QUIT
+20 ;
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,RECORDNUMBER,INFO,CNT
+6 KILL INFO
+7 SET (RECORDNUMBER,IEN,CNT)=0
+8 FOR
SET CNT=$ORDER(PROVIDERLIST(CNT))
if 'CNT
QUIT
SET IEN=$PIECE(PROVIDERLIST(CNT),"^",1)
DO GETS^DIQ(200,IEN_",",".01;.131:.138;.151;8;53.5;205.1","IE","INFO")
Begin DoDot:1
+9 SET RECORDNUMBER=RECORDNUMBER+1
+10 SET PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
+11 SET PROVIDERETURN("Provider",RECORDNUMBER,"RecallProviderIEN")=$PIECE(PROVIDERLIST(CNT),"^",4)
+12 SET PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
+13 ;
+14 SET PROVIDERETURN("Provider",RECORDNUMBER,"Team")=$PIECE(PROVIDERLIST(CNT),"^",2)
+15 SET PROVIDERETURN("Provider",RECORDNUMBER,"Division")=$PIECE(PROVIDERLIST(CNT),"^",3)
+16 ;
+17 SET PROVIDERETURN("Provider",RECORDNUMBER,"Homephone")=INFO(200,IEN_",",.131,"E")
+18 SET PROVIDERETURN("Provider",RECORDNUMBER,"Officephone")=INFO(200,IEN_",",.132,"E")
+19 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone3")=INFO(200,IEN_",",.133,"E")
+20 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone4")=INFO(200,IEN_",",.134,"E")
+21 SET PROVIDERETURN("Provider",RECORDNUMBER,"CommercialPhone")=INFO(200,IEN_",",.135,"E")
+22 SET PROVIDERETURN("Provider",RECORDNUMBER,"Fax")=INFO(200,IEN_",",.136,"E")
+23 SET PROVIDERETURN("Provider",RECORDNUMBER,"VoicePager")=INFO(200,IEN_",",.137,"E")
+24 SET PROVIDERETURN("Provider",RECORDNUMBER,"DigitalPager")=INFO(200,IEN_",",.138,"E")
+25 SET PROVIDERETURN("Provider",RECORDNUMBER,"Email")=INFO(200,IEN_",",.151,"E")
+26 SET PROVIDERETURN("Provider",RECORDNUMBER,"Title")=INFO(200,IEN_",",8,"E")
+27 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderClass")=INFO(200,IEN_",",53.5,"E")
+28 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderSecID")=INFO(200,IEN_",",205.1,"E")
+29 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",1)=""
+30 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",1)=""
+31 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC1",IENS))
if 'IENS
QUIT
Begin DoDot:2
+32 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",IENS)=$$GET1^DIQ(200.05,IENS_","_IEN_",",.01)
End DoDot:2
+33 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC3",IENS))
if 'IENS
QUIT
Begin DoDot:2
+34 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",IENS)=$$GET1^DIQ(200.07,IENS_","_IEN_",",.01)
End DoDot:2
End DoDot:1
+35 IF '$DATA(PROVIDERETURN("Provider"))
SET PROVIDERETURN("Provider",1)=""
+36 QUIT
