SDESPRVSRCHJSON ;ALB/LAB,TAW,DJS - Get Providers based on Search String ; NOV 9, 2022@11:26
;;5.3;Scheduling;**828**;Aug 13, 1993;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
Q
;
JSONPRVLIST(SDPRVJSON,SDSRCHSTR) ;Search PROVIDERS and get data needed to make VIDEO VISIT SERVICE (VVS) Appointment
;INPUT - SDSRCHSTR (Search String)
;RETURN PARMETER:
; List of Providers from NEW PERSON (#200) File. Data is delimited by carat (^).
; Field List:
; (1) Provider Name
; (2) Provider IEN
; (3) Primary Phone
; (4) Email Address
; (5) Title
; (6) Provider Class
;
N PROVIDERNAME,STRINGLENGTH,SDPRVSREC,ERRPOP,ERR,ERRMSG,SDECI
D INIT
D VALIDATE
I ERRPOP D BLDJSON Q
D BLDPRVREC
D BLDJSON
Q
;
INIT ; initialize values needed
S SDECI=0
S SDECI=$G(SDECI,0),ERR=""
S STRINGLENGTH=$L(SDSRCHSTR)
S PROVIDERNAME=$O(^VA(200,"B",SDSRCHSTR),-1)
I $E(PROVIDERNAME,1,SDSRCHSTR)=SDSRCHSTR D
.S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME),-1)
S ERRPOP=0,SDECI=0,ERRMSG=""
Q
;
VALIDATE ; validate incoming parameters
I $L(SDSRCHSTR)<2 D
. ;create error message - Search String must be at least 2 characters
. D ERRLOG^SDESJSON(.SDPRVSREC,64)
. S ERRPOP=1
Q
;
BLDJSON ;
D ENCODE^SDESJSON(.SDPRVSREC,.SDPRVJSON,.ERR)
K SDPRVSREC
Q
;
BLDPRVREC ;Build a list of Providers
;
N VVSPROVIDER,PROVIDERIEN,TERMDATE,SDPOP
F S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME)) Q:PROVIDERNAME=""!($E(PROVIDERNAME,1,STRINGLENGTH)'=SDSRCHSTR) D
.I SDECI>49 Q
.S (VVSPROVIDER,PROVIDERIEN)=""
.F S PROVIDERIEN=$O(^VA(200,"B",PROVIDERNAME,PROVIDERIEN)) Q:PROVIDERIEN="" D
..S TERMDATE=$$GET1^DIQ(200,PROVIDERIEN,9.2,"I")
..S SDPOP=0
..I TERMDATE'="" D
... S:TERMDATE<DT SDPOP=1
..I ($$GET1^DIQ(200,PROVIDERIEN,7,"I")'=1)&('SDPOP) D
...D GETPROINFO^SDECVVS(.VVSPROVIDER,PROVIDERIEN)
...I VVSPROVIDER'="" D
....S SDECI=SDECI+1
....S SDPRVSREC("Provider",SDECI,"IEN")=$P(VVSPROVIDER,"^",1)
....S SDPRVSREC("Provider",SDECI,"Name")=$P(VVSPROVIDER,"^",2)
....S SDPRVSREC("Provider",SDECI,"Email")=$P(VVSPROVIDER,"^",3)
....S SDPRVSREC("Provider",SDECI,"Cell")=$P(VVSPROVIDER,"^",4)
....S SDPRVSREC("Provider",SDECI,"Title")=$P(VVSPROVIDER,"^",5)
....S SDPRVSREC("Provider",SDECI,"ProviderClass")=$P(VVSPROVIDER,"^",6)
I '$D(SDPRVSREC("Provider")) S SDPRVSREC("Provider")=""
I SDECI=0 D
. ;create error message - No Providers found that match Search String
. D ERRLOG^SDESJSON(.SDPRVSREC,65)
. S ERRPOP=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESPRVSRCHJSON 2705 printed Nov 22, 2024@18:07:29 Page 2
SDESPRVSRCHJSON ;ALB/LAB,TAW,DJS - Get Providers based on Search String ; NOV 9, 2022@11:26
+1 ;;5.3;Scheduling;**828**;Aug 13, 1993;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Documented API's and Integration Agreements
+5 ; -------------------------------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 QUIT
+8 ;
JSONPRVLIST(SDPRVJSON,SDSRCHSTR) ;Search PROVIDERS and get data needed to make VIDEO VISIT SERVICE (VVS) Appointment
+1 ;INPUT - SDSRCHSTR (Search String)
+2 ;RETURN PARMETER:
+3 ; List of Providers from NEW PERSON (#200) File. Data is delimited by carat (^).
+4 ; Field List:
+5 ; (1) Provider Name
+6 ; (2) Provider IEN
+7 ; (3) Primary Phone
+8 ; (4) Email Address
+9 ; (5) Title
+10 ; (6) Provider Class
+11 ;
+12 NEW PROVIDERNAME,STRINGLENGTH,SDPRVSREC,ERRPOP,ERR,ERRMSG,SDECI
+13 DO INIT
+14 DO VALIDATE
+15 IF ERRPOP
DO BLDJSON
QUIT
+16 DO BLDPRVREC
+17 DO BLDJSON
+18 QUIT
+19 ;
INIT ; initialize values needed
+1 SET SDECI=0
+2 SET SDECI=$GET(SDECI,0)
SET ERR=""
+3 SET STRINGLENGTH=$LENGTH(SDSRCHSTR)
+4 SET PROVIDERNAME=$ORDER(^VA(200,"B",SDSRCHSTR),-1)
+5 IF $EXTRACT(PROVIDERNAME,1,SDSRCHSTR)=SDSRCHSTR
Begin DoDot:1
+6 SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME),-1)
End DoDot:1
+7 SET ERRPOP=0
SET SDECI=0
SET ERRMSG=""
+8 QUIT
+9 ;
VALIDATE ; validate incoming parameters
+1 IF $LENGTH(SDSRCHSTR)<2
Begin DoDot:1
+2 ;create error message - Search String must be at least 2 characters
+3 DO ERRLOG^SDESJSON(.SDPRVSREC,64)
+4 SET ERRPOP=1
End DoDot:1
+5 QUIT
+6 ;
BLDJSON ;
+1 DO ENCODE^SDESJSON(.SDPRVSREC,.SDPRVJSON,.ERR)
+2 KILL SDPRVSREC
+3 QUIT
+4 ;
BLDPRVREC ;Build a list of Providers
+1 ;
+2 NEW VVSPROVIDER,PROVIDERIEN,TERMDATE,SDPOP
+3 FOR
SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME))
if PROVIDERNAME=""!($EXTRACT(PROVIDERNAME,1,STRINGLENGTH)'=SDSRCHSTR)
QUIT
Begin DoDot:1
+4 IF SDECI>49
QUIT
+5 SET (VVSPROVIDER,PROVIDERIEN)=""
+6 FOR
SET PROVIDERIEN=$ORDER(^VA(200,"B",PROVIDERNAME,PROVIDERIEN))
if PROVIDERIEN=""
QUIT
Begin DoDot:2
+7 SET TERMDATE=$$GET1^DIQ(200,PROVIDERIEN,9.2,"I")
+8 SET SDPOP=0
+9 IF TERMDATE'=""
Begin DoDot:3
+10 if TERMDATE<DT
SET SDPOP=1
End DoDot:3
+11 IF ($$GET1^DIQ(200,PROVIDERIEN,7,"I")'=1)&('SDPOP)
Begin DoDot:3
+12 DO GETPROINFO^SDECVVS(.VVSPROVIDER,PROVIDERIEN)
+13 IF VVSPROVIDER'=""
Begin DoDot:4
+14 SET SDECI=SDECI+1
+15 SET SDPRVSREC("Provider",SDECI,"IEN")=$PIECE(VVSPROVIDER,"^",1)
+16 SET SDPRVSREC("Provider",SDECI,"Name")=$PIECE(VVSPROVIDER,"^",2)
+17 SET SDPRVSREC("Provider",SDECI,"Email")=$PIECE(VVSPROVIDER,"^",3)
+18 SET SDPRVSREC("Provider",SDECI,"Cell")=$PIECE(VVSPROVIDER,"^",4)
+19 SET SDPRVSREC("Provider",SDECI,"Title")=$PIECE(VVSPROVIDER,"^",5)
+20 SET SDPRVSREC("Provider",SDECI,"ProviderClass")=$PIECE(VVSPROVIDER,"^",6)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF '$DATA(SDPRVSREC("Provider"))
SET SDPRVSREC("Provider")=""
+22 IF SDECI=0
Begin DoDot:1
+23 ;create error message - No Providers found that match Search String
+24 DO ERRLOG^SDESJSON(.SDPRVSREC,65)
+25 SET ERRPOP=1
End DoDot:1
+26 QUIT
+27 ;
