- SDES2GETCONSULTS ;ALB/BWF,BLB,JAS - SDES2 VISTA SCHEDULING RPCS GET CONSULTS ;APR 16,2024
- ;;5.3;Scheduling;**873,877,886**;Aug 13, 1993;Build 13
- ;;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))
- ;
- I $G(CHIEN) D
- .S CHSIEN=$O(^SDEC(409.87,CHIEN,1,9999999),-1)
- .I $G(CHSIEN) D
- ..S OLDESTPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
- Q $S($G(OLDESTPID):OLDESTPID,1:0)
- ;
- CONSCANCELCHECK(CONSULTIEN,DFN) ;looking for most recent appt linked to this consult and checking if cancelled by patient or clinic
- N FOUND,APPTIEN,CANCHANGE,IENS
- S APPTIEN="",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
- ..I $$GET1^DIQ(409.84,APPTIEN,.17,"I")="I" D
- ...I $$GET1^DIQ(2.98,$$GET1^DIQ(409.84,APPTIEN,.01,"I")_","_$$GET1^DIQ(409.84,APPTIEN,.05,"I")_",",3,"I")="PC" D
- ....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"))
- ;
- I $D(^SDEC(409.87,"B",CONSULTIEN)) D
- .S PID=$$GETPID(CONSULTIEN)
- .S REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT(PID)
- I '$D(^SDEC(409.87,"B",CONSULTIEN)) D
- .S REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT($G(CONDATA(123,CONSULTIEN_",",17,"I")))
- ;
- 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,"PatientPhone")=$$GET1^DIQ(2,DFN_",",.131,"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,"PatientLast4")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
- S REQUEST("Request",NUM,"PatientIndicatedDate")=""
- S REQUEST("Request",NUM,"ConsultCanEditPid")=$$CONSCANCELCHECK(CONSULTIEN,DFN)
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETCONSULTS 8503 printed Mar 13, 2025@21:59 Page 2
- 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
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 ;External References
- +5 ;-------------------
- +6 ; Reference to ^VA(200 in ICR #10060 ;
- +7 ; Reference to $$GETS^DIQ,$$GET1^DIQ in ICR #2056
- +8 ;
- +9 ;
- +10 ; ----------------- ----------------- ----------
- +11 ;
- +12 ;
- +13 QUIT
- +14 ;
- +15 ; Input:
- +16 ; SDCONTEXT
- +17 ; SDINPUT("PATIENT IEN")=Patient DFN from the PATIENT file (#2)
- +18 ;
- GETCONSULTSBYDFN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CONSULTS BY DFN
- +1 NEW REQUEST,CPRSSTATUS,IFCROLE,CONSULTIEN,ERRORS,SDDUZ,DFN
- +2 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
- +3 IF $DATA(ERRORS)
- SET ERRORS("Request",1)=""
- DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
- QUIT
- +4 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,$GET(SDINPUT("PATIENT IEN")),1,,1,2)
- +5 IF $DATA(ERRORS)
- SET ERRORS("Request",1)=""
- DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
- QUIT
- +6 ;
- +7 SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
- +8 SET DFN=$GET(SDINPUT("PATIENT IEN"))
- +9 SET CONSULTIEN=0
- +10 FOR
- SET CONSULTIEN=$ORDER(^GMR(123,"F",DFN,CONSULTIEN))
- if 'CONSULTIEN
- QUIT
- Begin DoDot:1
- +11 SET CPRSSTATUS=$$GET1^DIQ(123,CONSULTIEN,8,"E")
- SET IFCROLE=$$GET1^DIQ(123,CONSULTIEN,.125,"E")
- +12 IF CPRSSTATUS'="PENDING"
- IF CPRSSTATUS'="ACTIVE"
- QUIT
- +13 IF IFCROLE="PLACER"
- QUIT
- +14 DO GETCONSULT(.REQUEST,CONSULTIEN,SDDUZ)
- End DoDot:1
- +15 IF '$DATA(REQUEST)
- SET REQUEST("Request",1)=""
- +16 DO BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
- +17 QUIT
- +18 ;
- +19 ; Input:
- +20 ; SDCONTEXT
- +21 ; SDINPUT("CONSULT IEN")=Patient DFN from the PATIENT file (#2)
- +22 ;
- GETCONSULTBYIEN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET CONSULTS BY IEN
- +1 NEW ERRORS,REQUEST,SDDUZ,VRET
- +2 ;
- +3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
- +4 IF $DATA(ERRORS)
- SET ERRORS("Request",1)=""
- DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
- QUIT
- +5 DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,123,$GET(SDINPUT("CONSULT IEN")),1,,5,6)
- +6 IF $DATA(ERRORS)
- SET ERRORS("Request",1)=""
- DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
- QUIT
- +7 ;
- +8 SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
- +9 DO GETCONSULT(.REQUEST,$GET(SDINPUT("CONSULT IEN")),SDDUZ)
- +10 IF '$DATA(REQUEST)
- SET REQUEST("Request",1)=""
- +11 ;
- +12 DO BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
- +13 QUIT
- +14 ;
- COVIDPRIORITYCHK(CONSULTIEN) ; pass back the latest entry in the comment multiple containging "covid-19 priority"
- +1 NEW SUBIEN,SUBIEN2,FOUND,COVIDCOMMENT
- +2 SET SUBIEN=999999999
- SET FOUND=0
- SET COVIDCOMMENT=""
- +3 FOR
- SET SUBIEN=$ORDER(^GMR(123,CONSULTIEN,40,SUBIEN),-1)
- if 'SUBIEN!(FOUND=1)
- QUIT
- Begin DoDot:1
- +4 SET SUBIEN2=0
- +5 FOR
- SET SUBIEN2=$ORDER(^GMR(123,CONSULTIEN,40,SUBIEN,1,SUBIEN2))
- if 'SUBIEN2
- QUIT
- Begin DoDot:2
- +6 SET COVIDCOMMENT=$$GET1^DIQ(123.25,SUBIEN2_","_SUBIEN_","_CONSULTIEN_",",.01)
- +7 IF COVIDCOMMENT["COVID-19 Priority"
- Begin DoDot:3
- +8 SET COVIDCOMMENT=$PIECE(COVIDCOMMENT,"-COVID-19 Priority",1)
- +9 SET FOUND=1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT COVIDCOMMENT
- +11 ;
- GETSTOPCODES(REQUEST,SERVICEIEN,NUM) ;
- +1 NEW SUBIEN,COUNT,STOPCODE
- +2 SET COUNT=0
- SET SUBIEN=0
- +3 FOR
- SET SUBIEN=$ORDER(^GMR(123.5,SERVICEIEN,688,SUBIEN))
- if 'SUBIEN
- QUIT
- Begin DoDot:1
- +4 SET COUNT=COUNT+1
- +5 SET STOPCODE=$$GET1^DIQ(123.5688,SUBIEN_","_SERVICEIEN_",",.01,"I")
- +6 SET REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"StopCode")=STOPCODE
- +7 SET REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"StopCodeName")=$$GET1^DIQ(40.7,STOPCODE,.01,"E")
- +8 SET REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"AmisStopCode")=$$GET1^DIQ(40.7,STOPCODE,1,"I")
- +9 SET REQUEST("Request",NUM,"ConsultAssociatedStopCodes",COUNT,"RestrictionType")=$$GET1^DIQ(40.7,STOPCODE,5,"I")
- End DoDot:1
- +10 QUIT
- +11 ;
- GETPID(CONSULTIEN) ;
- +1 NEW CHIEN,CHSIEN,OLDESTPID
- +2 ;
- +3 SET CHIEN=$ORDER(^SDEC(409.87,"B",CONSULTIEN,0))
- +4 ;
- +5 IF $GET(CHIEN)
- Begin DoDot:1
- +6 SET CHSIEN=$ORDER(^SDEC(409.87,CHIEN,1,9999999),-1)
- +7 IF $GET(CHSIEN)
- Begin DoDot:2
- +8 SET OLDESTPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
- End DoDot:2
- End DoDot:1
- +9 QUIT $SELECT($GET(OLDESTPID):OLDESTPID,1:0)
- +10 ;
- CONSCANCELCHECK(CONSULTIEN,DFN) ;looking for most recent appt linked to this consult and checking if cancelled by patient or clinic
- +1 NEW FOUND,APPTIEN,CANCHANGE,IENS
- +2 SET APPTIEN=""
- SET FOUND=0
- SET CANCHANGE=0
- +3 FOR
- SET APPTIEN=$ORDER(^SDEC(409.84,"CPAT",DFN,APPTIEN),-1)
- if 'APPTIEN!(FOUND=1)
- QUIT
- Begin DoDot:1
- +4 IF $PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";")=CONSULTIEN
- SET FOUND=1
- Begin DoDot:2
- +5 IF $$GET1^DIQ(409.84,APPTIEN,.17,"I")="PC"
- SET CANCHANGE=1
- +6 IF $$GET1^DIQ(409.84,APPTIEN,.1,"I")=1
- SET CANCHANGE=1
- +7 IF $$GET1^DIQ(409.84,APPTIEN,.17,"I")="I"
- Begin DoDot:3
- +8 IF $$GET1^DIQ(2.98,$$GET1^DIQ(409.84,APPTIEN,.01,"I")_","_$$GET1^DIQ(409.84,APPTIEN,.05,"I")_",",3,"I")="PC"
- Begin DoDot:4
- +9 SET CANCHANGE=1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT CANCHANGE
- +11 ;
- GETCONSULT(REQUEST,CONSULTIEN,SDDUZ) ;Build a consult record for every consult
- +1 NEW CLINICIEN,CLINICNAME,SERVICEIEN,CONDATA,CONSERR,CANCHANGEPID,PID,NUM,ERRORS,PROVIDERIEN,DFN,SENSITIVE,CONTACTIEN,PRIOGROUP
- +2 DO GETS^DIQ(123,CONSULTIEN,"**","IE","CONDATA","CONSERR")
- +3 SET NUM=""
- SET NUM=$ORDER(REQUEST("Request",NUM),-1)+1
- +4 SET REQUEST("Request",NUM,"Type")="Consult"
- +5 SET SDDUZ=$SELECT($GET(SDDUZ)'="":SDDUZ,1:DUZ)
- +6 ;
- +7 DO GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,CONSULTIEN_";GMR(123,")
- +8 DO BUILDSDECONTACT^SDES2GETAPPTREQ(.REQUEST,CONSULTIEN,NUM,"C")
- +9 IF 'CONTACTIEN
- DO SDECONTACT^SDES2GETREQS(.REQUEST,NUM)
- +10 ;
- +11 SET SERVICEIEN=$GET(CONDATA(123,CONSULTIEN_",",1,"I"))
- +12 IF $GET(SERVICEIEN)
- Begin DoDot:1
- +13 DO GETSTOPCODES(.REQUEST,SERVICEIEN,NUM)
- End DoDot:1
- +14 IF '$GET(SERVICEIEN)
- Begin DoDot:1
- +15 SET REQUEST("Request",NUM,"ConsultAssociatedStopCodes",1)=""
- End DoDot:1
- +16 ;
- +17 SET CLINICIEN=$GET(CONDATA(123,CONSULTIEN_",",2,"I"))
- +18 SET CLINICNAME=$GET(CONDATA(123,CONSULTIEN_",",2,"E"))
- +19 IF '$GET(CLINICIEN)
- Begin DoDot:1
- +20 SET CLINICIEN=$GET(CONDATA(123,CONSULTIEN_",",.05,"I"))
- +21 SET CLINICNAME=$GET(CONDATA(123,CONSULTIEN_",",.05,"E"))
- End DoDot:1
- +22 ;
- +23 IF $DATA(^SDEC(409.87,"B",CONSULTIEN))
- Begin DoDot:1
- +24 SET PID=$$GETPID(CONSULTIEN)
- +25 SET REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT(PID)
- End DoDot:1
- +26 IF '$DATA(^SDEC(409.87,"B",CONSULTIEN))
- Begin DoDot:1
- +27 SET REQUEST("Request",NUM,"ConsultClinicIndicatedDate")=$$FMTISO^SDAMUTDT($GET(CONDATA(123,CONSULTIEN_",",17,"I")))
- End DoDot:1
- +28 ;
- +29 SET PROVIDERIEN=$GET(CONDATA(123,CONSULTIEN_",",10,"I"))
- +30 SET DFN=$GET(CONDATA(123,CONSULTIEN_",",.02,"I"))
- +31 SET PRIOGROUP=$$PRIORITY^DGENA(DFN)
- IF PRIOGROUP
- SET PRIOGROUP="GROUP "_PRIOGROUP
- +32 SET REQUEST("Request",NUM,"Type")="Consult"
- +33 SET REQUEST("Request",NUM,"PatientIEN")=DFN
- +34 SET REQUEST("Request",NUM,"PatientICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
- +35 SET REQUEST("Request",NUM,"PatientName")=$GET(CONDATA(123,CONSULTIEN_",",.02,"E"))
- +36 SET REQUEST("Request",NUM,"PatientPhone")=$$GET1^DIQ(2,DFN_",",.131,"E")
- +37 SET REQUEST("Request",NUM,"RequestIEN")=CONSULTIEN
- +38 SET REQUEST("Request",NUM,"ConsultRequestType")=$GET(CONDATA(123,CONSULTIEN_",",13,"E"))
- +39 SET REQUEST("Request",NUM,"CreateDate")=$$FMTISO^SDAMUTDT($GET(CONDATA(123,CONSULTIEN_",",.01,"I")))
- +40 SET REQUEST("Request",NUM,"ConsultToService")=$GET(CONDATA(123,CONSULTIEN_",",1,"E"))
- +41 SET REQUEST("Request",NUM,"ClinicIEN")=CLINICIEN
- +42 SET REQUEST("Request",NUM,"ClinicName")=CLINICNAME
- +43 SET REQUEST("Request",NUM,"EnteredByIEN")=$GET(CONDATA(123,CONSULTIEN_",",10,"I"))
- +44 SET REQUEST("Request",NUM,"EnteredByName")=$GET(CONDATA(123,CONSULTIEN_",",10,"E"))
- +45 SET REQUEST("Request",NUM,"EnrollmentPriorityGroup")=PRIOGROUP
- +46 SET REQUEST("Request",NUM,"ConsultCovidPriority")=$$COVIDPRIORITYCHK(CONSULTIEN)
- +47 SET REQUEST("Request",NUM,"ConsultDateReleasedFromCPRS")=$$FMTISO^SDAMUTDT($GET(CONDATA(123,CONSULTIEN_",",3,"I")))
- +48 SET REQUEST("Request",NUM,"ConsultUrgencyOrEarliestDate")=$$FMTISO^SDAMUTDT($$PRIO^SDEC51A(CONSULTIEN))
- +49 SET REQUEST("Request",NUM,"ProviderIEN")=$GET(CONDATA(123,CONSULTIEN_",",10,"I"))
- +50 SET REQUEST("Request",NUM,"ProviderName")=$GET(CONDATA(123,CONSULTIEN_",",10,"E"))
- +51 SET REQUEST("Request",NUM,"ProviderSecID")=$$GET1^DIQ(200,PROVIDERIEN_",",205.1,"E")
- +52 SET REQUEST("Request",NUM,"ConsultServiceRenderedAs")=$GET(CONDATA(123,CONSULTIEN_",",14,"E"))
- +53 SET REQUEST("Request",NUM,"ConsultProhibitedClinicFlag")=$SELECT($$GET1^DIQ(44,+CLINICIEN_",",2500,"I")="Y":1,1:0)
- +54 SET REQUEST("Request",NUM,"CPRSStatus")=$$GET1^DIQ(123,CONSULTIEN,8,"E")
- +55 SET REQUEST("Request",NUM,"PatientLast4")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
- +56 SET REQUEST("Request",NUM,"PatientIndicatedDate")=""
- +57 SET REQUEST("Request",NUM,"ConsultCanEditPid")=$$CONSCANCELCHECK(CONSULTIEN,DFN)
- +58 SET REQUEST("Request",NUM,"DisplayClinicAppt")=""
- +59 SET REQUEST("Request",NUM,"CreditStopCodeAMIS")=""
- +60 SET REQUEST("Request",NUM,"CreditStopCodeIEN")=""
- +61 SET REQUEST("Request",NUM,"CreditStopCodeName")=""
- +62 ; sensitive record indicator
- +63 DO SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,$GET(SDDUZ))
- +64 SET REQUEST("Request",NUM,"SensitiveRecord")=$GET(SENSITIVE(1))
- +65 ; build appointment request and recall
- +66 IF '$$GETCONTIEN^SDESCONTACTS(.ERRORS,CONSULTIEN,"C")
- Begin DoDot:1
- +67 DO SDECONTACT^SDES2GETREQS(.REQUEST,NUM)
- End DoDot:1
- +68 DO APPTREQUEST^SDES2GETREQS(.REQUEST,NUM)
- +69 DO RECALL^SDES2GETREQS(.REQUEST,NUM)
- +70 QUIT
- +71 ;