EMERGENCY Released SD*5.3*822 SEQ #676 Extracted from mail message **KIDS**:SD*5.3*822^ **INSTALL NAME** SD*5.3*822 "BLD",12400,0) SD*5.3*822^SCHEDULING^0^3220728^y "BLD",12400,4,0) ^9.64PA^^ "BLD",12400,6) 17^621 "BLD",12400,6.3) 44 "BLD",12400,"ABPKG") n "BLD",12400,"INI") "BLD",12400,"INID") ^^ "BLD",12400,"INIT") "BLD",12400,"KRN",0) ^9.67PA^8993^25 "BLD",12400,"KRN",.4,0) .4 "BLD",12400,"KRN",.401,0) .401 "BLD",12400,"KRN",.402,0) .402 "BLD",12400,"KRN",.403,0) .403 "BLD",12400,"KRN",.5,0) .5 "BLD",12400,"KRN",.84,0) .84 "BLD",12400,"KRN",1.5,0) 1.5 "BLD",12400,"KRN",1.6,0) 1.6 "BLD",12400,"KRN",1.61,0) 1.61 "BLD",12400,"KRN",1.62,0) 1.62 "BLD",12400,"KRN",3.6,0) 3.6 "BLD",12400,"KRN",3.8,0) 3.8 "BLD",12400,"KRN",9.2,0) 9.2 "BLD",12400,"KRN",9.8,0) 9.8 "BLD",12400,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12400,"KRN",9.8,"NM",1,0) SDCCRSEN^^0^B121323053 "BLD",12400,"KRN",9.8,"NM",2,0) SDCCRSEN1^^0^B47359591 "BLD",12400,"KRN",9.8,"NM","B","SDCCRSEN",1) "BLD",12400,"KRN",9.8,"NM","B","SDCCRSEN1",2) "BLD",12400,"KRN",19,0) 19 "BLD",12400,"KRN",19.1,0) 19.1 "BLD",12400,"KRN",101,0) 101 "BLD",12400,"KRN",409.61,0) 409.61 "BLD",12400,"KRN",771,0) 771 "BLD",12400,"KRN",779.2,0) 779.2 "BLD",12400,"KRN",870,0) 870 "BLD",12400,"KRN",8989.51,0) 8989.51 "BLD",12400,"KRN",8989.52,0) 8989.52 "BLD",12400,"KRN",8993,0) 8993 "BLD",12400,"KRN",8994,0) 8994 "BLD",12400,"KRN","B",.4,.4) "BLD",12400,"KRN","B",.401,.401) "BLD",12400,"KRN","B",.402,.402) "BLD",12400,"KRN","B",.403,.403) "BLD",12400,"KRN","B",.5,.5) "BLD",12400,"KRN","B",.84,.84) "BLD",12400,"KRN","B",1.5,1.5) "BLD",12400,"KRN","B",1.6,1.6) "BLD",12400,"KRN","B",1.61,1.61) "BLD",12400,"KRN","B",1.62,1.62) "BLD",12400,"KRN","B",3.6,3.6) "BLD",12400,"KRN","B",3.8,3.8) "BLD",12400,"KRN","B",9.2,9.2) "BLD",12400,"KRN","B",9.8,9.8) "BLD",12400,"KRN","B",19,19) "BLD",12400,"KRN","B",19.1,19.1) "BLD",12400,"KRN","B",101,101) "BLD",12400,"KRN","B",409.61,409.61) "BLD",12400,"KRN","B",771,771) "BLD",12400,"KRN","B",779.2,779.2) "BLD",12400,"KRN","B",870,870) "BLD",12400,"KRN","B",8989.51,8989.51) "BLD",12400,"KRN","B",8989.52,8989.52) "BLD",12400,"KRN","B",8993,8993) "BLD",12400,"KRN","B",8994,8994) "BLD",12400,"QUES",0) ^9.62^^ "BLD",12400,"REQB",0) ^9.611^1^1 "BLD",12400,"REQB",1,0) SD*5.3*808^1 "BLD",12400,"REQB","B","SD*5.3*808",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) 822^3220728^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") 2 "RTN","SDCCRSEN") 0^1^B121323053^B189021302 "RTN","SDCCRSEN",1,0) SDCCRSEN ;CCRA/LB,PB - Appointment retrieval API;APR 4, 2019 "RTN","SDCCRSEN",2,0) ;;5.3;Scheduling;**707,730,735,764,768,741,795,808,822**;APR 4, 2019;Build 44 "RTN","SDCCRSEN",3,0) Q "RTN","SDCCRSEN",4,0) ; Documented API's and Integration Agreements "RTN","SDCCRSEN",5,0) ; ---------------------------------------------- "RTN","SDCCRSEN",6,0) ; Reference to GENACK^HLMA1 in ICR #2165 "RTN","SDCCRSEN",7,0) ; Reference to $$GETDFN^MPIF001,$$GETICN^MPIF001 in ICR #2701 "RTN","SDCCRSEN",8,0) ; Reference to MAKEADD^TIUSRVP2 in ICR #3535 "RTN","SDCCRSEN",9,0) ; Reference to $$HL7TFM^XLFDT in ICR #10103 "RTN","SDCCRSEN",10,0) ; Reference to $$PATCH^XPDUTL in ICR #10141 "RTN","SDCCRSEN",11,0) ; Patch 764 changed the SDECEND and SDECSTART times to send them in external format "RTN","SDCCRSEN",12,0) ; Patch 741 stopped sending a NAK for inactive clinic status and VistA messages for a successful appointment "RTN","SDCCRSEN",13,0) ; Patch 795 added code to lookup up COM CARE-OTEHR-DIVISIONID clinics and to check for the clinic to be non-count "RTN","SDCCRSEN",14,0) ; Patch 808 adds code to use the Related Hospital Location file in the Request Services File (#123.5) to lookup of the clinic for the appointment "RTN","SDCCRSEN",15,0) ; Patch 822 adds code to insure the consult id is stored in the Hospital Location File, Appointment multiple "RTN","SDCCRSEN",16,0) ; and when canceling an appointment, only cancel the appointment if it is for a com care clinic that matches the "RTN","SDCCRSEN",17,0) ; consult service and consult id. Patch 822 also split this routine and move the MAKE, CANCEL and NO SHOW code to SDCCRSEN1 "RTN","SDCCRSEN",18,0) EN() ;Primary entry routine for HL7 based CCRA scheduling processing. "RTN","SDCCRSEN",19,0) ;Will take all scheduling messages through this one point. "RTN","SDCCRSEN",20,0) N FS,CS,RS,ES,SS,MID,HLQUIT,HLNODE,USER,USERMAIL,NAKMSG,ICN,MSH,FMDTTM "RTN","SDCCRSEN",21,0) N MSG,HDR,SEG,SEGTYPE,MSGARY,LASTSEG,HDRTIME,ABORT,BASEDT,CLINARY,COUNT,PROVDTL,RESULTS,P694 "RTN","SDCCRSEN",22,0) D INT^SDCCRCOR "RTN","SDCCRSEN",23,0) D COPYMSG^SDCCRCOR(.MSG) "RTN","SDCCRSEN",24,0) Q:$$CHKMSG^SDCCRCOR(.MSG) "RTN","SDCCRSEN",25,0) Q:$$PROCMSG(.MSG) "RTN","SDCCRSEN",26,0) D:+$G(ABORT)'>0 ACK^SDCCRCOR("CA",MID) ;PB - Patch 764 "RTN","SDCCRSEN",27,0) Q "RTN","SDCCRSEN",28,0) PROCMSG(MSG1) ; Process message "RTN","SDCCRSEN",29,0) N QUIT,I,SEGTYPE,ERR1 "RTN","SDCCRSEN",30,0) N GMRCDFN,GMRCTIU,GMRCTIUS,CID,ADDTXT,GMRCATIU,STID,RAWSEG,APTTM,DFN,CONID,CONTITLE,PROVIDER,SRVNAME1,SRVNAMEX,LOC,PROV,SDECRESA,DIVID "RTN","SDCCRSEN",31,0) K SDECSTART,SDECEND,SDDFN,SITECODE,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL "RTN","SDCCRSEN",32,0) S (SDECSTART,SDECEND,SDDFN,SDECRES,SDECLEN,CID,PROV,LOC,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL)="" "RTN","SDCCRSEN",33,0) S ABORT=0,BASEDT="" "RTN","SDCCRSEN",34,0) S (QUIT,XX)=0 "RTN","SDCCRSEN",35,0) F S XX=$O(MSG1(XX)) Q:XX'>0 D "RTN","SDCCRSEN",36,0) . S SEGTYPE=$E(MSG1(XX),1,3),RAWSEG=$G(MSG1(XX)) "RTN","SDCCRSEN",37,0) . I SEGTYPE'="NTE" S LASTSEG=SEGTYPE "RTN","SDCCRSEN",38,0) . S SEG=$G(MSG1(XX)) "RTN","SDCCRSEN",39,0) . I SEGTYPE="MSH" D MSH(SEG,.MSGARY) "RTN","SDCCRSEN",40,0) . I SEGTYPE="SCH" D SCH(SEG,.MSGARY,.ABORT,.BASEDT) ;SCH MUST BE PROCESSED FIRST SOME VALIDATION DEPENDS ON APPOINTMENT STATUS IN SCH-25 "RTN","SDCCRSEN",41,0) . I SEGTYPE="NTE" D NTE(SEG,.MSGARY,LASTSEG,.CLINARY,.ABORT,.PROVDTL) "RTN","SDCCRSEN",42,0) . I SEGTYPE="PID" D PID(SEG,.MSGARY,.ABORT) "RTN","SDCCRSEN",43,0) . I SEGTYPE="PV1" D PV1(SEG,.MSGARY,HDRTIME,.ABORT) "RTN","SDCCRSEN",44,0) . I SEGTYPE="RGS" D RGS(SEG,.MSGARY) "RTN","SDCCRSEN",45,0) . I SEGTYPE="AIS" D AIS(SEG,.MSGARY) "RTN","SDCCRSEN",46,0) . I SEGTYPE="AIG" D AIG(SEG,.MSGARY,.PROVDTL,BASEDT) "RTN","SDCCRSEN",47,0) . I SEGTYPE="AIP" D AIP(SEG,.MSGARY,.PROVDTL,BASEDT) "RTN","SDCCRSEN",48,0) K XX "RTN","SDCCRSEN",49,0) I $G(NAKMSG)'="" S DUZ=.5,QUIT=1 D ANAK^SDCCRCOR($G(NAKMSG),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN",50,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,.ABORT) Q 1 "RTN","SDCCRSEN",51,0) I +$G(ABORT)=2 D APPMSG^SDCCRCOR(MID,.ABORT) Q 1 "RTN","SDCCRSEN",52,0) ;Q:$G(QUIT)=1 QUIT "RTN","SDCCRSEN",53,0) S QUIT=0 "RTN","SDCCRSEN",54,0) I MSGARY("EVENT")="SCHEDULE" D MAKE^SDCCRSEN1 "RTN","SDCCRSEN",55,0) I MSGARY("EVENT")="CANCEL" D CANCEL^SDCCRSEN1 "RTN","SDCCRSEN",56,0) I MSGARY("EVENT")="NOSHOW" D NOSHOW^SDCCRSEN1 "RTN","SDCCRSEN",57,0) D DONEINC^SDCCRCOR "RTN","SDCCRSEN",58,0) K MSG1,SDRES,SDECY,SDECDATE,SDECAPTID,RSNAME,SDAPTYP,SDCL,SDDFN,SDECNOT,SDECNOTE,INP,RET "RTN","SDCCRSEN",59,0) Q QUIT "RTN","SDCCRSEN",60,0) SETEVENT(EVENT,MSGARY) ;Takes the scheduling event and sets a message event to process. "RTN","SDCCRSEN",61,0) ;EVENT (I/REQ) - Message event from the MSH header. EX. S12, S14, S15, S26 "RTN","SDCCRSEN",62,0) ;MSGARY (I/O,REQ) message array structure with reformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",63,0) I $G(EVENT)="" Q 0 "RTN","SDCCRSEN",64,0) I EVENT="S12" S MSGARY("EVENT")="SCHEDULE" Q 1 "RTN","SDCCRSEN",65,0) I EVENT="S15" S MSGARY("EVENT")="CANCEL" Q 1 "RTN","SDCCRSEN",66,0) I EVENT="S26" S MSGARY("EVENT")="NOSHOW" Q 1 "RTN","SDCCRSEN",67,0) Q 0 "RTN","SDCCRSEN",68,0) MSH(MSH,MSGARY) ; RGS segment "RTN","SDCCRSEN",69,0) D PARSESEG^SDCCRSCU(MSH,.MSH) "RTN","SDCCRSEN",70,0) S SITECODE=$G(MSH(5,1,1)) "RTN","SDCCRSEN",71,0) Q "RTN","SDCCRSEN",72,0) SCH(SCH,MSGARY,ABORT,BASEDT) ;SCH segment processing.: "RTN","SDCCRSEN",73,0) ;SEG (I/REQ) - SCH message segment data "RTN","SDCCRSEN",74,0) ;MSGARY (I/O,REQ) message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",75,0) ;ABORT (O,OPT) - Error parameter if we did not receive an appointment date and time. Fatal case to this message. "RTN","SDCCRSEN",76,0) ;BASEDT (O,REQ) - appointment base date/time to use. May be incremented later if processing multiple joint clinic scheduling "RTN","SDCCRSEN",77,0) N ORDIDTYP,SRVNAME,CONSULTID "RTN","SDCCRSEN",78,0) D PARSESEG^SDCCRSCU(SCH,.SCH) "RTN","SDCCRSEN",79,0) S MSGARY("PLACER ID")=$G(SCH(1)) ;SCH-1.1 "RTN","SDCCRSEN",80,0) ;Cancel Reason "RTN","SDCCRSEN",81,0) S CONID=$G(SCH(2)),PROVIDER=$G(SCH(12,1,2))_" "_$G(SCH(12,1,3)) "RTN","SDCCRSEN",82,0) I MSGARY("EVENT")="CANCEL" S MSGARY("CANCEL REASON")=$$GETRSN^SDCCRCOR($G(SCH(6,1,2))),MSGARY("CANCEL CODE")=$G(SCH(6,1,5)) ;SCH-6 "RTN","SDCCRSEN",83,0) I $G(MSGARY("CANCEL REASON"))'="" N CANRSN S CANRSN=$O(^SD(409.2,"B",$G(MSGARY("CANCEL REASON")),"")) I CANRSN="" S MSGARY("CANCEL REASON")=11 "RTN","SDCCRSEN",84,0) ;Duration "RTN","SDCCRSEN",85,0) S (SDECLEN,MSGARY("DURATION"))=$G(SCH(9)) ;SCH-9,10 "RTN","SDCCRSEN",86,0) ;Appointment Date "RTN","SDCCRSEN",87,0) S P694=0 S P694=$$PATCH^XPDUTL("SD*5.3*694") "RTN","SDCCRSEN",88,0) S APTTM=$G(SCH(11,1,4)) I $G(APTTM)'="" S SDECSTART=$$TIMES^SDCCRCOR($G(SCH(11,1,4)),SITECODE),SDECEND=$$TIMES^SDCCRCOR($G(SCH(11,1,5)),SITECODE) "RTN","SDCCRSEN",89,0) I $G(SCH(11,1,4))="" S ERR1="NO APPOINTMENT DATE AND TIME",ABORT="1^"_ERR1 Q "RTN","SDCCRSEN",90,0) ;User "RTN","SDCCRSEN",91,0) S (MSGARY("USER"))=$$GETUSER^SDCCRCOR($G(SCH(20,1,1))) ;SCH-20 "RTN","SDCCRSEN",92,0) S USERMAIL=$$LOW^XLFSTR($G(SCH(13,1,4))) S:$G(USERMAIL)'="" DUZ=$O(^VA(200,"ADUPN",$G(USERMAIL),"")) "RTN","SDCCRSEN",93,0) S:$G(DUZ)'>0 DUZ=$O(^VA(200,"ADUPN",$E(USERMAIL,1,30),"")) ;29 JAN 2020 - PB - Change for patch 735 to look emails longer than 30 characters "RTN","SDCCRSEN",94,0) I $G(DUZ)'>0 S:$G(USERMAIL)'="" DUZ=$O(^VA(200,"ADUPN",$$UP^XLFSTR(USERMAIL),"")) "RTN","SDCCRSEN",95,0) I DUZ'>0 S DUZ=.5,(NAKMSG,ERR1)="SCHEDULER DOESN'T HAVE AN ACCOUNT ON THIS SYSTEM",ABORT="1^"_ERR1 Q "RTN","SDCCRSEN",96,0) S MSGARY("STATUS")=$$GETSTAT($G(SCH(25))) ;SCH-25 "RTN","SDCCRSEN",97,0) ; Linked Consults/Orders "RTN","SDCCRSEN",98,0) S ORDIDTYP=$$GET^SDCCRSCU(.SCH,27,2) ;Placer ID Type "RTN","SDCCRSEN",99,0) Q "RTN","SDCCRSEN",100,0) NTE(NTE,MSGARY,LASTSEG,CLINARY,ABORT,PROVDTL) ;NTE segment processing. "RTN","SDCCRSEN",101,0) ;NTE (I/REQ) - NTE message segment data "RTN","SDCCRSEN",102,0) ;MSGARY (I/O,REQ) - message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",103,0) ;LASTSEG (I,REQ) - segment previous to the NTE to determine context of note. "RTN","SDCCRSEN",104,0) ;CLINARY (I/O,REQ) - List of Clinics to be scheduled. Could contain more than one for joint appointments "RTN","SDCCRSEN",105,0) ;ABORT (O,REQ) - quit parameter to the whole tag. Having one clinic unmapped must stop filing. "RTN","SDCCRSEN",106,0) ;PROVDTL (I/OPT) - passed when NTE concerns a preceding AIP or AIG segment "RTN","SDCCRSEN",107,0) N NOTE,NOTETYPE,CLINIC "RTN","SDCCRSEN",108,0) S LASTSEG=$G(LASTSEG) "RTN","SDCCRSEN",109,0) D PARSESEG^SDCCRSCU(NTE,.NTE) "RTN","SDCCRSEN",110,0) S NOTE="HSRM CONSULT "_$G(CONID)_" "_$G(NTE(3)) ;NTE-3.1 "RTN","SDCCRSEN",111,0) S NOTETYPE=$$GET^SDCCRSCU(.NTE,4,1) ;NTE-4.1 "RTN","SDCCRSEN",112,0) ;Process NTE following SCH for scheduling comments. "RTN","SDCCRSEN",113,0) S (SDECNOTE,NOTE)=$TR(NOTE,"^","?") ;JAN 21, 2020 - PB - adding SDECNOTE to have the booking notes "RTN","SDCCRSEN",114,0) I LASTSEG="SCH" D "RTN","SDCCRSEN",115,0) . I ($G(MSGARY("COMMENT"))'=""),(NOTE'="") S MSGARY("COMMENT")=$G(MSGARY("COMMENT"))_" " "RTN","SDCCRSEN",116,0) . S MSGARY("COMMENT")=NOTE "RTN","SDCCRSEN",117,0) Q "RTN","SDCCRSEN",118,0) PID(PID,MSGARY,ABORT) ;PID segment "RTN","SDCCRSEN",119,0) ;PID (I/REQ) - PID message segment "RTN","SDCCRSEN",120,0) ;MSGARY (I/O,REQ) message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",121,0) ;ABORT (O,OPT) - Error parameter if we failed to find a valid patient. Fatal case to this message. "RTN","SDCCRSEN",122,0) N IDENTIFIERS,IENCHECK,OK "RTN","SDCCRSEN",123,0) D PARSESEG^SDCCRSCU(PID,.PID) "RTN","SDCCRSEN",124,0) S ICN=$G(PID(3,1,1)),(SDDFN,DFN)=$$GETDFN^MPIF001($P(ICN,"V")) "RTN","SDCCRSEN",125,0) Q "RTN","SDCCRSEN",126,0) PV1(PV1,MSGARY,HDRTIME,ABORT) ;PV1 segment "RTN","SDCCRSEN",127,0) ;PV1 (I/REQ) - PV1 message segment data "RTN","SDCCRSEN",128,0) ;MSGARY (I/O,REQ) message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",129,0) ;HDRTIME (I,OPT) - TIME FROM MSH-7, USED AS A DEFAULTING OPTION "RTN","SDCCRSEN",130,0) ;ABORT (O,OPT) - Error parameter if we failed to find a valid patient. Fatal case to this message. "RTN","SDCCRSEN",131,0) N ERROR "RTN","SDCCRSEN",132,0) D PARSESEG^SDCCRSCU(PV1,.PV1) "RTN","SDCCRSEN",133,0) I $G(PV1(19))'>0 S (NAKMSG,ERR1)="CONSULT ID MISSING. " S ABORT="1^"_ERR1 Q "RTN","SDCCRSEN",134,0) S CONSULTID=0,(CONID,CONSULTID)=$G(PV1(19)) "RTN","SDCCRSEN",135,0) S MSGARY("FILLER ID")=CONSULTID "RTN","SDCCRSEN",136,0) S SDAPTYP="C|"_$G(CONSULTID) "RTN","SDCCRSEN",137,0) N Y,RESNAME "RTN","SDCCRSEN",138,0) S DIVID=$G(PV1(3,1,4)) "RTN","SDCCRSEN",139,0) S CID=$$GET1^DIQ(123,$G(CONSULTID)_",",17,"E") S:$G(CID)'="" CID=$P($$FMTE^XLFDT(CID,1),"@",1) "RTN","SDCCRSEN",140,0) S SDECRESA=$$GET1^DIQ(123,$G(CONSULTID)_",",1,"I"),(CONTITLE,SRVNAME)=$$GET1^DIQ(123,$G(CONSULTID)_",",1,"E") "RTN","SDCCRSEN",141,0) I $G(SRVNAME)'["COMMUNITY CARE" S (NAKMSG,ERR1)="Not a Community Care Consult",ABORT="2^"_ERR1 Q "RTN","SDCCRSEN",142,0) ; patch 808 - PB lookup the clinic in the Related Hospital Location multiple in the Request Services file (#123.5), gets the last clinic in the list "RTN","SDCCRSEN",143,0) I $G(^GMR(123.5,SDECRESA,123.4,0))'="" D "RTN","SDCCRSEN",144,0) .N T1,T2,T3 "RTN","SDCCRSEN",145,0) .S (T1,T2)=0 F S T1=$O(^GMR(123.5,SDECRESA,123.4,T1)) Q:T1'>0 S T2=$P($G(^GMR(123.5,SDECRESA,123.4,T1,0)),"^") "RTN","SDCCRSEN",146,0) .S:$$GET1^DIQ(44,T2_",",.01,"E")["COM CARE-" SDCL=T2,SRVNAMEX=$$GET1^DIQ(44,T2_",",.01,"E") "RTN","SDCCRSEN",147,0) I $G(SDCL)'>0 S SDCL=$$CHECKLST($G(SRVNAME)) "RTN","SDCCRSEN",148,0) I $G(SDCL)=0 S QUIT=1 Q 0 "RTN","SDCCRSEN",149,0) I SDCL>0&($$GET1^DIQ(44,$G(SDCL)_",",2502,"E")'="YES") S (NAKMSG,ERROR)=SRVNAME_" NOT A NON COUNT CLINIC FOR CONSULT ID: "_CONSULTID,ERR1=ERROR,ABORT="2^"_ERR1 Q "RTN","SDCCRSEN",150,0) I $G(SDCL)'>0 S (NAKMSG,ERROR)=" NO MATCH FOR "_SRVNAMEX_" PV1-19 CONSULT ID:"_CONSULTID,ERR1=ERROR,ABORT="2^"_ERR1 Q ;WE NEED AN ERR HERE FOR PV1(19) "RTN","SDCCRSEN",151,0) N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN",152,0) I $G(SDECRES)="" S (NAKMSG,ERROR)=" NO CLINIC RESOURCE MATCH FOR "_SRVNAMEX,ERR1=ERROR,ABORT="1^"_ERR1 Q "RTN","SDCCRSEN",153,0) ;Need to check to see if the clinic is inactive - is there an SDEC API for this? "RTN","SDCCRSEN",154,0) S MSGARY("CHECKINDT")=$$DETTIME($$GET^SDCCRSCU(.PV1,44,1),$G(HDRTIME),.ERROR) ;PV1-44.1 "RTN","SDCCRSEN",155,0) I ($G(ERROR)'=""),($G(MSGARY("STATUS"))="CHECKED IN") S NAKMSG=" NO CHECK IN TIME IN PV1-44 ",ABORT="1^ NO CHECK IN TIME IN PV1-44 "_ERROR Q "RTN","SDCCRSEN",156,0) ;CHECK OUT DATE/TIME "RTN","SDCCRSEN",157,0) S MSGARY("CHECKOUTDT")=$$DETTIME($$GET^SDCCRSCU(.PV1,45,1),$G(HDRTIME),.ERROR) ;PV1-45.1 "RTN","SDCCRSEN",158,0) I ($G(ERROR)'=""),($G(MSGARY("STATUS"))="CHECKED OUT") S NAKMSG=" NO CHECK IN TIME IN PV1-45 ",ABORT="1^ NO CHECK IN TIME IN PV1-44 "_ERROR Q "RTN","SDCCRSEN",159,0) Q "RTN","SDCCRSEN",160,0) RGS(RGS,MSGARY) ; RGS segment "RTN","SDCCRSEN",161,0) Q "RTN","SDCCRSEN",162,0) AIS(AIS,MSGARY) ;AIS segment "RTN","SDCCRSEN",163,0) Q "RTN","SDCCRSEN",164,0) AIP(AIP,MSGARY,PROVDTL,BASEDTE) ;AIP segment processing. "RTN","SDCCRSEN",165,0) ;Per HL7 this field can repeat within each RGS group. "RTN","SDCCRSEN",166,0) ;AIP (I/REQ) - AIP message segment data "RTN","SDCCRSEN",167,0) ;MSGARY (I/O,REQ) message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",168,0) ;PROVDTL (O,REQ) - AIP date/time and length "RTN","SDCCRSEN",169,0) ;BASEDTE (I,REQ) - Appt D/T from SCH "RTN","SDCCRSEN",170,0) D PARSESEG^SDCCRSCU(AIP,.AIP) "RTN","SDCCRSEN",171,0) S PROV=$G(AIP(3,1,2))_" "_$G(AIP(3,1,3)) "RTN","SDCCRSEN",172,0) Q "RTN","SDCCRSEN",173,0) ; "RTN","SDCCRSEN",174,0) AIG(AIG,MSGARY,PROVDTL,BASEDTE) ;AIG segment processing. "RTN","SDCCRSEN",175,0) ;Per HL7 this field can repeat within each RGS group. "RTN","SDCCRSEN",176,0) ;AIG (I/REQ) - AIG message segment data "RTN","SDCCRSEN",177,0) ;MSGARY (I/O,REQ) message array structure with unformatted and translated data ready for filing. See PARSEMSG for details. "RTN","SDCCRSEN",178,0) ;PROVDTL (O,REQ) - AIG date/time and length "RTN","SDCCRSEN",179,0) ;BASEDTE (I,REQ) - Appt D/T from SCH "RTN","SDCCRSEN",180,0) D PARSESEG^SDCCRSCU(AIG,.AIG) "RTN","SDCCRSEN",181,0) I $$HL7TFM^XLFDT($$GET^SDCCRSCU(.AIG,8,1),"L")'="" S PROVDTL("DT")=$$HL7TFM^XLFDT($$GET^SDCCRSCU(.AIG,8,1),"L") ;AIG-8 "RTN","SDCCRSEN",182,0) E S PROVDTL("DT")=BASEDTE "RTN","SDCCRSEN",183,0) S PROVDTL("LN")=MSGARY("DURATION") "RTN","SDCCRSEN",184,0) Q "RTN","SDCCRSEN",185,0) ; "RTN","SDCCRSEN",186,0) GETSTAT(SCH) ; Translates status into appropriate scheduling statuses "RTN","SDCCRSEN",187,0) ;Options: (SCHEDULED,CHECKED IN,CHECKED OUT,CANCELLED,NO SHOW) "RTN","SDCCRSEN",188,0) N STATUS,ID,TITLE "RTN","SDCCRSEN",189,0) S ID=$$GET^SDCCRSCU(.SCH,25,1) "RTN","SDCCRSEN",190,0) S TITLE=$$GET^SDCCRSCU(.SCH,25,2) "RTN","SDCCRSEN",191,0) I $$INSTRING^SDCCRCOR(TITLE,"SCHEDULED,CHECKED IN,CHECKED OUT,CANCELLED,NO SHOW") Q TITLE "RTN","SDCCRSEN",192,0) I $$INSTRING^SDCCRCOR(ID,"SCHEDULED,CHECKED IN,CHECKED OUT,CANCELLED,NO SHOW") Q ID "RTN","SDCCRSEN",193,0) I (ID'="")!(TITLE'="") S NAKMSG=" SCHEDULING STATUS MAPPING ERROR",ABORT="1^ SCHEDULING STATUS MAPPING ERROR" Q "RTN","SDCCRSEN",194,0) Q "NA" "RTN","SDCCRSEN",195,0) DETTIME(PV1TIME,HDRTIME,ERROR) ;RETURNS THE BEST CHECK IN/OUT TIME AVAILABLE IN THE MESSAGE OR DEFAULTS TO NOW "RTN","SDCCRSEN",196,0) ;PV1TIME (I,OPT) - HIGHEST PRIORITY TIME TO RETURN FROM EITHER PV1-44 OR PV1-45 "RTN","SDCCRSEN",197,0) ;HDRTIME (I,OPT) - TIME FROM MSH-7 "RTN","SDCCRSEN",198,0) ;ERROR (O,OPT) - ERROR OUTPUT PARAMETER "RTN","SDCCRSEN",199,0) K ERROR "RTN","SDCCRSEN",200,0) I $G(PV1TIME)'="" Q $$HL7TFM^XLFDT(PV1TIME,"L") "RTN","SDCCRSEN",201,0) I $G(HDRTIME)'="" S ERROR="FALLING BACK TO MSH-7" Q $$HL7TFM^XLFDT(HDRTIME,"L") "RTN","SDCCRSEN",202,0) S ERROR="FALLING BACK TO FILING TIME" "RTN","SDCCRSEN",203,0) Q $$NOW^XLFDT() "RTN","SDCCRSEN",204,0) CHECKLST(SRVNAME) ; "RTN","SDCCRSEN",205,0) ; lookup matching clinic for imaging comm care consults "RTN","SDCCRSEN",206,0) I $G(SRVNAME)="" Q 0 "RTN","SDCCRSEN",207,0) N CLINID,CLINIC,CONTITLE,LEN,I,XC "RTN","SDCCRSEN",208,0) S CLINID=0 "RTN","SDCCRSEN",209,0) S:$G(SRVNAME)[" - " SRVNAME=$P(SRVNAME," - ",1)_"-"_$P(SRVNAME," - ",2) "RTN","SDCCRSEN",210,0) S:$G(SRVNAME)[" -" SRVNAME=$P(SRVNAME," -",1)_"-"_$P(SRVNAME," -",2) "RTN","SDCCRSEN",211,0) S:$G(SRVNAME)["- " SRVNAME=$P(SRVNAME,"- ",1)_"-"_$P(SRVNAME,"- ",2) "RTN","SDCCRSEN",212,0) S LEN=$L(SRVNAME),XC=1 "RTN","SDCCRSEN",213,0) F I=0:1:LEN I $E(SRVNAME,I)="-" S XC=XC+1 "RTN","SDCCRSEN",214,0) S CONTITLE=SRVNAME "RTN","SDCCRSEN",215,0) S (RSNAME,SRVNAME)="COM CARE-"_$P(SRVNAME,"-",2,XC),SRVNAME=$E(SRVNAME,1,30) S:$E(SRVNAME,30)=" " SRVNAME=$E(SRVNAME,1,29) "RTN","SDCCRSEN",216,0) S:$E($P(RSNAME,"-",2),1,3)="DOD" (RSNAME,SRVNAME)="CC-"_$P(RSNAME,"-",2,XC) "RTN","SDCCRSEN",217,0) S CLINID=$O(^SC("B",$E($G(SRVNAME),1,30),"")) "RTN","SDCCRSEN",218,0) I $G(CLINID)'>0 D "RTN","SDCCRSEN",219,0) .F I=1:1:20 D "RTN","SDCCRSEN",220,0) ..Q:$G(CLINID)>0 "RTN","SDCCRSEN",221,0) ..I $P($P($T(LIST+I),";;",2),"^",1)=CONTITLE S CLINIC=$P($P($T(LIST+I),";;",2),"^",2),CLINID=$O(^SC("B",$G(CLINIC),"")),SRVNAME=CLINIC "RTN","SDCCRSEN",222,0) I CLINID'>0 D "RTN","SDCCRSEN",223,0) . N LENG,SRVNAME1 "RTN","SDCCRSEN",224,0) . S LENG=0 "RTN","SDCCRSEN",225,0) . S LENG=$L(SRVNAME) "RTN","SDCCRSEN",226,0) . S (SRVNAME,SRVNAME1)=$S(LENG>28:$E(SRVNAME,1,28)_"-X",1:$G(SRVNAME)_"-X"),CLINID=$O(^SC("B",$G(SRVNAME1),"")) "RTN","SDCCRSEN",227,0) S SRVNAMEX=SRVNAME "RTN","SDCCRSEN",228,0) ;Need to check to see if the clinic is inactive - is there an SDEC API for this? "RTN","SDCCRSEN",229,0) N INACT S:$G(CLINID)>0 INACT=$$INACTIVE^SDEC32(CLINID) "RTN","SDCCRSEN",230,0) I $G(INACT)=1 S (NAKMSG,ERR1)="Clinic "_$P(^SC(CLINID,0),"^")_" is inactive",ABORT="1^"_ERR1 Q 0 "RTN","SDCCRSEN",231,0) ;If no matching clinic found look for com care-other-DIVID (DIVID from the PV! segment) "RTN","SDCCRSEN",232,0) I CLINID'>0!$G(INACT)=1 S CLINID=$O(^SC("B","COM CARE-OTHER-"_DIVID,"")) S:$G(CLINID)>0 (SRVNAMEX,SRVNAME)=$P(^SC(CLINID,0),"^") S:$G(CLINID)'>0 (SRVNAMEX,SRVNAME)="COM CARE-OTHER-"_$G(DIVID) "RTN","SDCCRSEN",233,0) I CLINID'>0!$G(INACT)=1 S CLINID=$O(^SC("B","COM CARE-OTHER","")) S:$G(CLINID)>0 (SRVNAMEX,SRVNAME)=$P(^SC(CLINID,0),"^") S:$G(CLINID)'>0 (SRVNAMEX,SRVNAME)="COM CARE-OTHER" "RTN","SDCCRSEN",234,0) Q CLINID "RTN","SDCCRSEN",235,0) LIST ; List of Imaging Community Care consult titles and clinics "RTN","SDCCRSEN",236,0) ;;COMMUNITY CARE-IMAGING CT-AUTO^COM CARE-IMAG CT-AUTO "RTN","SDCCRSEN",237,0) ;;COMMUNITY CARE-IMAGING GENERAL RADIOLOGY-AUTO^COM CARE-IMAG GEN RAD-AUTO "RTN","SDCCRSEN",238,0) ;;COMMUNITY CARE-IMAGING MAGNETIC RESONANCE IMAGING-AUTO^COM CARE-IMAG MRI-AUTO "RTN","SDCCRSEN",239,0) ;;COMMUNITY CARE-IMAGING MAMMOGRAPHY DIAGNOSTIC-AUTO^COM CARE-IMAG MAM DIAG-AUTO "RTN","SDCCRSEN",240,0) ;;COMMUNITY CARE-IMAGING MAMMOGRAPHY SCREEN-AUTO^COM CARE-IMAG MAM SCR-AUTO "RTN","SDCCRSEN",241,0) ;;COMMUNITY CARE-IMAGING NUCLEAR MEDICINE-AUTO^COM CARE-IMAG NUC MEC-AUTO "RTN","SDCCRSEN",242,0) ;;COMMUNITY CARE-IMAGING ULTRASOUND-AUTO^COM CARE-IMAG U/S-AUTO "RTN","SDCCRSEN",243,0) ;;COMMUNITY CARE-CIH BIOFEEDBACK/NEUROFEEDBACK^COM CARE-CIH BIO/NEURO FB "RTN","SDCCRSEN",244,0) ;;COMMUNITY CARE-CIH CLINICAL/BEHAVIORAL HYPNOTHERAPY^COM CARE-CIH CLIN/BEH HYPNO "RTN","SDCCRSEN",245,0) ;;COMMUNITY CARE-EMERGENCY TREATMENT APPROVED^COM CARE-EMER TREAT APPR "RTN","SDCCRSEN",246,0) ;;COMMUNITY CARE-INFERTILITY EVAL ONLY^COM CARE-INFERTILITY EVAL "RTN","SDCCRSEN",247,0) ;;COMMUNITY CARE-GEC ADULT DAY HEALTH CARE^COM CARE-GEC ADHC "RTN","SDCCRSEN",248,0) ;;COMMUNITY CARE-GEC NON-SKILLED HOME HEALTH AIDE^COM CARE-GEC NON-SK HHA "RTN","SDCCRSEN",249,0) ;;COMMUNITY CARE-IMAGING CT COLONOGRAPHY^COM CARE-IMAG CT COLON "RTN","SDCCRSEN",250,0) ;;COMMUNITY CARE-IMAGING BARIUM ENEMA^COM CARE-IMAG BARIUM ENEMA "RTN","SDCCRSEN",251,0) ;;COMMUNITY CARE-HOME SLEEP APNEA TEST^COM CARE-HOME SLEEP APNEA "RTN","SDCCRSEN",252,0) ;;COMMUNITY CARE-PTSD CLINICAL DEMONSTRATION (HBOT)^COM CARE-PTSD CL DEMO (HBOT) "RTN","SDCCRSEN",253,0) ;;COMMUNITY CARE-TREATMENT RESISTANT DEPRESSION^COM CARE-TRT RESIST DEP "RTN","SDCCRSEN",254,0) ;;COMMUNITY CARE-HEMATOLOGY/ONCOLOGY^COM CARE-HEMATOLOGY/ONCOLOGY "RTN","SDCCRSEN",255,0) ;;COMMUNITY CARE-HARDSHIP DETERMINATION^COM CARE-HARDSHIP DETER "RTN","SDCCRSEN1") 0^2^B47359591^n/a "RTN","SDCCRSEN1",1,0) SDCCRSEN1 ;CCRA/LB,PB - Appointment retrieval API;APR 4, 2019 "RTN","SDCCRSEN1",2,0) ;;5.3;Scheduling;**,822**;APR 4, 2019;Build 44 "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) MAKE ;MAKE APPOINTMENT: "S12"="SCHEDULE" "RTN","SDCCRSEN1",11,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",12,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",13,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",14,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,SDECSTART,SDCL,SDECRES) "RTN","SDCCRSEN1",15,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",16,0) .S ABORT="1^Patient already has an appointment at that datetime.",QUIT=1 "RTN","SDCCRSEN1",17,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) Q "RTN","SDCCRSEN1",18,0) Q:$G(QUIT)=1 "RTN","SDCCRSEN1",19,0) ;S:$G(SDECSTART)["@" SDECSTART=$P(SDECSTART,".",1)_"."_$E($P(SDECSTART,".",2),1,4) "RTN","SDCCRSEN1",20,0) ;S SDECSTART=$$FMTE^XLFDT(SDECSTART,2) "RTN","SDCCRSEN1",21,0) S SDECNOTE="HSRM, COMSULT "_$G(CONID)_" PID="_$G(CID)_" PER CONSULT, PROVIDER "_$G(PROV) "RTN","SDCCRSEN1",22,0) D:QUIT=0 APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,SDDFN,SDECRES,SDECLEN,$G(SDECNOTE),,,,,,,,,SDAPTYP,,,SDCL,,,,,1,,"") ;ADD NEW APPOINTMENT "RTN","SDCCRSEN1",23,0) ;735 - PB Check to see if the appointment was made. "RTN","SDCCRSEN1",24,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",25,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",26,0) ;Cancel remarks in in DPT $P(^DPT(DA(1),"S",DA,"R")," ",3) "RTN","SDCCRSEN1",27,0) I +$G(^TMP("SDEC07",$J,2))>0 Q "RTN","SDCCRSEN1",28,0) I $P($G(^TMP("SDEC07",$J,3)),"^",2)'="" S ABORT="1^"_$P($G(^TMP("SDEC07",$J,3)),"^",2) D "RTN","SDCCRSEN1",29,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",30,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",31,0) N XCLINIC S XCLINIC=+$G(^DPT($G(DFN),"S",FMDTTM,0),"^") I $G(XCLINIC)>0 D "RTN","SDCCRSEN1",32,0) .;Get the correct appointment from the appointment multiple in file 44 by matching .01 with the patient DFN, "RTN","SDCCRSEN1",33,0) .S XCLINIC=+$P(^DPT(DFN,"S",FMDTTM,0),"^") "RTN","SDCCRSEN1",34,0) .I $G(XCLINIC)>0 D "RTN","SDCCRSEN1",35,0) ..N DA,FDA,I1 "RTN","SDCCRSEN1",36,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",37,0) ..I +$G(^SD(XCLINIC,"S",FMDTTM,1,DA,"CONS"))="" S FDA(44.003,DA_","_FMDTTM_","_XCLINIC_",",688)=CONID "RTN","SDCCRSEN1",38,0) Q "RTN","SDCCRSEN1",39,0) CANCEL ;CANCEL APPOINTMENT: "S15"="CANCEL" "RTN","SDCCRSEN1",40,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",41,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",42,0) S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",43,0) ; patch 822 - PB check to see if the appointment exists "RTN","SDCCRSEN1",44,0) I '$D(^DPT(DFN,"S",$G(BASEDT))) D "RTN","SDCCRSEN1",45,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",46,0) .S QUIT=1 "RTN","SDCCRSEN1",47,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",48,0) I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",49,0) I $G(SDCL2)>0 D "RTN","SDCCRSEN1",50,0) .I $G(SDCL2)'=SDCL D "RTN","SDCCRSEN1",51,0) ..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",52,0) ..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",53,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",54,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",55,0) ;822 - PB when canceling the appointment check the CONS node for the appointment in file 44 appointment multiple "RTN","SDCCRSEN1",56,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",57,0) I $G(SDCL2)'>0 D "RTN","SDCCRSEN1",58,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",59,0) .S QUIT=1 "RTN","SDCCRSEN1",60,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",61,0) S SDECAPTID=$$CANCHECK(DFN,$G(SDCL2),$G(BASEDT),$G(CONID)) "RTN","SDCCRSEN1",62,0) I $G(SDECAPTID)=1 D "RTN","SDCCRSEN1",63,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",64,0) .S QUIT=1 "RTN","SDCCRSEN1",65,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",66,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",67,0) I $G(SDECAPTID)'>0 D "RTN","SDCCRSEN1",68,0) .S ABORT="1^NO APPOINTMENT was found to mark as CANCELED for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",69,0) .S QUIT=1 "RTN","SDCCRSEN1",70,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",71,0) S:$G(MSGARY("CANCEL CODE"))="" MSGARY("CANCEL CODE")="C" "RTN","SDCCRSEN1",72,0) S:$G(MSGARY("CANCEL REASON"))="" MSGARY("CANCEL REASON")=11 "RTN","SDCCRSEN1",73,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",74,0) ;735 - PB Check to see if the appointment was canceled. "RTN","SDCCRSEN1",75,0) I $G(^TMP("SDEC08",$J,"APPDEL",2))=$C(30) Q "RTN","SDCCRSEN1",76,0) I $G(^TMP("SDEC08",$J,"APPDEL",2))'="" S ABORT="1^"_$G(^TMP("SDEC08",$J,"APPDEL",2)) D "RTN","SDCCRSEN1",77,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",78,0) .D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN1",79,0) Q "RTN","SDCCRSEN1",80,0) NOSHOW ;NOSHOW APPOINTMENT: "S26"="NOSHOW" "RTN","SDCCRSEN1",81,0) ;S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",82,0) ;S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",83,0) ;S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",84,0) ;check if appointment exists "RTN","SDCCRSEN1",85,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",86,0) S:$G(DFN)>0 SDDFN=DFN "RTN","SDCCRSEN1",87,0) S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",88,0) ; patch 822 - PB check to see if the appointment exists "RTN","SDCCRSEN1",89,0) I '$D(^DPT(DFN,"S",$G(BASEDT))) D "RTN","SDCCRSEN1",90,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",91,0) .S QUIT=1 "RTN","SDCCRSEN1",92,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",93,0) I $D(^DPT(DFN,"S",$G(BASEDT))) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",94,0) I $G(SDCL2)'>0 D "RTN","SDCCRSEN1",95,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",96,0) .S QUIT=1 "RTN","SDCCRSEN1",97,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",98,0) I $G(SDCL2)>0 D "RTN","SDCCRSEN1",99,0) .I $G(SDCL2)'=SDCL D "RTN","SDCCRSEN1",100,0) ..S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",101,0) ..N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",102,0) S SDECLEN=$P(^SC(SDCL,"SL"),"^",1),SDECAPTID=0 "RTN","SDCCRSEN1",103,0) S:$G(SDECLEN)'>0 SDECLEN=15 "RTN","SDCCRSEN1",104,0) ;822 - PB when marking the appointment as NO SHOW check the CONS node for the appointment in file 44 appointment multiple "RTN","SDCCRSEN1",105,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",106,0) S SDECAPTID=$$CANCHECK(DFN,SDCL2,BASEDT,CONID) "RTN","SDCCRSEN1",107,0) I $G(SDECAPTID)=1 D "RTN","SDCCRSEN1",108,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",109,0) .S QUIT=1 "RTN","SDCCRSEN1",110,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",111,0) S:$G(SDDFN)>0 SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",112,0) ;Retrieve SDECAPTID pointer to SDEC APPOINTMENT file "RTN","SDCCRSEN1",113,0) ;S BASEDT=$$NETTOFM^SDECDATE(SDECSTART,"Y") "RTN","SDCCRSEN1",114,0) ;S SDECAPTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",115,0) I $G(SDECAPTID)'>0 D "RTN","SDCCRSEN1",116,0) .S ABORT="1^NO APPOINTMENT was found to mark as NO SHOW for the PATIENT on "_$G(SDECSTART)_" for consult, "_CONSULTID "RTN","SDCCRSEN1",117,0) .S QUIT=1 "RTN","SDCCRSEN1",118,0) I +$G(ABORT)=1 D MESSAGE^SDCCRCOR(MID,ABORT) Q "RTN","SDCCRSEN1",119,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",120,0) N SDCL2 S SDCL2=$P(^DPT(DFN,"S",$G(BASEDT),0),"^",1) "RTN","SDCCRSEN1",121,0) I SDCL2'=SDCL D "RTN","SDCCRSEN1",122,0) .S SDCL=SDCL2,SRVNAMEX=$P(^SC(SDCL,0),"^") "RTN","SDCCRSEN1",123,0) .N SDRES S SDRES=$O(^SDEC(409.831,"B",$G(SRVNAMEX),"")) S:$G(SDRES)>0 SDECRES=$G(SDRES) "RTN","SDCCRSEN1",124,0) D:QUIT=0 NOSHOW^SDEC31(.SDECY,SDECAPTID,1,$G(MSGARY("USER")),$G(SDECDATE)) "RTN","SDCCRSEN1",125,0) ;735 - PB Check to see if the appointment was made. "RTN","SDCCRSEN1",126,0) I +$G(^TMP("SDEC",$J,2))>0 Q "RTN","SDCCRSEN1",127,0) I +$G(^TMP("SDEC",$J,2))=0 S ABORT="1^"_$P($G(^TMP("SDEC",$J,2)),"^",2) D "RTN","SDCCRSEN1",128,0) .D MESSAGE^SDCCRCOR(MID,.ABORT) "RTN","SDCCRSEN1",129,0) .D ANAK^SDCCRCOR($P($G(ABORT),"^",2),$G(USERMAIL),$G(ICN),$G(DFN),$G(APTTM),$G(CONID)) "RTN","SDCCRSEN1",130,0) Q "RTN","SDCCRSEN1",131,0) CANCHECK(DFN,CLINIC,APPTTM,CONID,APPTID) ; "RTN","SDCCRSEN1",132,0) ;Returns APT ID if the appt is ready to be canceled, 1 if the appt should not be canceled "RTN","SDCCRSEN1",133,0) N GOOD,APTID "RTN","SDCCRSEN1",134,0) S GOOD=0 "RTN","SDCCRSEN1",135,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",136,0) .;W !,$G(^SC(CLINIC,"S",APPTTM,1,XX,0)) "RTN","SDCCRSEN1",137,0) .I +$P($G(^SC(CLINIC,"S",APPTTM,1,XX,"CONS")),"^")'=CONID S GOOD=1 W !,XX," ",$G(GOOD) "RTN","SDCCRSEN1",138,0) .I $P($G(^SC(CLINIC,0)),"^")'["COM CARE" S GOOD=1 "RTN","SDCCRSEN1",139,0) I $G(GOOD)=1 Q GOOD "RTN","SDCCRSEN1",140,0) S APTID=$$APPTGET^SDECUTL(SDDFN,BASEDT,SDCL,SDECRES) "RTN","SDCCRSEN1",141,0) K XX "RTN","SDCCRSEN1",142,0) Q APTID "VER") 8.0^22.2 "BLD",12400,6) ^676 **END** **END**