EMERGENCY Released SD*5.3*830 SEQ #685 Extracted from mail message **KIDS**:SD*5.3*830^ **INSTALL NAME** SD*5.3*830 "BLD",12501,0) SD*5.3*830^SCHEDULING^0^3221026^y "BLD",12501,4,0) ^9.64PA^^ "BLD",12501,6) 18^621 "BLD",12501,6.3) 45 "BLD",12501,"ABPKG") n "BLD",12501,"INI") "BLD",12501,"INID") ^^ "BLD",12501,"INIT") "BLD",12501,"KRN",0) ^9.67PA^8993^25 "BLD",12501,"KRN",.4,0) .4 "BLD",12501,"KRN",.401,0) .401 "BLD",12501,"KRN",.402,0) .402 "BLD",12501,"KRN",.403,0) .403 "BLD",12501,"KRN",.5,0) .5 "BLD",12501,"KRN",.84,0) .84 "BLD",12501,"KRN",1.5,0) 1.5 "BLD",12501,"KRN",1.6,0) 1.6 "BLD",12501,"KRN",1.61,0) 1.61 "BLD",12501,"KRN",1.62,0) 1.62 "BLD",12501,"KRN",3.6,0) 3.6 "BLD",12501,"KRN",3.8,0) 3.8 "BLD",12501,"KRN",9.2,0) 9.2 "BLD",12501,"KRN",9.8,0) 9.8 "BLD",12501,"KRN",9.8,"NM",0) ^9.68A^2^1 "BLD",12501,"KRN",9.8,"NM",2,0) SDCCRSEN1^^0^B50667651 "BLD",12501,"KRN",9.8,"NM","B","SDCCRSEN1",2) "BLD",12501,"KRN",19,0) 19 "BLD",12501,"KRN",19.1,0) 19.1 "BLD",12501,"KRN",101,0) 101 "BLD",12501,"KRN",409.61,0) 409.61 "BLD",12501,"KRN",771,0) 771 "BLD",12501,"KRN",779.2,0) 779.2 "BLD",12501,"KRN",870,0) 870 "BLD",12501,"KRN",8989.51,0) 8989.51 "BLD",12501,"KRN",8989.52,0) 8989.52 "BLD",12501,"KRN",8993,0) 8993 "BLD",12501,"KRN",8994,0) 8994 "BLD",12501,"KRN","B",.4,.4) "BLD",12501,"KRN","B",.401,.401) "BLD",12501,"KRN","B",.402,.402) "BLD",12501,"KRN","B",.403,.403) "BLD",12501,"KRN","B",.5,.5) "BLD",12501,"KRN","B",.84,.84) "BLD",12501,"KRN","B",1.5,1.5) "BLD",12501,"KRN","B",1.6,1.6) "BLD",12501,"KRN","B",1.61,1.61) "BLD",12501,"KRN","B",1.62,1.62) "BLD",12501,"KRN","B",3.6,3.6) "BLD",12501,"KRN","B",3.8,3.8) "BLD",12501,"KRN","B",9.2,9.2) "BLD",12501,"KRN","B",9.8,9.8) "BLD",12501,"KRN","B",19,19) "BLD",12501,"KRN","B",19.1,19.1) "BLD",12501,"KRN","B",101,101) "BLD",12501,"KRN","B",409.61,409.61) "BLD",12501,"KRN","B",771,771) "BLD",12501,"KRN","B",779.2,779.2) "BLD",12501,"KRN","B",870,870) "BLD",12501,"KRN","B",8989.51,8989.51) "BLD",12501,"KRN","B",8989.52,8989.52) "BLD",12501,"KRN","B",8993,8993) "BLD",12501,"KRN","B",8994,8994) "BLD",12501,"QUES",0) ^9.62^^ "BLD",12501,"REQB",0) ^9.611^1^1 "BLD",12501,"REQB",1,0) SD*5.3*822^1 "BLD",12501,"REQB","B","SD*5.3*822",1) "MBREQ") 0 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930930 "PKG",16,22,1,"PAH",1,0) 830^3221026^520824644 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","SDCCRSEN1") 0^2^B50667651^B47359591 "RTN","SDCCRSEN1",1,0) SDCCRSEN1 ;CCRA/LB,PB - Appointment retrieval API;APR 4, 2019 "RTN","SDCCRSEN1",2,0) ;;5.3;Scheduling;**822,830**;APR 4, 2019;Build 45 "RTN","SDCCRSEN1",3,0) Q "RTN","SDCCRSEN1",4,0) ; Documented API's and Integration Agreements "RTN","SDCCRSEN1",5,0) ; ---------------------------------------------- "RTN","SDCCRSEN1",6,0) ; Patch 822 Split routine SDCCRSEN due to it's growing size, created this routine and moved the MAKE, CANCEL and "RTN","SDCCRSEN1",7,0) ; NO SHOW code to this routine adds code to insure the consult id is stored in the Hospital Location File, "RTN","SDCCRSEN1",8,0) ; Appointment multiple and when canceling an appointment, only cancel the appointment if it is for a com care "RTN","SDCCRSEN1",9,0) ; clinic that matches the consult service and consult id "RTN","SDCCRSEN1",10,0) ; Patch 830 - fixing an issue from patch 822 where an error is created if the appointment is not made, "RTN","SDCCRSEN1",11,0) ; the code sent the HL7 NAK message back to HSRM, but then continued to process. This resulted in an error "RTN","SDCCRSEN1",12,0) ; in the VistA error trap. "RTN","SDCCRSEN1",13,0) MAKE ;MAKE APPOINTMENT: "S12"="SCHEDULE" "RTN","SDCCRSEN1",14,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",15,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",16,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",17,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,SDECSTART,SDCL,SDECRES) "RTN","SDCCRSEN1",18,0) I SDECAPTID>0 D ANAK^SDCCRCOR("Patient already has an appointment at that datetime.",$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) D "RTN","SDCCRSEN1",19,0) .S ABORT="1^Patient already has an appointment at that datetime.",QUIT=1 "RTN","SDCCRSEN1",20,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) Q "RTN","SDCCRSEN1",21,0) Q:$G(QUIT)=1 "RTN","SDCCRSEN1",22,0) ;S:$G(SDECSTART)["@" SDECSTART=$P(SDECSTART,".",1)_"."_$E($P(SDECSTART,".",2),1,4) "RTN","SDCCRSEN1",23,0) ;S SDECSTART=$$FMTE^XLFDT(SDECSTART,2) "RTN","SDCCRSEN1",24,0) S SDECNOTE="HSRM, CONSULT "_$G(CONID)_" PID="_$G(CID)_" PER CONSULT, PROVIDER "_$G(PROV) "RTN","SDCCRSEN1",25,0) D:QUIT=0 APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,SDDFN,SDECRES,SDECLEN,$G(SDECNOTE),,,,,,,,,SDAPTYP,,,SDCL,,,,,1,,"") ;ADD NEW APPOINTMENT "RTN","SDCCRSEN1",26,0) ;735 - PB Check to see if the appointment was made. "RTN","SDCCRSEN1",27,0) ;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 "RTN","SDCCRSEN1",28,0) ;Cancel remarks in SC $P($P(^SC(DA(1),"S",DA,1,2,0),"^",4)," ",3),^SC(DA(1),"S",DA,"CONS") "RTN","SDCCRSEN1",29,0) ;Cancel remarks in in DPT $P(^DPT(DA(1),"S",DA,"R")," ",3) "RTN","SDCCRSEN1",30,0) I +$G(^TMP("SDEC07",$J,2))>0 Q "RTN","SDCCRSEN1",31,0) I $P($G(^TMP("SDEC07",$J,3)),"^",2)'="" S ABORT="1^"_$P($G(^TMP("SDEC07",$J,3)),"^",2) D "RTN","SDCCRSEN1",32,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",33,0) .D:$P($G(^TMP("SDEC07",$J,3)),"^",2)'["PENDING or ACTIVE" ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN1",34,0) .;patch 830 - PB added setting QUIT=1 and then a quit command to make sure the code stops if the appointment was not made. "RTN","SDCCRSEN1",35,0) .S QUIT=1 "RTN","SDCCRSEN1",36,0) Q:QUIT=1 "RTN","SDCCRSEN1",37,0) N XCLINIC S XCLINIC=+$G(^DPT($G(DFN),"S",FMDTTM,0),"^") I $G(XCLINIC)>0 D "RTN","SDCCRSEN1",38,0) .;Get the correct appointment from the appointment multiple in file 44 by matching .01 with the patient DFN, "RTN","SDCCRSEN1",39,0) .S XCLINIC=+$P(^DPT(DFN,"S",FMDTTM,0),"^") "RTN","SDCCRSEN1",40,0) .I $G(XCLINIC)>0 D "RTN","SDCCRSEN1",41,0) ..N DA,FDA,I1 "RTN","SDCCRSEN1",42,0) ..S I1=0 F S I1=$O(^SD(XCLINIC,"S",FMDTTM,1,I1)) Q:I1'>0 I +$G(^SC(XCLINIC,"S",FMDTTM,1,I1,0))=DFN S DA=I1 "RTN","SDCCRSEN1",43,0) ..I +$G(^SD(XCLINIC,"S",FMDTTM,1,DA,"CONS"))="" S FDA(44.003,DA_","_FMDTTM_","_XCLINIC_",",688)=CONID "RTN","SDCCRSEN1",44,0) Q "RTN","SDCCRSEN1",45,0) CANCEL ;CANCEL APPOINTMENT: "S15"="CANCEL" "RTN","SDCCRSEN1",46,0) ; 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 "RTN","SDCCRSEN1",47,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",48,0) S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",49,0) ; patch 822 - PB check to see if the appointment exists "RTN","SDCCRSEN1",50,0) I '$D(^DPT(DFN,"S",$G(BASEDT))) D "RTN","SDCCRSEN1",51,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",52,0) .S QUIT=1 "RTN","SDCCRSEN1",53,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",54,0) I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",55,0) I $G(SDCL2)>0 D "RTN","SDCCRSEN1",56,0) .I $G(SDCL2)'=SDCL D "RTN","SDCCRSEN1",57,0) ..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",58,0) ..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",59,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",60,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",61,0) ;822 - PB when canceling the appointment check the CONS node for the appointment in file 44 appointment multiple "RTN","SDCCRSEN1",62,0) ;if it matches, cancel, if it doesn't or is null, check to be sure the clinic matches to the consult service "RTN","SDCCRSEN1",63,0) I $G(SDCL2)'>0 D "RTN","SDCCRSEN1",64,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",65,0) .S QUIT=1 "RTN","SDCCRSEN1",66,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",67,0) S SDECAPTID=$$CANCHECK(DFN,$G(SDCL2),$G(BASEDT),$G(CONID)) "RTN","SDCCRSEN1",68,0) I $G(SDECAPTID)=1 D "RTN","SDCCRSEN1",69,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",70,0) .S QUIT=1 "RTN","SDCCRSEN1",71,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",72,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",73,0) I $G(SDECAPTID)'>0 D "RTN","SDCCRSEN1",74,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",75,0) .S QUIT=1 "RTN","SDCCRSEN1",76,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",77,0) S:$G(MSGARY("CANCEL CODE"))="" MSGARY("CANCEL CODE")="C" "RTN","SDCCRSEN1",78,0) S:$G(MSGARY("CANCEL REASON"))="" MSGARY("CANCEL REASON")=11 "RTN","SDCCRSEN1",79,0) 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 "RTN","SDCCRSEN1",80,0) ;735 - PB Check to see if the appointment was canceled. "RTN","SDCCRSEN1",81,0) I $G(^TMP("SDEC08",$J,"APPDEL",2))=$C(30) Q "RTN","SDCCRSEN1",82,0) I $G(^TMP("SDEC08",$J,"APPDEL",2))'="" S ABORT="1^"_$G(^TMP("SDEC08",$J,"APPDEL",2)) D "RTN","SDCCRSEN1",83,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",84,0) .D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN1",85,0) Q "RTN","SDCCRSEN1",86,0) NOSHOW ;NOSHOW APPOINTMENT: "S26"="NOSHOW" "RTN","SDCCRSEN1",87,0) ;S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",88,0) ;S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",89,0) ;S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",90,0) ;check if appointment exists "RTN","SDCCRSEN1",91,0) ; 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 "RTN","SDCCRSEN1",92,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",93,0) S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",94,0) ; patch 822 - PB check to see if the appointment exists "RTN","SDCCRSEN1",95,0) I '$D(^DPT(DFN,"S",$G(BASEDT))) D "RTN","SDCCRSEN1",96,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",97,0) .S QUIT=1 "RTN","SDCCRSEN1",98,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",99,0) I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",100,0) I $G(SDCL2)'>0 D "RTN","SDCCRSEN1",101,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",102,0) .S QUIT=1 "RTN","SDCCRSEN1",103,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",104,0) I $G(SDCL2)>0 D "RTN","SDCCRSEN1",105,0) .I $G(SDCL2)'=SDCL D "RTN","SDCCRSEN1",106,0) ..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",107,0) ..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",108,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",109,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",110,0) ;822 - PB when marking the appointment as NO SHOW check the CONS node for the appointment in file 44 appointment multiple "RTN","SDCCRSEN1",111,0) ;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 "RTN","SDCCRSEN1",112,0) S SDECAPTID=$$CANCHECK(DFN,SDCL2,BASEDT,CONID) "RTN","SDCCRSEN1",113,0) I $G(SDECAPTID)=1 D "RTN","SDCCRSEN1",114,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",115,0) .S QUIT=1 "RTN","SDCCRSEN1",116,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT),ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) Q "RTN","SDCCRSEN1",117,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",118,0) ;Retrieve SDECAPTID pointer to SDEC APPOINTMENT file "RTN","SDCCRSEN1",119,0) ;S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",120,0) ;S SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",121,0) I $G(SDECAPTID)'>0 D "RTN","SDCCRSEN1",122,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",123,0) .S QUIT=1 "RTN","SDCCRSEN1",124,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,ABORT) Q "RTN","SDCCRSEN1",125,0) ; 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 "RTN","SDCCRSEN1",126,0) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",127,0) I SDCL2'=SDCL D "RTN","SDCCRSEN1",128,0) .S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",129,0) .N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",130,0) D:QUIT=0 NOSHOW^SDEC31(.SDECY,SDECAPTID,1,$G(MSGARY("USER")),$G(SDECDATE)) "RTN","SDCCRSEN1",131,0) ;735 - PB Check to see if the appointment was made. "RTN","SDCCRSEN1",132,0) I +$G(^TMP("SDEC",$J,2))>0 Q "RTN","SDCCRSEN1",133,0) I +$G(^TMP("SDEC",$J,2))=0 S ABORT="1^"_$P($G(^TMP("SDEC",$J,2)),"^",2) D "RTN","SDCCRSEN1",134,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",135,0) .D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN1",136,0) Q "RTN","SDCCRSEN1",137,0) CANCHECK(DFN,CLINIC,APPTTM,CONID,APPTID) ; "RTN","SDCCRSEN1",138,0) ;Returns APT ID if the appt is ready to be canceled, 1 if the appt should not be canceled "RTN","SDCCRSEN1",139,0) N GOOD,APTID "RTN","SDCCRSEN1",140,0) S GOOD=0 "RTN","SDCCRSEN1",141,0) 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 "RTN","SDCCRSEN1",142,0) .;W !,$G(^SC(CLINIC,"S",APPTTM,1,XX,0)) "RTN","SDCCRSEN1",143,0) .I +$P($G(^SC(CLINIC,"S",APPTTM,1,XX,"CONS")),"^")'=CONID S GOOD=1 W !,XX," ",$G(GOOD) "RTN","SDCCRSEN1",144,0) .I $P($G(^SC(CLINIC,0)),"^")'["COM CARE" S GOOD=1 "RTN","SDCCRSEN1",145,0) I $G(GOOD)=1 Q GOOD "RTN","SDCCRSEN1",146,0) S APTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",147,0) K XX "RTN","SDCCRSEN1",148,0) Q APTID "VER") 8.0^22.2 "BLD",12501,6) ^685 **END** **END**