Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDES2CLNSEARCH

SDES2CLNSEARCH.m

Go to the documentation of this file.
  1. SDES2CLNSEARCH ;ALB/MGD,BWF,JAS,JDJ,JAS - CLINIC NAME SEARCH AND LIMITED DATA RETURN ;NOV 07, 2024
  1. ;;5.3;Scheduling;**870,871,875,887,895**;Aug 13, 1993;Build 11
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; Reference to $$ACTIVPRV^PXAPI is supported by IA #2349
  1. ;
  1. ; Copy of SDESCLNSEARCH for SDES2 Namespace
  1. ; RPC = SDES2 SEARCH CLINIC ATTRIBUTES
  1. SEARCHCLIN(SDRETURN,SDCONTEXT,SDCLINIC) ;Search for clinics and provide return of matches and limited date in JSON STRING
  1. ; The SDCONTEXT array is controlled by the Acheron application and its fields are
  1. ; needed for the storage of the required auditing information.
  1. ;
  1. ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
  1. ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
  1. ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
  1. ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
  1. ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
  1. ;
  1. ; The SDCLINIC array contains the following array elements:
  1. ; SDCLINIC("SEARCHSTRING") (Req) = free text string that represents the clinic name that will be searched
  1. ; SDCLINIC("STATION") (Opt) = Station Number: If present, the search would be limited to matching clinics at the given institution.
  1. ; If absent, the search would take place across all divisions/institutions. Example values: 534, 534GB
  1. ; SDCLINIC("DATETIME") (Opt) = Date in ISO 8601 format to use for Clinic Status verification. If not passed in, defaults to DT.
  1. ; SDCLINIC("RETURNACTIVE") (Opt) = Boolean to return Active or Inactive clinics.
  1. ; 1:Returns active and inactive clinics, 0:Returns only active clinics, Defaults to 0 if not passed in
  1. ; SDCLINIC("LENGTH OF APPOINTMENT") (Opt) = numeric string (2-3) Example value: 30
  1. ;
  1. ; OUTPUT - SDRETURN
  1. ; List of Clinics from the HOSPITAL LOCATION (#44) file with the following data.
  1. ; Field List:
  1. ; 1. Clinic IEN
  1. ; 2. Clinic name
  1. ; 3. Patient friendly name
  1. ; 4. Default provider IEN
  1. ; 5. Default Provider name
  1. ; 6. Default Provider SECID
  1. ; 7. Stop code IEN
  1. ; 8. Stop code Name
  1. ; 9. Stop code AMIS
  1. ; 10. Credit stop code IEN
  1. ; 11. Credit stop code Name
  1. ; 12. Credit stop code AMIS
  1. ; 13. Status (Active or Inactive) If not passed in, default to DT
  1. ; 14. Non-count (Y or N)
  1. ;
  1. N SDLINICLIST,SDERRORS,SDCLINICLIST,SDJSONERRORS,SDVALIDDATA
  1. N SDSEARCHSTRING,SDSTATION,SDDATE,SDDATETIME,SDRETURNACTIVE
  1. ;
  1. D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
  1. I $D(SDERRORS) S SDJSONERRORS("Clinic",1)="" M SDJSONERRORS=SDERRORS D BUILDJSON^SDES2JSON(.SDRETURN,.SDJSONERRORS) Q
  1. ;
  1. D VALCLINIC(.SDERRORS,.SDCLINIC,.SDVALIDDATA)
  1. I $D(SDERRORS) S SDJSONERRORS("Clinic",1)="" M SDJSONERRORS=SDERRORS D BUILDJSON^SDES2JSON(.SDRETURN,.SDJSONERRORS) Q
  1. ;
  1. D GETCLINICLIST(.SDVALIDDATA,.SDCLINICLIST)
  1. D BUILDJSON^SDESBUILDJSON(.SDRETURN,.SDCLINICLIST)
  1. Q
  1. ;
  1. VALCLINIC(SDERRORS,SDCLINIC,SDVALIDDATA) ; validate incoming clinic parameters
  1. ; Input - SDERRORS = passed in by reference, represents the errors that could be generated when validating the search string
  1. ; SDSEARCHSTRING = represents the name or partial name of the Clinic
  1. ; SDSTATION = Station Number
  1. ; SDDATETIME (Opt) = Date in ISO 8601 format to use for Clinic Status verification. If not passed in, default to DT.
  1. ; SDRETURNACTIVE ? Boolean: 1:Return active and inactive clinics, 0:Return only active clinics
  1. ;
  1. ; Returns 0 or 1
  1. ; 0 = no validation errors
  1. ; 1 = validation errors
  1. ;
  1. S SDSEARCHSTRING=$G(SDCLINIC("SEARCHSTRING"))
  1. S SDSEARCHSTRING=$TR(SDSEARCHSTRING,$C(13)_$C(10)_$C(9),"")
  1. I ($L(SDSEARCHSTRING)<2)!($L(SDSEARCHSTRING)>30) D ERRLOG^SDESJSON(.SDERRORS,$S(SDSEARCHSTRING="":231,1:473))
  1. S SDVALIDDATA("SEARCHSTRING")=SDSEARCHSTRING
  1. ;
  1. S SDSTATION=$G(SDCLINIC("STATION"))
  1. S SDDATETIME=$G(SDCLINIC("DATETIME"))
  1. I SDSTATION'="" D VALSTATIONNUM^SDES2VAL4(.SDERRORS,SDSTATION,SDDATETIME)
  1. S SDVALIDDATA("STATION")=SDSTATION
  1. ;
  1. I SDDATETIME="" S SDDATETIME=DT
  1. I SDDATETIME'="",SDDATETIME'?7N D
  1. .S SDDATETIME=$$ISOTFM^SDAMUTDT(SDDATETIME,"")
  1. .I SDDATETIME=-1 D ERRLOG^SDESJSON(.SDERRORS,244)
  1. S SDVALIDDATA("DATETIME")=SDDATETIME
  1. ;
  1. S SDRETURNACTIVE=$G(SDCLINIC("RETURNACTIVE"))
  1. I SDRETURNACTIVE="" S SDRETURNACTIVE=0
  1. D VALBOOLEAN^SDES2UTIL1(.SDERRORS,SDRETURNACTIVE,0,"SDCLINIC(""RETURNACTIVE"")")
  1. S SDVALIDDATA("RETURNACTIVE")=SDRETURNACTIVE
  1. Q
  1. ;
  1. GETCLINICLIST(SDVALIDDATA,SDCLINICLIST) ; pull matching clinics using the first input parameter passed in by the RPC
  1. ; Input - SEARCHSTRING = string that represents the name of the clinic
  1. ; SDSTATION = Station Number
  1. ; SDDATETIME = Date/Time in FileMan format to use for Clinic Status verification
  1. ; SDRETURNACTIVE ? Boolean: 1:Return active and inactive clinics, 0:Return only active clinics
  1. ; SDCLINICLIST = passed in by reference; represents the array that will be returned as output
  1. ; Output - SDCLINICLIST = list of clinic names, clinic IENs and the associated IENs.
  1. N SDCLINCNT,SDRESULTS,SUB3,SDCNT,SDINDX,SDNAMEINDX
  1. S SDSEARCHSTRING=SDVALIDDATA("SEARCHSTRING")
  1. S SDSTATION=SDVALIDDATA("STATION")
  1. S SDDATETIME=SDVALIDDATA("DATETIME")
  1. S SDRETURNACTIVE=SDVALIDDATA("RETURNACTIVE")
  1. K SDCLINICLIST,SDRESULTS
  1. S SDNAMEINDX=0,SDCNT=0
  1. ; Loop through B x-ref
  1. F S SDNAMEINDX=$O(^SC("B",SDNAMEINDX)) Q:SDNAMEINDX="" D
  1. .Q:SDNAMEINDX'[SDSEARCHSTRING
  1. .S SDINDX=$O(^SC("B",SDNAMEINDX,""))
  1. .Q:'$D(^SC(SDINDX,0))
  1. .S SDCNT=SDCNT+1
  1. .S SDRESULTS(SDINDX)=""
  1. ; Loop through C x-ref
  1. S SDNAMEINDX=0
  1. F S SDNAMEINDX=$O(^SC("C",SDNAMEINDX)) Q:SDNAMEINDX="" D
  1. .Q:SDNAMEINDX'[SDSEARCHSTRING
  1. .S SDINDX=0
  1. .F S SDINDX=$O(^SC("C",SDNAMEINDX,SDINDX)) Q:'SDINDX D
  1. ..Q:'$D(^SC(SDINDX,0))
  1. ..S SDCNT=SDCNT+1
  1. ..S SDRESULTS(SDINDX)=""
  1. ; Process Matching Clinics
  1. S SDINDX=0,SDCLINCNT=0
  1. F S SDINDX=$O(SDRESULTS(SDINDX)) Q:SDINDX="" D
  1. .I SDRETURNACTIVE=0,SDSTATION'="" Q:$$WRONGDIVISION(SDINDX,SDSTATION)
  1. .I SDRETURNACTIVE=0 Q:$$INACTIVE^SDES2UTIL(SDINDX,SDDATETIME)
  1. .S SDCLINCNT=SDCLINCNT+1
  1. .I SDINDX D BUILDRETURN(SDINDX,SDCLINCNT,.SDCLINICLIST,.SDDATETIME)
  1. I SDCLINCNT=0 S SDCLINICLIST("Clinic",1)=""
  1. Q
  1. ;
  1. BUILDRETURN(SDCLINICIEN,SDCLINCNT,SDCLINICLIST,SDDATETIME) ;Build return array with reminder clinic data
  1. ; input - SDCLINICIEN = IEN of clinic in #44
  1. ; SDCLINICLIST = passed by reference, represents the array of clinics and associated data that will be returned to the client
  1. ; output - SDCLINICLIST = clinic array and their associated data to be sent back to the client
  1. ;
  1. N STATUS,SDFIELDS,SDDATA,SDPRVCNT,SDCLINPROVIDER,SDPROVIDERID,SDPROVIDERNAME,SDDEFAULTPROV,SDPROVIDERSECID
  1. S SDFIELDS=".01;1;2;2.1;8;16;50.01;60;200;2500;2502;2503"
  1. D GETS^DIQ(44,SDCLINICIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"Abbreviation")=$G(SDDATA(44,SDCLINICIEN_",",1,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"Type")=$G(SDDATA(44,SDCLINICIEN_",",2,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"TypeExtension")=$G(SDDATA(44,SDCLINICIEN_",",2.1,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"ClinicIEN")=SDCLINICIEN
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"ClinicName")=$G(SDDATA(44,SDCLINICIEN_",",.01,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"PatientFriendlyName")=$G(SDDATA(44,SDCLINICIEN_",",60,"E"))
  1. ; initialize default provider fields to null to ensure they are always defined (in the event no default provider is found)
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderActive")=""
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderIEN")=""
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderName")=""
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderSecID")=""
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"StopCodeIEN")=$G(SDDATA(44,SDCLINICIEN_",",8,"I"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"StopCodeName")=$G(SDDATA(44,SDCLINICIEN_",",8,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"StopCodeAMIS")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLINICIEN_",",8,"I")),1,"I")
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"OccasionOfServiceClinic")=$G(SDDATA(44,SDCLINICIEN_",",50.01,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"ProhibitedClinic")=$S($G(SDDATA(44,SDCLINICIEN_",",2500,"E"))="YES":1,1:0)
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"CreditStopCodeIEN")=$G(SDDATA(44,SDCLINICIEN_",",2503,"I"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"CreditStopCodeName")=$G(SDDATA(44,SDCLINICIEN_",",2503,"E"))
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"CreditStopCodeAMIS")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLINICIEN_",",2503,"I")),1,"I")
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"NonCountClinic")=$G(SDDATA(44,SDCLINICIEN_",",2502,"E"))
  1. S STATUS=$$INACTIVE^SDESUTIL(SDCLINICIEN,SDDATETIME),STATUS=$S(STATUS=1:"Inactive",1:"Active")
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"ClinicStatus")=STATUS
  1. S SDCLINICLIST("Clinic",SDCLINCNT,"PbspID")=$G(SDDATA(44,SDCLINICIEN_",",200,"E"))
  1. S SDPRVCNT=0
  1. S SDCLINPROVIDER=0 F S SDCLINPROVIDER=$O(^SC(SDCLINICIEN,"PR",SDCLINPROVIDER)) Q:'SDCLINPROVIDER D
  1. .S SDPROVIDERID=$$GET1^DIQ(44.1,SDCLINPROVIDER_","_SDCLINICIEN_",",.01,"I")
  1. .S SDPROVIDERNAME=$$GET1^DIQ(200,SDPROVIDERID,.01,"E")
  1. .S SDPROVIDERSECID=$$GET1^DIQ(200,SDPROVIDERID,205.1,"I")
  1. .S SDDEFAULTPROV=$$GET1^DIQ(44.1,SDCLINPROVIDER_","_SDCLINICIEN_",",.02,"I")
  1. .I SDDEFAULTPROV D Q
  1. ..S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderIEN")=SDPROVIDERID
  1. ..S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderName")=$$GET1^DIQ(200,SDPROVIDERID,.01,"E")
  1. ..S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderSecID")=SDPROVIDERSECID
  1. ..S SDCLINICLIST("Clinic",SDCLINCNT,"DefaultProviderActive")=$$ACTIVPRV^PXAPI(SDPROVIDERID,$G(SDDATETIME))
  1. .S SDPRVCNT=SDPRVCNT+1
  1. .S SDCLINICLIST("Clinic",SDCLINCNT,"Providers",SDPRVCNT,"Name")=SDPROVIDERNAME
  1. .S SDCLINICLIST("Clinic",SDCLINCNT,"Providers",SDPRVCNT,"ID")=SDPROVIDERID
  1. .S SDCLINICLIST("Clinic",SDCLINCNT,"Providers",SDPRVCNT,"SecID")=SDPROVIDERSECID
  1. .S SDCLINICLIST("Clinic",SDCLINCNT,"Providers",SDPRVCNT,"Active")=$$ACTIVPRV^PXAPI(SDPROVIDERID,$G(SDDATETIME))
  1. ; set empty object if no records are found
  1. I '$D(SDCLINICLIST("Clinic",SDCLINCNT,"Providers")) S SDCLINICLIST("Clinic",SDCLINCNT,"Providers",1)=""
  1. ; get subspecialties
  1. N SSCNT,SSFN,SUBSPECIEN
  1. S SSCNT=0
  1. F SSFN=301:1:302 D
  1. . S SUBSPECIEN=0
  1. . F S SUBSPECIEN=$O(^SC(SDCLINICIEN,SSFN,"B",SUBSPECIEN)) Q:'SUBSPECIEN D
  1. . . S SSCNT=SSCNT+1
  1. . . S SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty",SSCNT,"ID")=$$GET1^DIQ(409.94,SUBSPECIEN_",",.01,"E")
  1. . . S SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty",SSCNT,"Name")=$$GET1^DIQ(409.94,SUBSPECIEN_",",1)
  1. . . S SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty",SSCNT,"Tier")=$$GET1^DIQ(409.94,SUBSPECIEN_",",2,"E")
  1. . . S SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty",SSCNT,"Parent")=$$GET1^DIQ(409.94,SUBSPECIEN_",",3,"E")
  1. I '$D(SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty")) S SDCLINICLIST("Clinic",SDCLINCNT,"Subspecialty",1)=""
  1. Q
  1. ;
  1. WRONGDIVISION(SDCLINICIEN,STATION) ;
  1. ; Screen out Clinics that don't match passed in Station Number
  1. N SDDIVISION,SDINSTIEN,STATIONID
  1. S SDDIVISION=$$GET1^DIQ(44,SDCLINICIEN,3.5,"I")
  1. S SDINSTIEN=$$GET1^DIQ(40.8,SDDIVISION,.07,"I")
  1. S STATIONID=$$GET1^DIQ(4,SDINSTIEN,99,"I")
  1. I STATIONID'[STATION Q 1
  1. Q 0