SDESPROVSEARCH ;BAYPINES/KML,MGD,JAS - Get Provider based on Search String ;Apr 5, 2024
;;5.3;Scheduling;**819,826,877**;Aug 13, 1993;Build 14
;;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
; rpc = SDES SEARCH PROVIDERS
PROVIDERSEARCH(JSONRETURN,SEARCHSTRING) ;Search for Healthcare Providers and provide return of providers in JSON STRING
;INPUT - SEARCHSTRING = free text string that represents the provider name that will be searched
;OUTPUT - JSONRETURN
; List of Providers from NEW PERSON (#200) File.
; Field List:
; (1) Provider Name
; (2) Provider IEN
; (3) Office Phone
; (4) Email Address
; (5) Title
; (6) Provider Class
; (7) Security ID (SECID)
; (8) Fax
; (9) Home Phone
; (10) Commercial Phone
; (11) Digital Pager
; (12) Voice Pager
; (13) Person Class
; (14) Provider Class
; (15) User Class
;
;
N USERLIST,ERROREXISTS,ERRORLIST,PROVIDERETURN,PROVIDERLIST
K JSONRETURN
S SEARCHSTRING=$G(SEARCHSTRING)
S SEARCHSTRING=$TR(SEARCHSTRING,$C(13)_$C(10)_$C(9),"")
S ERROREXISTS=0
S ERROREXISTS=$$VALIDATEINPUT(.ERRORLIST,SEARCHSTRING)
I ERROREXISTS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.ERRORLIST) Q
D GETUSERLIST(SEARCHSTRING,.USERLIST)
D BLDPROVIDERLIST(.USERLIST,.PROVIDERLIST)
D BUILDRETURN(.PROVIDERLIST,.PROVIDERETURN)
D BUILDJSON^SDESBUILDJSON(.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
; returns 0 or 1
; 0 = no validation errors
; 1 = validation errors
I ($L(SEARCHSTRING)<3)!($L(SEARCHSTRING)>35) D Q 1
. D ERRLOG^SDESJSON(.ERRORLIST,230)
. S ERRORLIST("Provider",1)=""
Q 0
;
BLDPROVIDERLIST(USERLIST,PROVIDERLIST) ;
; 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 I $$SCREEN(USERDUZ,DT) S PROVIDERLIST(USERDUZ)=""
Q
;
SCREEN(USERDUZ,DATE) ;
;
; Selects active providers with an active entry in the NEW PERSON
; file (#200) for PERSON CLASS.
;
; INPUT: USERDUZ = ien of file 200
; DATE = today's date
; OUTPUT: 1 to select; 0 to not select
;
; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
; The TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
; will be used to determine if selection is active in the
; NEW PERSON (#200) file for a given date.
;
I '+$G(USERDUZ) Q 0
S:'+$G(DATE) DATE=DT
S DATE=$P(DATE,".")
I $$ACTIVPRV^PXAPI(USERDUZ,DATE)&($$ACTIVE^XUSER(USERDUZ)) Q 1
Q 0
;
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
K INFO
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
;
GETUSERLIST(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 RESULTS,SUB3,USERDUZ
K USERLIST
S SUB3=0
D FIND^DIC(200,,"@;.01",,SEARCHSTRING,,,,,"RESULTS")
F S SUB3=$O(RESULTS("DILIST",2,SUB3)) Q:SUB3="" D
. S USERDUZ=RESULTS("DILIST",2,SUB3)
. S USERLIST(USERDUZ)=RESULTS("DILIST","ID",SUB3,.01)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESPROVSEARCH 6089 printed Nov 22, 2024@18:07:28 Page 2
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
+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 QUIT
+9 ; rpc = SDES SEARCH PROVIDERS
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
+2 ;OUTPUT - JSONRETURN
+3 ; List of Providers from NEW PERSON (#200) File.
+4 ; Field List:
+5 ; (1) Provider Name
+6 ; (2) Provider IEN
+7 ; (3) Office Phone
+8 ; (4) Email Address
+9 ; (5) Title
+10 ; (6) Provider Class
+11 ; (7) Security ID (SECID)
+12 ; (8) Fax
+13 ; (9) Home Phone
+14 ; (10) Commercial Phone
+15 ; (11) Digital Pager
+16 ; (12) Voice Pager
+17 ; (13) Person Class
+18 ; (14) Provider Class
+19 ; (15) User Class
+20 ;
+21 ;
+22 NEW USERLIST,ERROREXISTS,ERRORLIST,PROVIDERETURN,PROVIDERLIST
+23 KILL JSONRETURN
+24 SET SEARCHSTRING=$GET(SEARCHSTRING)
+25 SET SEARCHSTRING=$TRANSLATE(SEARCHSTRING,$CHAR(13)_$CHAR(10)_$CHAR(9),"")
+26 SET ERROREXISTS=0
+27 SET ERROREXISTS=$$VALIDATEINPUT(.ERRORLIST,SEARCHSTRING)
+28 IF ERROREXISTS
DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.ERRORLIST)
QUIT
+29 DO GETUSERLIST(SEARCHSTRING,.USERLIST)
+30 DO BLDPROVIDERLIST(.USERLIST,.PROVIDERLIST)
+31 DO BUILDRETURN(.PROVIDERLIST,.PROVIDERETURN)
+32 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.PROVIDERETURN)
+33 QUIT
+34 ;
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 ; returns 0 or 1
+4 ; 0 = no validation errors
+5 ; 1 = validation errors
+6 IF ($LENGTH(SEARCHSTRING)<3)!($LENGTH(SEARCHSTRING)>35)
Begin DoDot:1
+7 DO ERRLOG^SDESJSON(.ERRORLIST,230)
+8 SET ERRORLIST("Provider",1)=""
End DoDot:1
QUIT 1
+9 QUIT 0
+10 ;
BLDPROVIDERLIST(USERLIST,PROVIDERLIST) ;
+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
IF $$SCREEN(USERDUZ,DT)
SET PROVIDERLIST(USERDUZ)=""
+7 QUIT
+8 ;
SCREEN(USERDUZ,DATE) ;
+1 ;
+2 ; Selects active providers with an active entry in the NEW PERSON
+3 ; file (#200) for PERSON CLASS.
+4 ;
+5 ; INPUT: USERDUZ = ien of file 200
+6 ; DATE = today's date
+7 ; OUTPUT: 1 to select; 0 to not select
+8 ;
+9 ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
+10 ; The TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
+11 ; will be used to determine if selection is active in the
+12 ; NEW PERSON (#200) file for a given date.
+13 ;
+14 IF '+$GET(USERDUZ)
QUIT 0
+15 if '+$GET(DATE)
SET DATE=DT
+16 SET DATE=$PIECE(DATE,".")
+17 IF $$ACTIVPRV^PXAPI(USERDUZ,DATE)&($$ACTIVE^XUSER(USERDUZ))
QUIT 1
+18 QUIT 0
+19 ;
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
+6 KILL INFO
+7 SET (RECORDNUMBER,IEN)=0
+8 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
+9 SET RECORDNUMBER=RECORDNUMBER+1
+10 SET PROVIDERETURN("Provider",RECORDNUMBER,"IEN")=IEN
+11 SET PROVIDERETURN("Provider",RECORDNUMBER,"Name")=INFO(200,IEN_",",.01,"E")
+12 SET PROVIDERETURN("Provider",RECORDNUMBER,"Homephone")=INFO(200,IEN_",",.131,"E")
+13 SET PROVIDERETURN("Provider",RECORDNUMBER,"Officephone")=INFO(200,IEN_",",.132,"E")
+14 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone3")=INFO(200,IEN_",",.133,"E")
+15 SET PROVIDERETURN("Provider",RECORDNUMBER,"Phone4")=INFO(200,IEN_",",.134,"E")
+16 SET PROVIDERETURN("Provider",RECORDNUMBER,"CommercialPhone")=INFO(200,IEN_",",.135,"E")
+17 SET PROVIDERETURN("Provider",RECORDNUMBER,"Fax")=INFO(200,IEN_",",.136,"E")
+18 SET PROVIDERETURN("Provider",RECORDNUMBER,"VoicePager")=INFO(200,IEN_",",.137,"E")
+19 SET PROVIDERETURN("Provider",RECORDNUMBER,"DigitalPager")=INFO(200,IEN_",",.138,"E")
+20 SET PROVIDERETURN("Provider",RECORDNUMBER,"Email")=INFO(200,IEN_",",.151,"E")
+21 SET PROVIDERETURN("Provider",RECORDNUMBER,"Title")=INFO(200,IEN_",",8,"E")
+22 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderClass")=INFO(200,IEN_",",53.5,"E")
+23 SET PROVIDERETURN("Provider",RECORDNUMBER,"ProviderSecID")=INFO(200,IEN_",",205.1,"E")
+24 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",1)=""
+25 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",1)=""
+26 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC1",IENS))
if 'IENS
QUIT
Begin DoDot:2
+27 SET PROVIDERETURN("Provider",RECORDNUMBER,"PersonClass",IENS)=$$GET1^DIQ(200.05,IENS_","_IEN_",",.01)
End DoDot:2
+28 SET IENS=0
FOR
SET IENS=$ORDER(^VA(200,IEN,"USC3",IENS))
if 'IENS
QUIT
Begin DoDot:2
+29 SET PROVIDERETURN("Provider",RECORDNUMBER,"UserClass",IENS)=$$GET1^DIQ(200.07,IENS_","_IEN_",",.01)
End DoDot:2
End DoDot:1
+30 IF '$DATA(PROVIDERETURN("Provider"))
SET PROVIDERETURN("Provider",1)=""
+31 QUIT
+32 ;
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
+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 RESULTS,SUB3,USERDUZ
+5 KILL USERLIST
+6 SET SUB3=0
+7 DO FIND^DIC(200,,"@;.01",,SEARCHSTRING,,,,,"RESULTS")
+8 FOR
SET SUB3=$ORDER(RESULTS("DILIST",2,SUB3))
if SUB3=""
QUIT
Begin DoDot:1
+9 SET USERDUZ=RESULTS("DILIST",2,SUB3)
+10 SET USERLIST(USERDUZ)=RESULTS("DILIST","ID",SUB3,.01)
End DoDot:1
+11 QUIT
+12 ;
