- SDECPRVSRCHJSON ;ALB/LAB,TAW - Get Providers based on Search String ;DEC 17, 2021
- ;;5.3;Scheduling;**797,800,804**;Aug 13, 1993;Build 9
- ;;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[HSDECPRVSRCHJSON 2702 printed Jan 18, 2025@03:53:31 Page 2
- SDECPRVSRCHJSON ;ALB/LAB,TAW - Get Providers based on Search String ;DEC 17, 2021
- +1 ;;5.3;Scheduling;**797,800,804**;Aug 13, 1993;Build 9
- +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 ;