- SDESRECPROVSRCH ;ALB/MGD/ANU/JAS,TJB - VISTA SCHEDULING RECALL PROVIDER USER SEARCH RPC; Apr 15, 2024
- ;;5.3;Scheduling;**823,827,845,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
- Q
- ; RPC = SDES SEARCH RECALL PROVIDERS
- SEARCHRECALLPROV(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 active Providers from the RECALL REMINDERS PROVIDERS (#403.54) file with data pulled from the 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
- ; (16) Recall Reminders Provider IEN
- ;
- 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 GETPROVLIST(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
- ;
- 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
- S CNT=1
- D FIND^DIC(403.54,,"@;.01IE;1IE;2IE",,SEARCHSTRING,,,,,"RESULTS")
- F S SUB3=$O(RESULTS("DILIST",2,SUB3)) Q:SUB3="" D
- . S IEN40354=RESULTS("DILIST",2,SUB3)
- . Q:($$GET1^DIQ(403.54,IEN40354_",",5,"I")="I")
- . S USERDUZ=$G(RESULTS("DILIST","ID",SUB3,.01,"I"))
- . S USRISACTIVE=$$ACTIVE^XUSER(USERDUZ)
- . Q:$P(USRISACTIVE,"^")'=1 ;Quit if User is TERMINATED or DISUSER'ed or User cannot sign-on (no AC/VC assigned)
- . S USERTEAM=$G(RESULTS("DILIST","ID",SUB3,1,"E"))
- . S USERLOC=$G(RESULTS("DILIST","ID",SUB3,2,"E"))
- . S USERLIST(CNT)=USERDUZ_"^"_USERTEAM_"^"_USERLOC
- . S CNT=CNT+1
- Q
- ;
- 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
- M PROVIDERLIST=USERLIST
- 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
- 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")=$O(^SD(403.54,"B",IEN,0))
- . 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)=""
- I RECORDNUMBER=0 D ERRLOG^SDESJSON(.PROVIDERETURN,65)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESRECPROVSRCH 6268 printed Feb 19, 2025@00:24:11 Page 2
- SDESRECPROVSRCH ;ALB/MGD/ANU/JAS,TJB - VISTA SCHEDULING RECALL PROVIDER USER SEARCH RPC; Apr 15, 2024
- +1 ;;5.3;Scheduling;**823,827,845,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 QUIT
- +8 ; RPC = SDES SEARCH RECALL PROVIDERS
- SEARCHRECALLPROV(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 active Providers from the RECALL REMINDERS PROVIDERS (#403.54) file with data pulled from the 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 ; (16) Recall Reminders Provider IEN
- +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 GETPROVLIST(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 ;
- 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
- +7 SET CNT=1
- +8 DO FIND^DIC(403.54,,"@;.01IE;1IE;2IE",,SEARCHSTRING,,,,,"RESULTS")
- +9 FOR
- SET SUB3=$ORDER(RESULTS("DILIST",2,SUB3))
- if SUB3=""
- QUIT
- Begin DoDot:1
- +10 SET IEN40354=RESULTS("DILIST",2,SUB3)
- +11 if ($$GET1^DIQ(403.54,IEN40354_",",5,"I")="I")
- QUIT
- +12 SET USERDUZ=$GET(RESULTS("DILIST","ID",SUB3,.01,"I"))
- +13 SET USRISACTIVE=$$ACTIVE^XUSER(USERDUZ)
- +14 ;Quit if User is TERMINATED or DISUSER'ed or User cannot sign-on (no AC/VC assigned)
- if $PIECE(USRISACTIVE,"^")'=1
- QUIT
- +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
- +18 SET CNT=CNT+1
- End DoDot:1
- +19 QUIT
- +20 ;
- 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 MERGE PROVIDERLIST=USERLIST
- +7 QUIT
- +8 ;
- 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,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")=$ORDER(^SD(403.54,"B",IEN,0))
- +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 IF RECORDNUMBER=0
- DO ERRLOG^SDESJSON(.PROVIDERETURN,65)
- +37 QUIT