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

SDES2GETCONSULTS.m

Go to the documentation of this file. 
  1. SDES2GETCONSULTS ;ALB/BWF,BLB,JAS - SDES2 VISTA SCHEDULING RPCS GET CONSULTS ;APR 16,2024
  1.  ;;5.3;Scheduling;**873,877,886**;Aug 13, 1993;Build 13
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;External References
  1.  ;-------------------
  1.  ; Reference to ^VA(200 in ICR #10060 ;
  1.  ; Reference to $$GETS^DIQ,$$GET1^DIQ in ICR #2056
  1.  ;
  1.  ;
  1.  ; ----------------- ----------------- ----------
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ; Input:
  1.  ; SDCONTEXT
  1.  ; SDINPUT("PATIENT IEN")=Patient DFN from the PATIENT file (#2)
  1.  ;
  1. GETCONSULTSBYDFN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CONSULTS BY DFN
  1.  N REQUEST,CPRSSTATUS,IFCROLE,CONSULTIEN,ERRORS,SDDUZ,DFN
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,$G(SDINPUT("PATIENT IEN")),1,,1,2)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  ;
  1.  S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
  1.  S DFN=$G(SDINPUT("PATIENT IEN"))
  1.  S CONSULTIEN=0
  1.  F  S CONSULTIEN=$O(^GMR(123,"F",DFN,CONSULTIEN)) Q:'CONSULTIEN  D
  1.  .S CPRSSTATUS=$$GET1^DIQ(123,CONSULTIEN,8,"E"),IFCROLE=$$GET1^DIQ(123,CONSULTIEN,.125,"E")
  1.  .I CPRSSTATUS'="PENDING",CPRSSTATUS'="ACTIVE" Q
  1.  .I IFCROLE="PLACER" Q
  1.  .D GETCONSULT(.REQUEST,CONSULTIEN,SDDUZ)
  1.  I '$D(REQUEST) S REQUEST("Request",1)=""
  1.  D BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
  1.  Q
  1.  ;
  1.  ; Input:
  1.  ; SDCONTEXT
  1.  ; SDINPUT("CONSULT IEN")=Patient DFN from the PATIENT file (#2)
  1.  ;
  1. GETCONSULTBYIEN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CONSULTS BY IEN
  1.  N ERRORS,REQUEST,SDDUZ,VRET
  1.  ;
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,123,$G(SDINPUT("CONSULT IEN")),1,,5,6)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  ;
  1.  S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
  1.  D GETCONSULT(.REQUEST,$G(SDINPUT("CONSULT IEN")),SDDUZ)
  1.  I '$D(REQUEST) S REQUEST("Request",1)=""
  1.  ;
  1.  D BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
  1.  Q
  1.  ;
  1. COVIDPRIORITYCHK(CONSULTIEN) ; pass back the latest entry in the comment multiple containging "covid-19 priority"
  1.  N SUBIEN,SUBIEN2,FOUND,COVIDCOMMENT
  1.  S SUBIEN=999999999,FOUND=0,COVIDCOMMENT=""
  1.  F  S SUBIEN=$O(^GMR(123,CONSULTIEN,40,SUBIEN),-1) Q:'SUBIEN!(FOUND=1)  D
  1.  .S SUBIEN2=0
  1.  .F  S SUBIEN2=$O(^GMR(123,CONSULTIEN,40,SUBIEN,1,SUBIEN2)) Q:'SUBIEN2  D
  1.  ..S COVIDCOMMENT=$$GET1^DIQ(123.25,SUBIEN2_","_SUBIEN_","_CONSULTIEN_",",.01)
  1.  ..I COVIDCOMMENT["COVID-19 Priority" D
  1.  ...S COVIDCOMMENT=$P(COVIDCOMMENT,"-COVID-19 Priority",1)
  1.  ...S FOUND=1 Q
  1.  Q COVIDCOMMENT
  1.  ;
  1. GETSTOPCODES(REQUEST,SERVICEIEN,NUM) ;
  1.  N SUBIEN,COUNT,STOPCODE
  1.  S COUNT=0,SUBIEN=0
  1.  F  S SUBIEN=$O(^GMR(123.5,SERVICEIEN,688,SUBIEN)) Q:'SUBIEN  D
  1.  .S COUNT=COUNT+1
  1.  .S STOPCODE=$$GET1^DIQ(123.5688,SUBIEN_","_SERVICEIEN_",",.01,"I")
  1.  .S REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"StopCode")=STOPCODE
  1.  .S REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"StopCodeName")=$$GET1^DIQ(40.7,STOPCODE,.01,"E")
  1.  .S REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"AmisStopCode")=$$GET1^DIQ(40.7,STOPCODE,1,"I")
  1.  .S REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"RestrictionType")=$$GET1^DIQ(40.7,STOPCODE,5,"I")
  1.  Q
  1.  ;
  1. GETPID(CONSULTIEN) ;
  1.  N CHIEN,CHSIEN,OLDESTPID
  1.  ;
  1.  S CHIEN=$O(^SDEC(409.87,"B",CONSULTIEN,0))
  1.  ;
  1.  I $G(CHIEN) D
  1.  .S CHSIEN=$O(^SDEC(409.87,CHIEN,1,9999999),-1)
  1.  .I $G(CHSIEN) D
  1.  ..S OLDESTPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
  1.  Q $S($G(OLDESTPID):OLDESTPID,1:0)
  1.  ;
  1. CONSCANCELCHECK(CONSULTIEN,DFN) ;looking for most recent appt linked to this consult and checking if cancelled by patient or clinic
  1.  N FOUND,APPTIEN,CANCHANGE,IENS
  1.  S APPTIEN="",FOUND=0,CANCHANGE=0
  1.  F  S APPTIEN=$O(^SDEC(409.84,"CPAT",DFN,APPTIEN),-1) Q:'APPTIEN!(FOUND=1)  D
  1.  .I $P($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")=CONSULTIEN S FOUND=1 D
  1.  ..I $$GET1^DIQ(409.84,APPTIEN,.17,"I")="PC" S CANCHANGE=1
  1.  ..I $$GET1^DIQ(409.84,APPTIEN,.1,"I")=1 S CANCHANGE=1
  1.  ..I $$GET1^DIQ(409.84,APPTIEN,.17,"I")="I" D
  1.  ...I $$GET1^DIQ(2.98,$$GET1^DIQ(409.84,APPTIEN,.01,"I")_","_$$GET1^DIQ(409.84,APPTIEN,.05,"I")_",",3,"I")="PC" D
  1.  ....S CANCHANGE=1
  1.  Q CANCHANGE
  1.  ;
  1. GETCONSULT(REQUEST,CONSULTIEN,SDDUZ) ;Build a consult record for every consult
  1.  N CLINICIEN,CLINICNAME,SERVICEIEN,CONDATA,CONSERR,CANCHANGEPID,PID,NUM,ERRORS,PROVIDERIEN,DFN,SENSITIVE,CONTACTIEN,PRIOGROUP
  1.  D GETS^DIQ(123,CONSULTIEN,"**","IE","CONDATA","CONSERR")
  1.  S NUM="",NUM=$O(REQUEST("Request",NUM),-1)+1
  1.  S REQUEST("Request",NUM,"Type")="Consult"
  1.  S SDDUZ=$S($G(SDDUZ)'="":SDDUZ,1:DUZ)
  1.  ;
  1.  D GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,CONSULTIEN_";GMR(123,")
  1.  D BUILDSDECONTACT^SDES2GETAPPTREQ(.REQUEST,CONSULTIEN,NUM,"C")
  1.  I 'CONTACTIEN D SDECONTACT^SDES2GETREQS(.REQUEST,NUM)
  1.  ;
  1.  S SERVICEIEN=$G(CONDATA(123,CONSULTIEN_",",1,"I"))
  1.  I $G(SERVICEIEN) D
  1.  .D GETSTOPCODES(.REQUEST,SERVICEIEN,NUM)
  1.  I '$G(SERVICEIEN) D
  1.  .S REQUEST("Request",NUM,"ConsultAssociatedStopCodes",1)=""
  1.  ;
  1.  S CLINICIEN=$G(CONDATA(123,CONSULTIEN_",",2,"I"))
  1.  S CLINICNAME=$G(CONDATA(123,CONSULTIEN_",",2,"E"))
  1.  I '$G(CLINICIEN) D
  1.  .S CLINICIEN=$G(CONDATA(123,CONSULTIEN_",",.05,"I"))
  1.  .S CLINICNAME=$G(CONDATA(123,CONSULTIEN_",",.05,"E"))
  1.  ;
  1.  I $D(^SDEC(409.87,"B",CONSULTIEN)) D
  1.  .S PID=$$GETPID(CONSULTIEN)
  1.  .S REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT(PID)
  1.  I '$D(^SDEC(409.87,"B",CONSULTIEN)) D
  1.  .S REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT($G(CONDATA(123,CONSULTIEN_",",17,"I")))
  1.  ;
  1.  S PROVIDERIEN=$G(CONDATA(123,CONSULTIEN_",",10,"I"))
  1.  S DFN=$G(CONDATA(123,CONSULTIEN_",",.02,"I"))
  1.  S PRIOGROUP=$$PRIORITY^DGENA(DFN) I PRIOGROUP S PRIOGROUP="GROUP "_PRIOGROUP
  1.  S REQUEST("Request",NUM,"Type")="Consult"
  1.  S REQUEST("Request",NUM,"PatientIEN")=DFN
  1.  S REQUEST("Request",NUM,"PatientICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
  1.  S REQUEST("Request",NUM,"PatientName")=$G(CONDATA(123,CONSULTIEN_",",.02,"E"))
  1.  S REQUEST("Request",NUM,"PatientPhone")=$$GET1^DIQ(2,DFN_",",.131,"E")
  1.  S REQUEST("Request",NUM,"RequestIEN")=CONSULTIEN
  1.  S REQUEST("Request",NUM,"ConsultRequestType")=$G(CONDATA(123,CONSULTIEN_",",13,"E"))
  1.  S REQUEST("Request",NUM,"CreateDate")=$$FMTISO^SDAMUTDT($G(CONDATA(123,CONSULTIEN_",",.01,"I")))
  1.  S REQUEST("Request",NUM,"ConsultToService")=$G(CONDATA(123,CONSULTIEN_",",1,"E"))
  1.  S REQUEST("Request",NUM,"ClinicIEN")=CLINICIEN
  1.  S REQUEST("Request",NUM,"ClinicName")=CLINICNAME
  1.  S REQUEST("Request",NUM,"EnteredByIEN")=$G(CONDATA(123,CONSULTIEN_",",10,"I"))
  1.  S REQUEST("Request",NUM,"EnteredByName")=$G(CONDATA(123,CONSULTIEN_",",10,"E"))
  1.  S REQUEST("Request",NUM,"EnrollmentPriorityGroup")=PRIOGROUP
  1.  S REQUEST("Request",NUM,"ConsultCovidPriority")=$$COVIDPRIORITYCHK(CONSULTIEN)
  1.  S REQUEST("Request",NUM,"ConsultDateReleasedFromCPRS")=$$FMTISO^SDAMUTDT($G(CONDATA(123,CONSULTIEN_",",3,"I")))
  1.  S REQUEST("Request",NUM,"ConsultUrgencyOrEarliestDate")=$$FMTISO^SDAMUTDT($$PRIO^SDEC51A(CONSULTIEN))
  1.  S REQUEST("Request",NUM,"ProviderIEN")=$G(CONDATA(123,CONSULTIEN_",",10,"I"))
  1.  S REQUEST("Request",NUM,"ProviderName")=$G(CONDATA(123,CONSULTIEN_",",10,"E"))
  1.  S REQUEST("Request",NUM,"ProviderSecID")=$$GET1^DIQ(200,PROVIDERIEN_",",205.1,"E")
  1.  S REQUEST("Request",NUM,"ConsultServiceRenderedAs")=$G(CONDATA(123,CONSULTIEN_",",14,"E"))
  1.  S REQUEST("Request",NUM,"ConsultProhibitedClinicFlag")=$S($$GET1^DIQ(44,+CLINICIEN_",",2500,"I")="Y":1,1:0)
  1.  S REQUEST("Request",NUM,"CPRSStatus")=$$GET1^DIQ(123,CONSULTIEN,8,"E")
  1.  S REQUEST("Request",NUM,"PatientLast4")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
  1.  S REQUEST("Request",NUM,"PatientIndicatedDate")=""
  1.  S REQUEST("Request",NUM,"ConsultCanEditPid")=$$CONSCANCELCHECK(CONSULTIEN,DFN)
  1.  S REQUEST("Request",NUM,"DisplayClinicAppt")=""
  1.  S REQUEST("Request",NUM,"CreditStopCodeAMIS")=""
  1.  S REQUEST("Request",NUM,"CreditStopCodeIEN")=""
  1.  S REQUEST("Request",NUM,"CreditStopCodeName")=""
  1.  ; sensitive record indicator
  1.  D SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,$G(SDDUZ))
  1.  S REQUEST("Request",NUM,"SensitiveRecord")=$G(SENSITIVE(1))
  1.  ; build appointment request and recall
  1.  I '$$GETCONTIEN^SDESCONTACTS(.ERRORS,CONSULTIEN,"C") D
  1.  .D SDECONTACT^SDES2GETREQS(.REQUEST,NUM)
  1.  D APPTREQUEST^SDES2GETREQS(.REQUEST,NUM)
  1.  D RECALL^SDES2GETREQS(.REQUEST,NUM)
  1.  Q
  1.  ;