SDCCRSEN2 ;CCRA/LB,PB - Appointment retrieval API;
;;5.3;Scheduling;**912**;;Build 61
;SAC EXEMPTION 202505291453-05 : CCRA use of vendor specific code
;Patch 912 change to add a new comment to the consult
Q
;Check the status of the consult. if it is scheduled or canceled return 1, otherwise return 0
CHKAPPT(CONSID,TYPE) ;
;D APPERROR^%ZTER("SDCCRSEN2 8")
I CONSID="" Q 0
S ST=0
I TYPE="SCHEDULE" D
.S TSTATUS=$O(^ORD(100.01,"B","SCHEDULED",0))
.S:$P(^GMR(123,CONSID,0),"^",12)=TSTATUS ST=1
;When checking cancel, check status, if status = scheduled, then check to see if there is an appointment
;for the appointment date/time (SDECSTART). if status = scheduled and there is an appointment for the
;patient on the SDECSTART time, then it is considered the original and return 1. otherwise return 0
I TYPE="CANCEL" D
.S TSTATUS=$O(^ORD(100.01,"B","CANCELLED",0))
.S:$P(^GMR(123,CONSID,0),"^",12)=TSTATUS ST=1
.I ST=0 d
..S:'$D(^DPT(DFN,"S",STARTFM1)) ST=1
Q ST
D WEBSERV
S COMMENT(1)="Patient has an appointment on "_SDECSTART_" with "_$G(PROV)_"."
S COMMENT(2)="Address: "_$G(OFFICE)
S COMMENT(3)=" "_$G(STREET1)
S COMMENT(4)=" "_$G(CITY)_", "_$G(STATE)_" "_$G(ZIP)
S COMMENT(5)=" "_"Office Phone: "_$G(PHONE)
D NOW^%DTC
D CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
K ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,%
Q
D WEBSERV
D NOW^%DTC
S CANCELEDBY=$P(USERMAIL,"@")
S COMMENT(1)="Patient's appointment on "_SDECSTART_" with "_$G(PROV)
S COMMENT(2)="at: "_$G(OFFICE)
S COMMENT(3)=" "_$G(STREET1)
S COMMENT(4)=" "_$G(CITY)_", "_$G(STATE)_" "_$G(ZIP)
S COMMENT(5)=" "_"Office Phone: "_$G(PHONE)
S COMMENT(6)="was canceled by "_$P($G(CANCELEDBY),".",1)_" "_$P($G(CANCELEDBY),".",2)_" on "_SDECSTART_"."
D NOW^%DTC
D CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
K ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,CANCELEDBY,%
Q
D WEBSERV
S CANCELEDBY=$P(USERMAIL,"@")
S COMMENT(1)="Patient failed to make an appointment on "_SDECSTART_" with "_$G(PROV)
S COMMENT(2)="at: "_$G(OFFICE)
S COMMENT(3)=$G(STREET1)
S COMMENT(4)=$G(CITY)_", "_$G(STATE)_" "_$G(ZIP)
S COMMENT(5)="Office Phone: "_$G(PHONE)
D NOW^%DTC
D CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
K ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,%
Q
WEBSERV ;
N MYREST,MYERR,resource,SC,NEWRESPONSE,JSON,RESPJSON,OUTJSON,XX,PROVPHONE
S MYREST=$$GETREST^XOBWLIB("CCRA NPI SERVICE","CCRA NPI SERVER"),MYERR=""
S resource="/"_NPI,PHONE=""
S SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
I 'SC I MYERR.code=404 D
.S PHONE=""
I 'SC Q 1
S NEWRESPONSE=MYREST.HttpResponse
S JSON=NEWRESPONSE.Data
S RESPJSON=""
F Q:JSON.AtEnd S RESPJSON=RESPJSON_JSON.ReadLine()
S OUTJSON=""
D DECODE^XLFJSON("RESPJSON","OUTJSON","MYERR")
d NOW^%DTC
I $G(MYERR)="" D PARSEJSON
Q
PARSEJSON ;
S XX=0 F S XX=$O(OUTJSON("PPMSLocations",XX)) Q:XX'>0 D
.Q:$G(OUTJSON("PPMSLocations",XX,"Location","SiteName"))'=SITE
.Q:$G(OUTJSON("PPMSLocations",XX,"Location","Street1"))'=STREET
.S PHONE=$G(OUTJSON("PPMSLocations",XX,"Location","Phone"))
.S STREET1=$G(OUTJSON("PPMSLocations",XX,"Location","Street1"))
.S CITY=$G(OUTJSON("PPMSLocations",XX,"Location","City"))
.S STATE=$G(OUTJSON("PPMSLocations",XX,"Location","State"))
.S ZIP=$G(OUTJSON("PPMSLocations",XX,"Location","Zip"))
.S OFFICE=$G(OUTJSON("PPMSLocations",XX,"Location","SiteName"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCCRSEN2 3620 printed Sep 23, 2025@20:25:20 Page 2
SDCCRSEN2 ;CCRA/LB,PB - Appointment retrieval API;
+1 ;;5.3;Scheduling;**912**;;Build 61
+2 ;SAC EXEMPTION 202505291453-05 : CCRA use of vendor specific code
+3 ;Patch 912 change to add a new comment to the consult
+4 QUIT
+5 ;Check the status of the consult. if it is scheduled or canceled return 1, otherwise return 0
CHKAPPT(CONSID,TYPE) ;
+1 ;D APPERROR^%ZTER("SDCCRSEN2 8")
+2 IF CONSID=""
QUIT 0
+3 SET ST=0
+4 IF TYPE="SCHEDULE"
Begin DoDot:1
+5 SET TSTATUS=$ORDER(^ORD(100.01,"B","SCHEDULED",0))
+6 if $PIECE(^GMR(123,CONSID,0),"^",12)=TSTATUS
SET ST=1
End DoDot:1
+7 ;When checking cancel, check status, if status = scheduled, then check to see if there is an appointment
+8 ;for the appointment date/time (SDECSTART). if status = scheduled and there is an appointment for the
+9 ;patient on the SDECSTART time, then it is considered the original and return 1. otherwise return 0
+10 IF TYPE="CANCEL"
Begin DoDot:1
+11 SET TSTATUS=$ORDER(^ORD(100.01,"B","CANCELLED",0))
+12 if $PIECE(^GMR(123,CONSID,0),"^",12)=TSTATUS
SET ST=1
+13 IF ST=0
Begin DoDot:2
+14 if '$DATA(^DPT(DFN,"S",STARTFM1))
SET ST=1
End DoDot:2
End DoDot:1
+15 QUIT ST
+1 DO WEBSERV
+2 SET COMMENT(1)="Patient has an appointment on "_SDECSTART_" with "_$GET(PROV)_"."
+3 SET COMMENT(2)="Address: "_$GET(OFFICE)
+4 SET COMMENT(3)=" "_$GET(STREET1)
+5 SET COMMENT(4)=" "_$GET(CITY)_", "_$GET(STATE)_" "_$GET(ZIP)
+6 SET COMMENT(5)=" "_"Office Phone: "_$GET(PHONE)
+7 DO NOW^%DTC
+8 DO CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
+9 KILL ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,%
+10 QUIT
+1 DO WEBSERV
+2 DO NOW^%DTC
+3 SET CANCELEDBY=$PIECE(USERMAIL,"@")
+4 SET COMMENT(1)="Patient's appointment on "_SDECSTART_" with "_$GET(PROV)
+5 SET COMMENT(2)="at: "_$GET(OFFICE)
+6 SET COMMENT(3)=" "_$GET(STREET1)
+7 SET COMMENT(4)=" "_$GET(CITY)_", "_$GET(STATE)_" "_$GET(ZIP)
+8 SET COMMENT(5)=" "_"Office Phone: "_$GET(PHONE)
+9 SET COMMENT(6)="was canceled by "_$PIECE($GET(CANCELEDBY),".",1)_" "_$PIECE($GET(CANCELEDBY),".",2)_" on "_SDECSTART_"."
+10 DO NOW^%DTC
+11 DO CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
+12 KILL ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,CANCELEDBY,%
+13 QUIT
+1 DO WEBSERV
+2 SET CANCELEDBY=$PIECE(USERMAIL,"@")
+3 SET COMMENT(1)="Patient failed to make an appointment on "_SDECSTART_" with "_$GET(PROV)
+4 SET COMMENT(2)="at: "_$GET(OFFICE)
+5 SET COMMENT(3)=$GET(STREET1)
+6 SET COMMENT(4)=$GET(CITY)_", "_$GET(STATE)_" "_$GET(ZIP)
+7 SET COMMENT(5)="Office Phone: "_$GET(PHONE)
+8 DO NOW^%DTC
+9 DO CMT^GMRCGUIB(CONID,.COMMENT,DUZ,%,DUZ)
+10 KILL ZIP,TSTATUS,STREET2,STATE,ST,PHONE,OFFICE,COMMENT,CITY,%
+11 QUIT
WEBSERV ;
+1 NEW MYREST,MYERR,resource,SC,NEWRESPONSE,JSON,RESPJSON,OUTJSON,XX,PROVPHONE
+2 SET MYREST=$$GETREST^XOBWLIB("CCRA NPI SERVICE","CCRA NPI SERVER")
SET MYERR=""
+3 SET resource="/"_NPI
SET PHONE=""
+4 SET SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
+5 IF 'SC
IF MYERR.code=404
Begin DoDot:1
+6 SET PHONE=""
End DoDot:1
+7 IF 'SC
QUIT 1
+8 SET NEWRESPONSE=MYREST.HttpResponse
+9 SET JSON=NEWRESPONSE.Data
+10 SET RESPJSON=""
+11 FOR
if JSON.AtEnd
QUIT
SET RESPJSON=RESPJSON_JSON.ReadLine()
+12 SET OUTJSON=""
+13 DO DECODE^XLFJSON("RESPJSON","OUTJSON","MYERR")
+14 DO NOW^%DTC
+15 IF $GET(MYERR)=""
DO PARSEJSON
+16 QUIT
PARSEJSON ;
+1 SET XX=0
FOR
SET XX=$ORDER(OUTJSON("PPMSLocations",XX))
if XX'>0
QUIT
Begin DoDot:1
+2 if $GET(OUTJSON("PPMSLocations",XX,"Location","SiteName"))'=SITE
QUIT
+3 if $GET(OUTJSON("PPMSLocations",XX,"Location","Street1"))'=STREET
QUIT
+4 SET PHONE=$GET(OUTJSON("PPMSLocations",XX,"Location","Phone"))
+5 SET STREET1=$GET(OUTJSON("PPMSLocations",XX,"Location","Street1"))
+6 SET CITY=$GET(OUTJSON("PPMSLocations",XX,"Location","City"))
+7 SET STATE=$GET(OUTJSON("PPMSLocations",XX,"Location","State"))
+8 SET ZIP=$GET(OUTJSON("PPMSLocations",XX,"Location","Zip"))
+9 SET OFFICE=$GET(OUTJSON("PPMSLocations",XX,"Location","SiteName"))
End DoDot:1
+10 QUIT
