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 Dec 13, 2024@02:53:57 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 ;
