SDCCRSEN1 ;CCRA/LB,PB - Appointment retrieval API;APR 4, 2019
;;5.3;Scheduling;**822,830,841,865,882**;APR 4, 2019;Build 55
Q
; Documented API's and Integration Agreements
; ----------------------------------------------
; Patch 822 Split routine SDCCRSEN due to it's growing size, created this routine and moved the MAKE, CANCEL and
; NO SHOW code to this routine adds code to insure the consult id is stored in the Hospital Location File,
; Appointment multiple and when canceling an appointment, only cancel the appointment if it is for a com care
; clinic that matches the consult service and consult id
; Patch 830 - fixing an issue from patch 822 where an error is created if the appointment is not made,
; the code sent the HL7 NAK message back to HSRM, but then continued to process. This resulted in an error
; in the VistA error trap.
; Patch 865 changes the text in the NAK messages to be more meaningful for the end user
; Patch 882 removes the Q: command on line 41 and corrects the global reference on line 54 and 55 to change it from ^SD to ^SC
MAKE ;MAKE APPOINTMENT: "S12"="SCHEDULE"
S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0
S:$G(DFN)>0 SDDFN=DFN
S:$G(SDECLEN)'>0 SDECLEN=15
;PB - Patch 865 changing error messages
I $D(^DPT(DFN,"S",STARTFM1))&(($P($G(^(STARTFM1,0)),U,2)'="C")&($P($G(^(0)),U,2)'="PC")) D
.S QUIT=0
.S QUIT=$$MSGTXT("Patient already has an appointment on "_$G(SDECSTART)_".")
Q:$G(QUIT)=1
S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,SDECSTART,SDCL,SDECRES)
I SDECAPTID>0 D
.S QUIT=$$MSGTXT("Patient already has an appointment on "_$G(SDECSTART)_".")
.S ABORT="1^"_NAKMSG
.D MESSAGE^SDCCRCOR(MID,.ABORT) ; Q
Q:$G(QUIT)=1
S SDECNOTE="HSRM, CONSULT "_$G(CONID)_" PID="_$G(CID)_" PER CONSULT, PROVIDER "_$G(PROV)
D:QUIT=0 APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,SDDFN,SDECRES,SDECLEN,$G(SDECNOTE),,,,,,,,,SDAPTYP,,,SDCL,,,,,1,,"") ;ADD NEW APPOINTMENT
;735 - PB Check to see if the appointment was made.
;822 - PB make sure the CONS node in the appt multiple of file 44 has the consult number, if it doesn't hard code it
;Cancel remarks in SC $P($P(^SC(DA(1),"S",DA,1,2,0),"^",4)," ",3),^SC(DA(1),"S",DA,"CONS")
;Cancel remarks in in DPT $P(^DPT(DA(1),"S",DA,"R")," ",3)
I +$G(^TMP("SDEC07",$J,2))>0 Q
I $P($G(^TMP("SDEC07",$J,3)),"^",2)'="" D
.N ERM,QUIT S ERM=$P($G(^TMP("SDEC07",$J,3)),"^",2) S:$G(ERM)["SDEC07 Error:" ERM=$P(ERM,":",2)
.S ERM=$TR(ERM,$C(30),".") ;S ERM=$E(ERM,1,$L(ERM)-1)_"."
.S ABORT="1^"_$G(ERM) D
.I $P($G(^TMP("SDEC07",$J,3)),"^",2)["PENDING or ACTIVE" S QUIT=$$MSGTXT("Consult status is not PENDING or ACTIVE.") Q
.;Q:$G(QUIT)'="" ;May 21, 2024 - PB - Patch 882 remove this quit it is not needed.
.I $P($G(^TMP("SDEC07",$J,3)),"^",2)'="" S QUIT=$$MSGTXT($G(ERM))
.;I $P($G(^TMP("SDEC07",$J,3)),"^",2)["SDEC07 Error:" S QUIT=$$MSGTXT($G(ERM))
.;patch 830 - PB added setting QUIT=1 and then a quit command to make sure the code stops if the appointment was not made.
.S QUIT=1
Q:QUIT=1
;May 21, 2024 - PB -Patch 882, fixed the global reference in lines 53 and 54 from ^SD to ^SC
N XCLINIC S XCLINIC=+$G(^DPT($G(DFN),"S",FMDTTM,0),"^") I $G(XCLINIC)>0 D
.;Get the correct appointment from the appointment multiple in file 44 by matching .01 with the patient DFN,
.S XCLINIC=+$P(^DPT(DFN,"S",FMDTTM,0),"^")
.I $G(XCLINIC)>0 D
..N DA,FDA,I1
..S I1=0 F S I1=$O(^SC(XCLINIC,"S",FMDTTM,1,I1)) Q:I1'>0 I +$G(^SC(XCLINIC,"S",FMDTTM,1,I1,0))=DFN S DA=I1
..I +$G(^SC(XCLINIC,"S",FMDTTM,1,DA,"CONS"))="" S FDA(44.003,DA_","_FMDTTM_","_XCLINIC_",",688)=CONID
Q
CANCEL ;CANCEL APPOINTMENT: "S15"="CANCEL"
; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to cancel the appointment
S:$G(DFN)>0 SDDFN=DFN
S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
; patch 822 - PB check to see if the appointment exists
I '$D(^DPT(DFN,"S",$G(BASEDT))) D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be cancelled.",1),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:+$G(QUIT)=1
I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1)
I $G(SDCL2)>0 D
.I $G(SDCL2)'=SDCL D
..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^")
..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES)
S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0
S:$G(SDECLEN)'>0 SDECLEN=15
;822 - PB when canceling the appointment check the CONS node for the appointment in file 44 appointment multiple
;if it matches, cancel, if it doesn't or is null, check to be sure the clinic matches to the consult service
I $G(SDCL2)'>0 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be cancelled.",1),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:+$G(QUIT)=1
S SDECAPTID=$$CANCHECK(DFN,$G(SDCL2),$G(BASEDT),$G(CONID))
I $G(SDECAPTID)=1 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be cancelled.",1),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:+$G(QUIT)=1
S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
I $G(SDECAPTID)'>0 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be cancelled.",1),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:+$G(QUIT)=1
S:$G(MSGARY("CANCEL CODE"))="" MSGARY("CANCEL CODE")="C"
S:$G(MSGARY("CANCEL REASON"))="" MSGARY("CANCEL REASON")=11
D:QUIT=0 APPDEL^SDEC08(.SDECY,SDECAPTID,$G(MSGARY("CANCEL CODE")),$G(MSGARY("CANCEL REASON")),$G(MSGARY("COMMENT")),$G(SDECDATE),$G(MSGARY("USER"))) ;CANCEL APPOINTMENT
;735 - PB Check to see if the appointment was canceled.
I $G(^TMP("SDEC08",$J,"APPDEL",2))=$C(30) Q
I $G(^TMP("SDEC08",$J,"APPDEL",2))'="" S ABORT="1^"_$G(^TMP("SDEC08",$J,"APPDEL",2)) D
.D MESSAGE^SDCCRCOR(MID,.ABORT)
.D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID))
Q
NOSHOW ;NOSHOW APPOINTMENT: "S26"="NOSHOW"
;S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0
;S:$G(DFN)>0 SDDFN=DFN
;S:$G(SDECLEN)'>0 SDECLEN=15
;check if appointment exists
; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to cancel the appointment
S:$G(DFN)>0 SDDFN=DFN
S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
; patch 822 - PB check to see if the appointment exists
I '$D(^DPT(DFN,"S",$G(BASEDT))) D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be marked as NO SHOW."),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:$G(QUIT)=1
I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1)
I $G(SDCL2)'>0 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be marked as NO SHOW."),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:$G(QUIT)=1
I $G(SDCL2)>0 D
.I $G(SDCL2)'=SDCL D
..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^")
..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES)
S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0
S:$G(SDECLEN)'>0 SDECLEN=15
;822 - PB when marking the appointment as NO SHOW check the CONS node for the appointment in file 44 appointment multiple
;if it matches, mark it as NO SHOW, if it doesn't or is null, check to be sure the clinic matches to the consult service
S SDECAPTID=$$CANCHECK(DFN,SDCL2,BASEDT,CONID)
I $G(SDECAPTID)=1 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be marked as NO SHOW."),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
Q:$G(QUIT)=1
S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
;Retrieve SDECAPTID pointer to SDEC APPOINTMENT file
;S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
;S SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
I $G(SDECAPTID)'>0 D
.S QUIT=$$MSGTXT("No Appointment was found for the patient on "_$G(SDECSTART)_" and Consult Id "_$G(CONID)_" to be marked as NO SHOW."),ABORT="1^"_ERR1 ;PB - Patch 865 new NAK message
;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,ABORT) Q
Q:$G(QUIT)=1
; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to mark the appointment as no show
N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1)
I SDCL2'=SDCL D
.S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^")
.N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES)
D:QUIT=0 NOSHOW^SDEC31(.SDECY,SDECAPTID,1,$G(MSGARY("USER")),$G(SDECDATE))
;735 - PB Check to see if the appointment was made.
I +$G(^TMP("SDEC",$J,2))>0 Q
I +$G(^TMP("SDEC",$J,2))=0 S ABORT="1^"_$P($G(^TMP("SDEC",$J,2)),"^",2) D
.D MESSAGE^SDCCRCOR(MID,.ABORT)
.D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID))
Q
CANCHECK(DFN,CLINIC,APPTTM,CONID,APPTID) ;
;Returns APT ID if the appt is ready to be canceled, 1 if the appt should not be canceled
N GOOD,APTID
S GOOD=0
; Feb 24, 23 - PB - patch 841 adding code to continue the search for the correct appt to mark as canceled or no show
S XX=0 F S XX=$O(^SC(CLINIC,"S",APPTTM,1,XX)) Q:XX'>0 I +$P(^SC(CLINIC,"S",APPTTM,1,XX,0),"^")=DFN D
.Q:$P(^SC(CLINIC,"S",APPTTM,1,XX,0),"^",9)'=""
.I +$P($G(^SC(CLINIC,"S",APPTTM,1,XX,"CONS")),"^")'=CONID S GOOD=1
.I $P($G(^SC(CLINIC,0)),"^")'["COM CARE" S GOOD=1
I $G(GOOD)=1 Q GOOD
S APTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
K XX
Q APTID
MSGTXT(ERTXT,CAN) ;
S QUIT=0 N AMPM
I $L($P(STARTFM1,".",2))=2 S STARTFM1=STARTFM1_"00"
S AMPM=$$FMTE^XLFDT(STARTFM1,"2P"),AMPM=$P(AMPM," ",1,2)_$P(AMPM," ",3)
S AMPM=$P(AMPM," ",1)_" at "_$P(AMPM," ",2)
S RTN="The appointment at Community Care Provider, "_$G(PROVIDER)_" on "_$G(AMPM)_" was rejected and not written to VistA. "_$G(ERTXT)
S:$G(CAN)=1 RTN="The appointment cancellation at Community Care Provider, "_$G(PROVIDER)_" on "_$G(AMPM)_" was rejected and not written to VistA. "_$G(ERTXT)
S (NAKMSG,ERR1)=RTN,ABORT="1^"_ERR1,DUZ=.5,QUIT=1
I $G(NAKMSG)'="" D ANAK^SDCCRCOR($G(NAKMSG),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)),MESSAGE^SDCCRCOR(MID,.ABORT)
Q QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCCRSEN1 10958 printed Dec 13, 2024@02:48:54 Page 2
SDCCRSEN1 ;CCRA/LB,PB - Appointment retrieval API;APR 4, 2019
+1 ;;5.3;Scheduling;**822,830,841,865,882**;APR 4, 2019;Build 55
+2 QUIT
+3 ; Documented API's and Integration Agreements
+4 ; ----------------------------------------------
+5 ; Patch 822 Split routine SDCCRSEN due to it's growing size, created this routine and moved the MAKE, CANCEL and
+6 ; NO SHOW code to this routine adds code to insure the consult id is stored in the Hospital Location File,
+7 ; Appointment multiple and when canceling an appointment, only cancel the appointment if it is for a com care
+8 ; clinic that matches the consult service and consult id
+9 ; Patch 830 - fixing an issue from patch 822 where an error is created if the appointment is not made,
+10 ; the code sent the HL7 NAK message back to HSRM, but then continued to process. This resulted in an error
+11 ; in the VistA error trap.
+12 ; Patch 865 changes the text in the NAK messages to be more meaningful for the end user
+13 ; Patch 882 removes the Q: command on line 41 and corrects the global reference on line 54 and 55 to change it from ^SD to ^SC
MAKE ;MAKE APPOINTMENT: "S12"="SCHEDULE"
+1 SET SDECLEN=$PIECE(^SC(SDCL,"SL"),"^",1)
SET SDECAPTID=0
+2 if $GET(DFN)>0
SET SDDFN=DFN
+3 if $GET(SDECLEN)'>0
SET SDECLEN=15
+4 ;PB - Patch 865 changing error messages
+5 IF $DATA(^DPT(DFN,"S",STARTFM1))&(($PIECE($GET(^(STARTFM1,0)),U,2)'="C")&($PIECE($GET(^(0)),U,2)'="PC"))
Begin DoDot:1
+6 SET QUIT=0
+7 SET QUIT=$$MSGTXT("Patient already has an appointment on "_$GET(SDECSTART)_".")
End DoDot:1
+8 if $GET(QUIT)=1
QUIT
+9 if $GET(SDDFN)>0
SET SDECAPTID=$$APPTGET^SDECUTL(SDDFN,SDECSTART,SDCL,SDECRES)
+10 IF SDECAPTID>0
Begin DoDot:1
+11 SET QUIT=$$MSGTXT("Patient already has an appointment on "_$GET(SDECSTART)_".")
+12 SET ABORT="1^"_NAKMSG
+13 ; Q
DO MESSAGE^SDCCRCOR(MID,.ABORT)
End DoDot:1
+14 if $GET(QUIT)=1
QUIT
+15 SET SDECNOTE="HSRM, CONSULT "_$GET(CONID)_" PID="_$GET(CID)_" PER CONSULT, PROVIDER "_$GET(PROV)
+16 ;ADD NEW APPOINTMENT
if QUIT=0
DO APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,SDDFN,SDECRES,SDECLEN,$GET(SDECNOTE),,,,,,,,,SDAPTYP,,,SDCL,,,,,1,,"")
+17 ;735 - PB Check to see if the appointment was made.
+18 ;822 - PB make sure the CONS node in the appt multiple of file 44 has the consult number, if it doesn't hard code it
+19 ;Cancel remarks in SC $P($P(^SC(DA(1),"S",DA,1,2,0),"^",4)," ",3),^SC(DA(1),"S",DA,"CONS")
+20 ;Cancel remarks in in DPT $P(^DPT(DA(1),"S",DA,"R")," ",3)
+21 IF +$GET(^TMP("SDEC07",$JOB,2))>0
QUIT
+22 IF $PIECE($GET(^TMP("SDEC07",$JOB,3)),"^",2)'=""
Begin DoDot:1
+23 NEW ERM,QUIT
SET ERM=$PIECE($GET(^TMP("SDEC07",$JOB,3)),"^",2)
if $GET(ERM)["SDEC07 Error
SET ERM=$PIECE(ERM,":",2)
+24 ;S ERM=$E(ERM,1,$L(ERM)-1)_"."
SET ERM=$TRANSLATE(ERM,$CHAR(30),".")
+25 SET ABORT="1^"_$GET(ERM)
Begin DoDot:2
End DoDot:2
+26 IF $PIECE($GET(^TMP("SDEC07",$JOB,3)),"^",2)["PENDING or ACTIVE"
SET QUIT=$$MSGTXT("Consult status is not PENDING or ACTIVE.")
QUIT
+27 ;Q:$G(QUIT)'="" ;May 21, 2024 - PB - Patch 882 remove this quit it is not needed.
+28 IF $PIECE($GET(^TMP("SDEC07",$JOB,3)),"^",2)'=""
SET QUIT=$$MSGTXT($GET(ERM))
+29 ;I $P($G(^TMP("SDEC07",$J,3)),"^",2)["SDEC07 Error:" S QUIT=$$MSGTXT($G(ERM))
+30 ;patch 830 - PB added setting QUIT=1 and then a quit command to make sure the code stops if the appointment was not made.
+31 SET QUIT=1
End DoDot:1
+32 if QUIT=1
QUIT
+33 ;May 21, 2024 - PB -Patch 882, fixed the global reference in lines 53 and 54 from ^SD to ^SC
+34 NEW XCLINIC
SET XCLINIC=+$GET(^DPT($GET(DFN),"S",FMDTTM,0),"^")
IF $GET(XCLINIC)>0
Begin DoDot:1
+35 ;Get the correct appointment from the appointment multiple in file 44 by matching .01 with the patient DFN,
+36 SET XCLINIC=+$PIECE(^DPT(DFN,"S",FMDTTM,0),"^")
+37 IF $GET(XCLINIC)>0
Begin DoDot:2
+38 NEW DA,FDA,I1
+39 SET I1=0
FOR
SET I1=$ORDER(^SC(XCLINIC,"S",FMDTTM,1,I1))
if I1'>0
QUIT
IF +$GET(^SC(XCLINIC,"S",FMDTTM,1,I1,0))=DFN
SET DA=I1
+40 IF +$GET(^SC(XCLINIC,"S",FMDTTM,1,DA,"CONS"))=""
SET FDA(44.003,DA_","_FMDTTM_","_XCLINIC_",",688)=CONID
End DoDot:2
End DoDot:1
+41 QUIT
CANCEL ;CANCEL APPOINTMENT: "S15"="CANCEL"
+1 ; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to cancel the appointment
+2 if $GET(DFN)>0
SET SDDFN=DFN
+3 SET BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
+4 ; patch 822 - PB check to see if the appointment exists
+5 IF '$DATA(^DPT(DFN,"S",$GET(BASEDT)))
Begin DoDot:1
+6 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be cancelled.",1)
SET ABORT="1^"_ERR1
End DoDot:1
+7 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+8 if +$GET(QUIT)=1
QUIT
+9 IF $DATA(^DPT(DFN,"S",$GET(BASEDT)))
NEW SDCL2
SET SDCL2=$PIECE(^DPT(DFN,"S",$GET(BASEDT),0),"^",1)
+10 IF $GET(SDCL2)>0
Begin DoDot:1
+11 IF $GET(SDCL2)'=SDCL
Begin DoDot:2
+12 SET SDCL=SDCL2
SET SRVNAMEX=$PIECE(^SC(SDCL,0),"^")
+13 NEW SDRES
SET SDRES=$ORDER(^SDEC(409.831,"B",$GET(SRVNAMEX),""))
if $GET(SDRES)>0
SET SDECRES=$GET(SDRES)
End DoDot:2
End DoDot:1
+14 SET SDECLEN=$PIECE(^SC(SDCL,"SL"),"^",1)
SET SDECAPTID=0
+15 if $GET(SDECLEN)'>0
SET SDECLEN=15
+16 ;822 - PB when canceling the appointment check the CONS node for the appointment in file 44 appointment multiple
+17 ;if it matches, cancel, if it doesn't or is null, check to be sure the clinic matches to the consult service
+18 IF $GET(SDCL2)'>0
Begin DoDot:1
+19 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be cancelled.",1)
SET ABORT="1^"_ERR1
End DoDot:1
+20 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+21 if +$GET(QUIT)=1
QUIT
+22 SET SDECAPTID=$$CANCHECK(DFN,$GET(SDCL2),$GET(BASEDT),$GET(CONID))
+23 IF $GET(SDECAPTID)=1
Begin DoDot:1
+24 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be cancelled.",1)
SET ABORT="1^"_ERR1
End DoDot:1
+25 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+26 if +$GET(QUIT)=1
QUIT
+27 if $GET(SDDFN)>0
SET SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
+28 IF $GET(SDECAPTID)'>0
Begin DoDot:1
+29 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be cancelled.",1)
SET ABORT="1^"_ERR1
End DoDot:1
+30 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+31 if +$GET(QUIT)=1
QUIT
+32 if $GET(MSGARY("CANCEL CODE"))=""
SET MSGARY("CANCEL CODE")="C"
+33 if $GET(MSGARY("CANCEL REASON"))=""
SET MSGARY("CANCEL REASON")=11
+34 ;CANCEL APPOINTMENT
if QUIT=0
DO APPDEL^SDEC08(.SDECY,SDECAPTID,$GET(MSGARY("CANCEL CODE")),$GET(MSGARY("CANCEL REASON")),$GET(MSGARY("COMMENT")),$GET(SDECDATE),$GET(MSGARY("USER")))
+35 ;735 - PB Check to see if the appointment was canceled.
+36 IF $GET(^TMP("SDEC08",$JOB,"APPDEL",2))=$CHAR(30)
QUIT
+37 IF $GET(^TMP("SDEC08",$JOB,"APPDEL",2))'=""
SET ABORT="1^"_$GET(^TMP("SDEC08",$JOB,"APPDEL",2))
Begin DoDot:1
+38 DO MESSAGE^SDCCRCOR(MID,.ABORT)
+39 DO ANAK^SDCCRCOR($PIECE($GET(ABORT),"^",2),$GET(USERMAIL),$GET(ICN),$GET(DFN),$GET(APTTM),$GET(CONID))
End DoDot:1
+40 QUIT
NOSHOW ;NOSHOW APPOINTMENT: "S26"="NOSHOW"
+1 ;S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0
+2 ;S:$G(DFN)>0 SDDFN=DFN
+3 ;S:$G(SDECLEN)'>0 SDECLEN=15
+4 ;check if appointment exists
+5 ; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to cancel the appointment
+6 if $GET(DFN)>0
SET SDDFN=DFN
+7 SET BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
+8 ; patch 822 - PB check to see if the appointment exists
+9 IF '$DATA(^DPT(DFN,"S",$GET(BASEDT)))
Begin DoDot:1
+10 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be marked as NO SHOW.")
SET ABORT="1^"_ERR1
End DoDot:1
+11 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+12 if $GET(QUIT)=1
QUIT
+13 IF $DATA(^DPT(DFN,"S",$GET(BASEDT)))
NEW SDCL2
SET SDCL2=$PIECE(^DPT(DFN,"S",$GET(BASEDT),0),"^",1)
+14 IF $GET(SDCL2)'>0
Begin DoDot:1
+15 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be marked as NO SHOW.")
SET ABORT="1^"_ERR1
End DoDot:1
+16 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+17 if $GET(QUIT)=1
QUIT
+18 IF $GET(SDCL2)>0
Begin DoDot:1
+19 IF $GET(SDCL2)'=SDCL
Begin DoDot:2
+20 SET SDCL=SDCL2
SET SRVNAMEX=$PIECE(^SC(SDCL,0),"^")
+21 NEW SDRES
SET SDRES=$ORDER(^SDEC(409.831,"B",$GET(SRVNAMEX),""))
if $GET(SDRES)>0
SET SDECRES=$GET(SDRES)
End DoDot:2
End DoDot:1
+22 SET SDECLEN=$PIECE(^SC(SDCL,"SL"),"^",1)
SET SDECAPTID=0
+23 if $GET(SDECLEN)'>0
SET SDECLEN=15
+24 ;822 - PB when marking the appointment as NO SHOW check the CONS node for the appointment in file 44 appointment multiple
+25 ;if it matches, mark it as NO SHOW, if it doesn't or is null, check to be sure the clinic matches to the consult service
+26 SET SDECAPTID=$$CANCHECK(DFN,SDCL2,BASEDT,CONID)
+27 IF $GET(SDECAPTID)=1
Begin DoDot:1
+28 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be marked as NO SHOW.")
SET ABORT="1^"_ERR1
End DoDot:1
+29 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT)
+30 if $GET(QUIT)=1
QUIT
+31 if $GET(SDDFN)>0
SET SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
+32 ;Retrieve SDECAPTID pointer to SDEC APPOINTMENT file
+33 ;S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y")
+34 ;S SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
+35 IF $GET(SDECAPTID)'>0
Begin DoDot:1
+36 ;PB - Patch 865 new NAK message
SET QUIT=$$MSGTXT("No Appointment was found for the patient on "_$GET(SDECSTART)_" and Consult Id "_$GET(CONID)_" to be marked as NO SHOW.")
SET ABORT="1^"_ERR1
End DoDot:1
+37 ;I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,ABORT) Q
+38 if $GET(QUIT)=1
QUIT
+39 ; patch 808 - PB compare the clinic in the Patient file appointment multiple. if it matches good, otherwise use the clinic from the appointment multiple to mark the appointment as no show
+40 NEW SDCL2
SET SDCL2=$PIECE(^DPT(DFN,"S",$GET(BASEDT),0),"^",1)
+41 IF SDCL2'=SDCL
Begin DoDot:1
+42 SET SDCL=SDCL2
SET SRVNAMEX=$PIECE(^SC(SDCL,0),"^")
+43 NEW SDRES
SET SDRES=$ORDER(^SDEC(409.831,"B",$GET(SRVNAMEX),""))
if $GET(SDRES)>0
SET SDECRES=$GET(SDRES)
End DoDot:1
+44 if QUIT=0
DO NOSHOW^SDEC31(.SDECY,SDECAPTID,1,$GET(MSGARY("USER")),$GET(SDECDATE))
+45 ;735 - PB Check to see if the appointment was made.
+46 IF +$GET(^TMP("SDEC",$JOB,2))>0
QUIT
+47 IF +$GET(^TMP("SDEC",$JOB,2))=0
SET ABORT="1^"_$PIECE($GET(^TMP("SDEC",$JOB,2)),"^",2)
Begin DoDot:1
+48 DO MESSAGE^SDCCRCOR(MID,.ABORT)
+49 DO ANAK^SDCCRCOR($PIECE($GET(ABORT),"^",2),$GET(USERMAIL),$GET(ICN),$GET(DFN),$GET(APTTM),$GET(CONID))
End DoDot:1
+50 QUIT
CANCHECK(DFN,CLINIC,APPTTM,CONID,APPTID) ;
+1 ;Returns APT ID if the appt is ready to be canceled, 1 if the appt should not be canceled
+2 NEW GOOD,APTID
+3 SET GOOD=0
+4 ; Feb 24, 23 - PB - patch 841 adding code to continue the search for the correct appt to mark as canceled or no show
+5 SET XX=0
FOR
SET XX=$ORDER(^SC(CLINIC,"S",APPTTM,1,XX))
if XX'>0
QUIT
IF +$PIECE(^SC(CLINIC,"S",APPTTM,1,XX,0),"^")=DFN
Begin DoDot:1
+6 if $PIECE(^SC(CLINIC,"S",APPTTM,1,XX,0),"^",9)'=""
QUIT
+7 IF +$PIECE($GET(^SC(CLINIC,"S",APPTTM,1,XX,"CONS")),"^")'=CONID
SET GOOD=1
+8 IF $PIECE($GET(^SC(CLINIC,0)),"^")'["COM CARE"
SET GOOD=1
End DoDot:1
+9 IF $GET(GOOD)=1
QUIT GOOD
+10 SET APTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES)
+11 KILL XX
+12 QUIT APTID
MSGTXT(ERTXT,CAN) ;
+1 SET QUIT=0
NEW AMPM
+2 IF $LENGTH($PIECE(STARTFM1,".",2))=2
SET STARTFM1=STARTFM1_"00"
+3 SET AMPM=$$FMTE^XLFDT(STARTFM1,"2P")
SET AMPM=$PIECE(AMPM," ",1,2)_$PIECE(AMPM," ",3)
+4 SET AMPM=$PIECE(AMPM," ",1)_" at "_$PIECE(AMPM," ",2)
+5 SET RTN="The appointment at Community Care Provider, "_$GET(PROVIDER)_" on "_$GET(AMPM)_" was rejected and not written to VistA. "_$GET(ERTXT)
+6 if $GET(CAN)=1
SET RTN="The appointment cancellation at Community Care Provider, "_$GET(PROVIDER)_" on "_$GET(AMPM)_" was rejected and not written to VistA. "_$GET(ERTXT)
+7 SET (NAKMSG,ERR1)=RTN
SET ABORT="1^"_ERR1
SET DUZ=.5
SET QUIT=1
+8 IF $GET(NAKMSG)'=""
DO ANAK^SDCCRCOR($GET(NAKMSG),$GET(USERMAIL),$GET(ICN),$GET(DFN),$GET(APTTM),$GET(CONID))
DO MESSAGE^SDCCRCOR(MID,.ABORT)
+9 QUIT QUIT
