SDES01C ;ALB/ANU,TAW,DJS,JAS - SEARCH SDEC RESOURCES FOR MATCHING FILE #44 DATA ;FEB 06, 2023
;;5.3;Scheduling;**790,807,836,837**;Aug 13, 1993;Build 4
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
CLINICRSC(CLINICLIST,SEARCHSTRING) ;Returns first 50 matching RESOURCE names
; SEARCHSTRING - (Required) Partial name text of at least 3 characters
;RETURN:
; Successful Return:
; a JSON formatted string that contains data from the
; HOSPITAL LOCATION file
; 1. CLINIC IEN - Pointer to the HOSPITAL LOCATION file 44
; 2. CLINIC NAME - Clinic Name from HOSPITAL LOCATION file 44
; 3. CLINIC STATUS (Active/Inactive)
; 4. NON-COUNT CLINIC? (Y/N)
; 5. PRIMARY AMIS STOP CODE
; 6. SECONDARY AMIS STOP CODE
; 7. PATIENT FRIENDLY NAME
;
N CLINICFLDSARRAY,HASFIELDS,HASVALERRORS,MAXREC,RETCNT,RETURN,SDRESOURCEIEN,SDRESOURCE,SSERRORS
S MAXREC=50,RETCNT=1,SDRESOURCE=""
S SEARCHSTRING=$G(SEARCHSTRING)
;
S HASVALERRORS=$$VALIDATESRCHSTRG(.SSERRORS,SEARCHSTRING)
I HASVALERRORS M RETURN=SSERRORS
I 'HASVALERRORS D
. ;partial name lookup
. S SDRESOURCE=$$GETSUB^SDEC56(SEARCHSTRING)
. F S SDRESOURCE=$O(^SDEC(409.831,"B",SDRESOURCE)) Q:SDRESOURCE="" Q:SDRESOURCE'[SEARCHSTRING D Q:(RETCNT'<MAXREC)
. . S SDRESOURCEIEN=0
. . F S SDRESOURCEIEN=$O(^SDEC(409.831,"B",SDRESOURCE,SDRESOURCEIEN)) Q:'+SDRESOURCEIEN D Q:(RETCNT'<MAXREC)
. . . S HASFIELDS=$$GETCLINICFIELDS(.CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT)
. . . I HASFIELDS M RETURN=CLINICFLDSARRAY S RETCNT=RETCNT+1
. I RETCNT'>1,'$D(RETURN("Error")) S RETURN("Resource")=""
;
;JSON format
D ENCODE^SDESJSON(.RETURN,.CLINICLIST)
Q
;
VALIDATESRCHSTRG(SSERRORS,SEARCHSTRING) ; VALIDATE SEARCH STRING
N ERRORFLAG
I SEARCHSTRING="" D
. S ERRORFLAG=1 D ERRLOG^SDESJSON(.SSERRORS,231)
I SEARCHSTRING'="",$L(SEARCHSTRING)<3!($L(SEARCHSTRING)>35) D
. S ERRORFLAG=1,SEARCHSTRING=""
. D ERRLOG^SDESJSON(.SSERRORS,230)
Q $D(ERRORFLAG)
;
GETCLINICFIELDS(CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT) ; get data for 1 resource
N CLIENS,CREDITAMIS,FND,NONCNTCL,PTFRNDLYNM,PRIAMIS,PRIMAMIS,SDABBREVIEN
N SDCLDATA,SDCLIENS,SDCLINNAME,SDHOSLOCIEN,SDRESTYP,SDRSDATA,SDSTATUS,SECONDAMIS,STATUS
S FND=0,SDABBREVIEN=0
I '$D(^SDEC(409.831,SDRESOURCEIEN,0)) Q 0
;
; Skip Records in ABBREVIATION cross-reference
;
S FND=$$SDCHK(SEARCHSTRING,SDRESOURCEIEN) Q:FND 0 ;Stop if 'this' record found in abbreviations
F S SDABBREVIEN=$O(^SDEC(409.831,"C",SEARCHSTRING,SDABBREVIEN)) Q:SDABBREVIEN="" D
. S FND=SDABBREVIEN=SDRESOURCEIEN
Q:FND 0
;
; Collect Resource and Clinic Data for Return Array
;
S CLIENS=SDRESOURCEIEN_","
D GETS^DIQ(409.831,CLIENS,".01;.04;.012","IE","SDRSDATA")
S SDRESTYP=$G(SDRSDATA(409.831,CLIENS,.012,"I"))
Q:SDRESTYP'["SC(" 0 ; Only want Hospital Location Resources
S STATUS=$$INACTIVE^SDESUTIL(SDRESOURCEIEN,DT) ; Get status of clinic
S SDSTATUS=$S(STATUS=1:"ACTIVE",1:"INACTIVE")
S SDHOSLOCIEN=$G(SDRSDATA(409.831,CLIENS,.04,"I"))
S SDCLIENS=SDHOSLOCIEN_","
D GETS^DIQ(44,SDCLIENS,".01;8;2502;2503;60","IE","SDCLDATA")
S SDCLINNAME=$G(SDCLDATA(44,SDCLIENS,.01,"E"))
I SDCLINNAME="" S SDCLINNAME="Clinic name not found for location:"_SDHOSLOCIEN
S NONCNTCL=$G(SDCLDATA(44,SDCLIENS,2502,"E"))
S PTFRNDLYNM=$G(SDCLDATA(44,SDCLIENS,60,"E"))
S PRIAMIS=$G(SDCLDATA(44,SDCLIENS,8,"I"))
S CREDITAMIS=$G(SDCLDATA(44,SDCLIENS,2503,"I"))
S PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL(PRIAMIS) ; Get Primary AMIS Stop Code
S SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL(CREDITAMIS) ; Get Secondary AMIS Stop Code
;
; Build the Return Array
;
S CLINICFLDSARRAY("Resource",RETCNT,"IEN")=$G(SDHOSLOCIEN)
S CLINICFLDSARRAY("Resource",RETCNT,"Name")=$G(SDCLINNAME)
S CLINICFLDSARRAY("Resource",RETCNT,"Status")=$G(SDSTATUS)
S CLINICFLDSARRAY("Resource",RETCNT,"Non-CountClinic")=$G(NONCNTCL)
S CLINICFLDSARRAY("Resource",RETCNT,"PrimaryAMISStopCode")=$G(PRIMAMIS)
S CLINICFLDSARRAY("Resource",RETCNT,"SecondaryAMISStopCode")=$G(SECONDAMIS)
S CLINICFLDSARRAY("Resource",RETCNT,"PatientFriendlyName")=$G(PTFRNDLYNM)
Q 1
;
SDCHK(SEARCHSTRING,SDRESOURCEIEN) ;Stop if 'this' record found in abbreviations
N FND,SDABBREVIEN,SDABBREV
S FND=0
S SDABBREV=$$GETSUB^SDEC56(SEARCHSTRING)
F S SDABBREV=$O(^SDEC(409.831,"C",SDABBREV)) Q:SDABBREV="" Q:SDABBREV'[SEARCHSTRING D Q:+FND
. S SDABBREVIEN=0
. F S SDABBREVIEN=$O(^SDEC(409.831,"C",SDABBREV,SDABBREVIEN)) Q:'+SDABBREVIEN D Q:+FND
. . S FND=SDABBREVIEN=SDRESOURCEIEN
Q FND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES01C 4611 printed May 14, 2023@15:10:34 Page 2
SDES01C ;ALB/ANU,TAW,DJS,JAS - SEARCH SDEC RESOURCES FOR MATCHING FILE #44 DATA ;FEB 06, 2023
+1 ;;5.3;Scheduling;**790,807,836,837**;Aug 13, 1993;Build 4
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
CLINICRSC(CLINICLIST,SEARCHSTRING) ;Returns first 50 matching RESOURCE names
+1 ; SEARCHSTRING - (Required) Partial name text of at least 3 characters
+2 ;RETURN:
+3 ; Successful Return:
+4 ; a JSON formatted string that contains data from the
+5 ; HOSPITAL LOCATION file
+6 ; 1. CLINIC IEN - Pointer to the HOSPITAL LOCATION file 44
+7 ; 2. CLINIC NAME - Clinic Name from HOSPITAL LOCATION file 44
+8 ; 3. CLINIC STATUS (Active/Inactive)
+9 ; 4. NON-COUNT CLINIC? (Y/N)
+10 ; 5. PRIMARY AMIS STOP CODE
+11 ; 6. SECONDARY AMIS STOP CODE
+12 ; 7. PATIENT FRIENDLY NAME
+13 ;
+14 NEW CLINICFLDSARRAY,HASFIELDS,HASVALERRORS,MAXREC,RETCNT,RETURN,SDRESOURCEIEN,SDRESOURCE,SSERRORS
+15 SET MAXREC=50
SET RETCNT=1
SET SDRESOURCE=""
+16 SET SEARCHSTRING=$GET(SEARCHSTRING)
+17 ;
+18 SET HASVALERRORS=$$VALIDATESRCHSTRG(.SSERRORS,SEARCHSTRING)
+19 IF HASVALERRORS
MERGE RETURN=SSERRORS
+20 IF 'HASVALERRORS
Begin DoDot:1
+21 ;partial name lookup
+22 SET SDRESOURCE=$$GETSUB^SDEC56(SEARCHSTRING)
+23 FOR
SET SDRESOURCE=$ORDER(^SDEC(409.831,"B",SDRESOURCE))
if SDRESOURCE=""
QUIT
if SDRESOURCE'[SEARCHSTRING
QUIT
Begin DoDot:2
+24 SET SDRESOURCEIEN=0
+25 FOR
SET SDRESOURCEIEN=$ORDER(^SDEC(409.831,"B",SDRESOURCE,SDRESOURCEIEN))
if '+SDRESOURCEIEN
QUIT
Begin DoDot:3
+26 SET HASFIELDS=$$GETCLINICFIELDS(.CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT)
+27 IF HASFIELDS
MERGE RETURN=CLINICFLDSARRAY
SET RETCNT=RETCNT+1
End DoDot:3
if (RETCNT'<MAXREC)
QUIT
End DoDot:2
if (RETCNT'<MAXREC)
QUIT
+28 IF RETCNT'>1
IF '$DATA(RETURN("Error"))
SET RETURN("Resource")=""
End DoDot:1
+29 ;
+30 ;JSON format
+31 DO ENCODE^SDESJSON(.RETURN,.CLINICLIST)
+32 QUIT
+33 ;
VALIDATESRCHSTRG(SSERRORS,SEARCHSTRING) ; VALIDATE SEARCH STRING
+1 NEW ERRORFLAG
+2 IF SEARCHSTRING=""
Begin DoDot:1
+3 SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.SSERRORS,231)
End DoDot:1
+4 IF SEARCHSTRING'=""
IF $LENGTH(SEARCHSTRING)<3!($LENGTH(SEARCHSTRING)>35)
Begin DoDot:1
+5 SET ERRORFLAG=1
SET SEARCHSTRING=""
+6 DO ERRLOG^SDESJSON(.SSERRORS,230)
End DoDot:1
+7 QUIT $DATA(ERRORFLAG)
+8 ;
GETCLINICFIELDS(CLINICFLDSARRAY,SEARCHSTRING,SDRESOURCEIEN,RETCNT) ; get data for 1 resource
+1 NEW CLIENS,CREDITAMIS,FND,NONCNTCL,PTFRNDLYNM,PRIAMIS,PRIMAMIS,SDABBREVIEN
+2 NEW SDCLDATA,SDCLIENS,SDCLINNAME,SDHOSLOCIEN,SDRESTYP,SDRSDATA,SDSTATUS,SECONDAMIS,STATUS
+3 SET FND=0
SET SDABBREVIEN=0
+4 IF '$DATA(^SDEC(409.831,SDRESOURCEIEN,0))
QUIT 0
+5 ;
+6 ; Skip Records in ABBREVIATION cross-reference
+7 ;
+8 ;Stop if 'this' record found in abbreviations
SET FND=$$SDCHK(SEARCHSTRING,SDRESOURCEIEN)
if FND
QUIT 0
+9 FOR
SET SDABBREVIEN=$ORDER(^SDEC(409.831,"C",SEARCHSTRING,SDABBREVIEN))
if SDABBREVIEN=""
QUIT
Begin DoDot:1
+10 SET FND=SDABBREVIEN=SDRESOURCEIEN
End DoDot:1
+11 if FND
QUIT 0
+12 ;
+13 ; Collect Resource and Clinic Data for Return Array
+14 ;
+15 SET CLIENS=SDRESOURCEIEN_","
+16 DO GETS^DIQ(409.831,CLIENS,".01;.04;.012","IE","SDRSDATA")
+17 SET SDRESTYP=$GET(SDRSDATA(409.831,CLIENS,.012,"I"))
+18 ; Only want Hospital Location Resources
if SDRESTYP'["SC("
QUIT 0
+19 ; Get status of clinic
SET STATUS=$$INACTIVE^SDESUTIL(SDRESOURCEIEN,DT)
+20 SET SDSTATUS=$SELECT(STATUS=1:"ACTIVE",1:"INACTIVE")
+21 SET SDHOSLOCIEN=$GET(SDRSDATA(409.831,CLIENS,.04,"I"))
+22 SET SDCLIENS=SDHOSLOCIEN_","
+23 DO GETS^DIQ(44,SDCLIENS,".01;8;2502;2503;60","IE","SDCLDATA")
+24 SET SDCLINNAME=$GET(SDCLDATA(44,SDCLIENS,.01,"E"))
+25 IF SDCLINNAME=""
SET SDCLINNAME="Clinic name not found for location:"_SDHOSLOCIEN
+26 SET NONCNTCL=$GET(SDCLDATA(44,SDCLIENS,2502,"E"))
+27 SET PTFRNDLYNM=$GET(SDCLDATA(44,SDCLIENS,60,"E"))
+28 SET PRIAMIS=$GET(SDCLDATA(44,SDCLIENS,8,"I"))
+29 SET CREDITAMIS=$GET(SDCLDATA(44,SDCLIENS,2503,"I"))
+30 ; Get Primary AMIS Stop Code
SET PRIMAMIS=$$STOPCODETOAMIS^SDESUTIL(PRIAMIS)
+31 ; Get Secondary AMIS Stop Code
SET SECONDAMIS=$$STOPCODETOAMIS^SDESUTIL(CREDITAMIS)
+32 ;
+33 ; Build the Return Array
+34 ;
+35 SET CLINICFLDSARRAY("Resource",RETCNT,"IEN")=$GET(SDHOSLOCIEN)
+36 SET CLINICFLDSARRAY("Resource",RETCNT,"Name")=$GET(SDCLINNAME)
+37 SET CLINICFLDSARRAY("Resource",RETCNT,"Status")=$GET(SDSTATUS)
+38 SET CLINICFLDSARRAY("Resource",RETCNT,"Non-CountClinic")=$GET(NONCNTCL)
+39 SET CLINICFLDSARRAY("Resource",RETCNT,"PrimaryAMISStopCode")=$GET(PRIMAMIS)
+40 SET CLINICFLDSARRAY("Resource",RETCNT,"SecondaryAMISStopCode")=$GET(SECONDAMIS)
+41 SET CLINICFLDSARRAY("Resource",RETCNT,"PatientFriendlyName")=$GET(PTFRNDLYNM)
+42 QUIT 1
+43 ;
SDCHK(SEARCHSTRING,SDRESOURCEIEN) ;Stop if 'this' record found in abbreviations
+1 NEW FND,SDABBREVIEN,SDABBREV
+2 SET FND=0
+3 SET SDABBREV=$$GETSUB^SDEC56(SEARCHSTRING)
+4 FOR
SET SDABBREV=$ORDER(^SDEC(409.831,"C",SDABBREV))
if SDABBREV=""
QUIT
if SDABBREV'[SEARCHSTRING
QUIT
Begin DoDot:1
+5 SET SDABBREVIEN=0
+6 FOR
SET SDABBREVIEN=$ORDER(^SDEC(409.831,"C",SDABBREV,SDABBREVIEN))
if '+SDABBREVIEN
QUIT
Begin DoDot:2
+7 SET FND=SDABBREVIEN=SDRESOURCEIEN
End DoDot:2
if +FND
QUIT
End DoDot:1
if +FND
QUIT
+8 QUIT FND
