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