SDESCANCELVVS ;ALB/BWF,MGD - CANCEL VVS WEB SERVICE ; 5/30/24 13:38pm
;;5.3;SCHEDULING;**884**;AUG 13, 1993;Build 1
;;Per VHA Directive 6402, this routine should not be modified
;SAC EXEMPTION 202405201404-02 : Use of Cache methods
Q
;
RESTPOST(APPTIEN,SDSTATUS,SDCANREASON) ; Generate web service call to cancel VVS appointment
; Input:
; APPTIEN = Appointment IEN in #409.84
; SDSTATUS = Cancellation Status for Appointment (passed in if VVS Appointment Cancelled prior to VistA Appointment)
; SDCANREASON = Cancellation Reason for Appointment (passed in if VVS Appointment Cancelled prior to VistA Appointment)
; Output:
; 0^Error Information
; 1^Success Information
;
; NOTE: RESTPOST^SDESCANCELVVS contains vendor specific code that is restricted and will be reported by XINDEX.
; Exemption (202405201404-02) was granted by the Standards and Conventions (SAC) committee on 5/20/24
; allowing the vendor specific code.
;
N SDSERVER,SDSERVICE,SDRESTOBJ,DFN,VVSID,ICN,VVSCAN,VVSJSONOUT,SDRESPONSE,SDRESPERR,SDOUT
N SDERRCODE,SDERRARR,SDHEADER,SDHTTPRSP,SDKEY,SDOUTJSON,SDPROD,VVSIDUPPER,VVSERR
N $ETRAP,$ESTACK
;
; Determine Production or Test and set Server and Service accordingly
S SDPROD=$$PROD^XUPROD
I SDPROD D
. S SDSERVICE="SD VVS WEB SERVICE"
. S SDSERVER="SD VVS WEB SERVER"
;
I 'SDPROD D
. S SDSERVICE="SD VVS WEB SERVICE TEST"
. S SDSERVER="SD VVS WEB SERVER TEST"
;
; get instance of client REST request object
S SDRESTOBJ=$$GETREST^XOBWLIB(SDSERVICE,SDSERVER)
S SDRESTOBJ.SSLCheckServerIdentity=0
;
; Retrieve fields for VVS cancellation
S DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
S ICN=$$GETICN^MPIF001(DFN)
S DFN=DFN_"-"_DUZ(2)
S (VVSID,VVSIDUPPER)=$$GET1^DIQ(409.84,APPTIEN,2,"E")
; The VS GUI stores the ID in all uppercase, VSS stores it in lowercase so convert back to lowercase
S VVSID=$TR(VVSID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
I $G(SDSTATUS)="" S SDSTATUS=$$GET1^DIQ(409.84,APPTIEN,.17,"E")
D STATUS(.SDSTATUS)
I $G(SDCANREASON)="" S SDCANREASON=$$GET1^DIQ(409.84,APPTIEN,.122,"E")
D REASON(.SDCANREASON)
;
; Build JSON for VVS video Visit cancellation
S VVSCAN("id")=VVSID
S VVSCAN("sourceSystem")="VSE"
I +ICN>1 D
. S VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","assigningAuthority")="ICN"
. S VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","uniqueId")=ICN
I +ICN<0 D
. S VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","assigningAuthority")="DFN"
. S VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","uniqueId")=DFN
S VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","description")=""
S VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","code")=SDSTATUS
S VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","reason")=SDCANREASON
;
D BUILDJSON^SDES2JSON(.VVSJSONOUT,.VVSCAN)
D SDRESTOBJ.EntityBody.Write(VVSJSONOUT(1))
;
; Update Headers prior to calling VVS
F SDHEADER="Accept","ContentType" D SDRESTOBJ.SetHeader(SDHEADER,"application/json")
;
I SDPROD D
. S SDKEY=$$GET^XPAR("PKG","SD-VVS-CANCEL-KEY",1)
. S SDKEY=$$AESDECR^XUSHSH($$B64DECD^XUSHSH(SDKEY),"3ncr4pt55SK3y")
. D SDRESTOBJ.SetHeader("Authorization","Bearer SD-VVS-CANCEL-KEY"_";"_SDKEY)
I 'SDPROD D
. S SDKEY=$$GET^XPAR("PKG","SD-VVS-CANCEL-KEY-TEST",1)
. S SDKEY=$$AESDECR^XUSHSH($$B64DECD^XUSHSH(SDKEY),"3ncr4pt55SK3y")
. D SDRESTOBJ.SetHeader("Authorization","Bearer SD-VVS-CANCEL-KEY-TEST"_";"_SDKEY)
D SDRESTOBJ.SetHeader("Origin","https://vista.domain.ext")
;
; Execute HTTP Post method
S SDRESPONSE=$$POST^XOBWLIB(SDRESTOBJ,"",.SDRESPERR,0)
; Get HTTP response
I 'SDRESPONSE D Q SDRESPONSE
. S SDERRCODE=$$ERRSPMSG(SDRESPERR,.SDERRARR)
. S VVSERR=+SDERRCODE
. W !!,"This Video Visit appointment ",VVSIDUPPER
. W !,"couldn't be cancelled in the VVS system."
. W !,"VVS ERROR: "
. I VVSERR=400 W VVSERR," - A validation error occurred for the cancellation request."
. I VVSERR=401 W VVSERR," - The API Key or client ID was not recognized."
. I VVSERR=404 W VVSERR," - The appointment to be cancelled was not found."
. I VVSERR=500 W VVSERR," - Internal server error."
. I VVSERR="" W "504 - VVS Gateway Time-out."
;
W !!,"This Video Visit appointment successfully cancelled in the VVS system."
Q SDRESPONSE
;
ERRSPMSG(SDRESPERR,SDRESPETXT) ;
; Input : DGRESPERR (Required) - response error from Post call
; Return: response code/txt (ex: DGERR(400) from Init)_response code/msg (ex: ADDRVAL###)
N SDERRCODE,SDEMSG,SDERR
S SDERRCODE=SDRESPERR.code
DO ERR2ARR^XOBWLIB(.SDRESPERR,.SDRESPETXT)
; Example:
; S DGRESPETXT("errorType")="HTTP"
; S DGRESPETXT("statusLine")="HTTP/1.1 504 Gateway Timeout"
; S DGRESPETXT("text")=1
; S DGRESPETXT("text",1)={"message":"Unable to parse data. Not JSON format"}
S SDEMSG=$G(SDRESPETXT("text",1))
I SDEMSG="" S SDEMSG=SDRESPETXT("statusLine")
S SDERR(SDERRCODE)=SDERRCODE_$S($L(SDEMSG)>1:SDEMSG,1:" VVS Service Error.")
Q SDERR(SDERRCODE)
;
;
STATUS(SDSTATUS) ;
I SDSTATUS="NO-SHOW" S SDSTATUS="NO_SHOW" Q
I SDSTATUS="CANCELLED BY CLINIC" S SDSTATUS="CANCELLED_BY_CLINIC" Q
I SDSTATUS="NO-SHOW & AUTO RE-BOOK" S SDSTATUS="NO_SHOW_AND_AUTO_RE_BOOK" Q
I SDSTATUS="CANCELLED BY CLINIC & AUTO RE-BOOK" S SDSTATUS="CANCELLED_BY_CLINIC_AND_AUTO_RE_BOOK" Q
I SDSTATUS="INPATIENT APPOINTMENT" S SDSTATUS="CANCELLED_BY_CLINIC" Q
I SDSTATUS="CANCELLED BY PATIENT" S SDSTATUS="CANCELLED_BY_PATIENT" Q
I SDSTATUS="CANCELLED BY PATIENT & AUTO-REBOOK" S SDSTATUS="CANCELLED_BY_PATIENT_AND_AUTO_REBOOK" Q
I SDSTATUS="NO ACTION TAKEN" S SDSTATUS="CANCELLED_BY_CLINIC" Q
Q
;
;
REASON(SDCNREASON) ;
I SDCNREASON="APPOINTMENT NO LONGER REQUIRED" S SDCNREASON="APPOINTMENT_NO_LONGER_REQUIRED" Q
I SDCNREASON="AUTOMATED CANCELLATION" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="BLOCK AND MOVE" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="CLINIC CANCELLED" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="CLINIC STAFFING" S SDCNREASON="CLINIC_STAFFING" Q
I SDCNREASON="DEATH IN FAMILY" S SDCNREASON="DEATH_IN_FAMILY" Q
I SDCNREASON="DO NOT RESCHEDULE" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="INPATIENT STATUS" S SDCNREASON="INPATIENT_STATUS" Q
I SDCNREASON="OTHER" Q
I SDCNREASON="PANDEMIC" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="PATIENT DEATH" S SDCNREASON="PATIENT_DEATH" Q
I SDCNREASON="PATIENT NOT ELIGIBLE" S SDCNREASON="PATIENT_NOT_ELIGIBLE" Q
I SDCNREASON="RESCHEDULE - CALL BACK" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="RESCHEDULE - VET WILL CALL" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="SCHEDULING CONFLICT/ERROR" S SDCNREASON="SCHEDULING_CONFLICT_OR_ERROR" Q
I SDCNREASON="TRANSFER OPT CARE TO OTHER VA" S SDCNREASON="TRANSFER_OPT_CARE_TO_OTHER_VA" Q
I SDCNREASON="TRAVEL DIFFICULTY" S SDCNREASON="TRAVEL_DIFFICULTY" Q
I SDCNREASON="UNABLE TO KEEP APPOINTMENT" S SDCNREASON="UNABLE_TO_KEEP_APPOINTMENT" Q
I SDCNREASON="WALKIN ENTERED IN ERROR" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="WALKIN NO LONGER NECESSARY" S SDCNREASON="CLINIC_CANCELLED" Q
I SDCNREASON="WEATHER" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCANCELVVS 7293 printed Oct 16, 2024@18:56:24 Page 2
SDESCANCELVVS ;ALB/BWF,MGD - CANCEL VVS WEB SERVICE ; 5/30/24 13:38pm
+1 ;;5.3;SCHEDULING;**884**;AUG 13, 1993;Build 1
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;SAC EXEMPTION 202405201404-02 : Use of Cache methods
+4 QUIT
+5 ;
RESTPOST(APPTIEN,SDSTATUS,SDCANREASON) ; Generate web service call to cancel VVS appointment
+1 ; Input:
+2 ; APPTIEN = Appointment IEN in #409.84
+3 ; SDSTATUS = Cancellation Status for Appointment (passed in if VVS Appointment Cancelled prior to VistA Appointment)
+4 ; SDCANREASON = Cancellation Reason for Appointment (passed in if VVS Appointment Cancelled prior to VistA Appointment)
+5 ; Output:
+6 ; 0^Error Information
+7 ; 1^Success Information
+8 ;
+9 ; NOTE: RESTPOST^SDESCANCELVVS contains vendor specific code that is restricted and will be reported by XINDEX.
+10 ; Exemption (202405201404-02) was granted by the Standards and Conventions (SAC) committee on 5/20/24
+11 ; allowing the vendor specific code.
+12 ;
+13 NEW SDSERVER,SDSERVICE,SDRESTOBJ,DFN,VVSID,ICN,VVSCAN,VVSJSONOUT,SDRESPONSE,SDRESPERR,SDOUT
+14 NEW SDERRCODE,SDERRARR,SDHEADER,SDHTTPRSP,SDKEY,SDOUTJSON,SDPROD,VVSIDUPPER,VVSERR
+15 NEW $ETRAP,$ESTACK
+16 ;
+17 ; Determine Production or Test and set Server and Service accordingly
+18 SET SDPROD=$$PROD^XUPROD
+19 IF SDPROD
Begin DoDot:1
+20 SET SDSERVICE="SD VVS WEB SERVICE"
+21 SET SDSERVER="SD VVS WEB SERVER"
End DoDot:1
+22 ;
+23 IF 'SDPROD
Begin DoDot:1
+24 SET SDSERVICE="SD VVS WEB SERVICE TEST"
+25 SET SDSERVER="SD VVS WEB SERVER TEST"
End DoDot:1
+26 ;
+27 ; get instance of client REST request object
+28 SET SDRESTOBJ=$$GETREST^XOBWLIB(SDSERVICE,SDSERVER)
+29 SET SDRESTOBJ.SSLCheckServerIdentity=0
+30 ;
+31 ; Retrieve fields for VVS cancellation
+32 SET DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
+33 SET ICN=$$GETICN^MPIF001(DFN)
+34 SET DFN=DFN_"-"_DUZ(2)
+35 SET (VVSID,VVSIDUPPER)=$$GET1^DIQ(409.84,APPTIEN,2,"E")
+36 ; The VS GUI stores the ID in all uppercase, VSS stores it in lowercase so convert back to lowercase
+37 SET VVSID=$TRANSLATE(VVSID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+38 IF $GET(SDSTATUS)=""
SET SDSTATUS=$$GET1^DIQ(409.84,APPTIEN,.17,"E")
+39 DO STATUS(.SDSTATUS)
+40 IF $GET(SDCANREASON)=""
SET SDCANREASON=$$GET1^DIQ(409.84,APPTIEN,.122,"E")
+41 DO REASON(.SDCANREASON)
+42 ;
+43 ; Build JSON for VVS video Visit cancellation
+44 SET VVSCAN("id")=VVSID
+45 SET VVSCAN("sourceSystem")="VSE"
+46 IF +ICN>1
Begin DoDot:1
+47 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","assigningAuthority")="ICN"
+48 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","uniqueId")=ICN
End DoDot:1
+49 IF +ICN<0
Begin DoDot:1
+50 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","assigningAuthority")="DFN"
+51 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"id","uniqueId")=DFN
End DoDot:1
+52 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","description")=""
+53 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","code")=SDSTATUS
+54 SET VVSCAN("patientBookingStatuses","personBookingStatus",1,"status","reason")=SDCANREASON
+55 ;
+56 DO BUILDJSON^SDES2JSON(.VVSJSONOUT,.VVSCAN)
+57 DO SDRESTOBJ.EntityBody.Write(VVSJSONOUT(1))
+58 ;
+59 ; Update Headers prior to calling VVS
+60 FOR SDHEADER="Accept","ContentType"
DO SDRESTOBJ.SetHeader(SDHEADER,"application/json")
+61 ;
+62 IF SDPROD
Begin DoDot:1
+63 SET SDKEY=$$GET^XPAR("PKG","SD-VVS-CANCEL-KEY",1)
+64 SET SDKEY=$$AESDECR^XUSHSH($$B64DECD^XUSHSH(SDKEY),"3ncr4pt55SK3y")
+65 DO SDRESTOBJ.SetHeader("Authorization","Bearer SD-VVS-CANCEL-KEY"_";"_SDKEY)
End DoDot:1
+66 IF 'SDPROD
Begin DoDot:1
+67 SET SDKEY=$$GET^XPAR("PKG","SD-VVS-CANCEL-KEY-TEST",1)
+68 SET SDKEY=$$AESDECR^XUSHSH($$B64DECD^XUSHSH(SDKEY),"3ncr4pt55SK3y")
+69 DO SDRESTOBJ.SetHeader("Authorization","Bearer SD-VVS-CANCEL-KEY-TEST"_";"_SDKEY)
End DoDot:1
+70 DO SDRESTOBJ.SetHeader("Origin","https://vista.domain.ext")
+71 ;
+72 ; Execute HTTP Post method
+73 SET SDRESPONSE=$$POST^XOBWLIB(SDRESTOBJ,"",.SDRESPERR,0)
+74 ; Get HTTP response
+75 IF 'SDRESPONSE
Begin DoDot:1
+76 SET SDERRCODE=$$ERRSPMSG(SDRESPERR,.SDERRARR)
+77 SET VVSERR=+SDERRCODE
+78 WRITE !!,"This Video Visit appointment ",VVSIDUPPER
+79 WRITE !,"couldn't be cancelled in the VVS system."
+80 WRITE !,"VVS ERROR: "
+81 IF VVSERR=400
WRITE VVSERR," - A validation error occurred for the cancellation request."
+82 IF VVSERR=401
WRITE VVSERR," - The API Key or client ID was not recognized."
+83 IF VVSERR=404
WRITE VVSERR," - The appointment to be cancelled was not found."
+84 IF VVSERR=500
WRITE VVSERR," - Internal server error."
+85 IF VVSERR=""
WRITE "504 - VVS Gateway Time-out."
End DoDot:1
QUIT SDRESPONSE
+86 ;
+87 WRITE !!,"This Video Visit appointment successfully cancelled in the VVS system."
+88 QUIT SDRESPONSE
+89 ;
ERRSPMSG(SDRESPERR,SDRESPETXT) ;
+1 ; Input : DGRESPERR (Required) - response error from Post call
+2 ; Return: response code/txt (ex: DGERR(400) from Init)_response code/msg (ex: ADDRVAL###)
+3 NEW SDERRCODE,SDEMSG,SDERR
+4 SET SDERRCODE=SDRESPERR.code
+5 DO ERR2ARR^XOBWLIB(.SDRESPERR,.SDRESPETXT)
+6 ; Example:
+7 ; S DGRESPETXT("errorType")="HTTP"
+8 ; S DGRESPETXT("statusLine")="HTTP/1.1 504 Gateway Timeout"
+9 ; S DGRESPETXT("text")=1
+10 ; S DGRESPETXT("text",1)={"message":"Unable to parse data. Not JSON format"}
+11 SET SDEMSG=$GET(SDRESPETXT("text",1))
+12 IF SDEMSG=""
SET SDEMSG=SDRESPETXT("statusLine")
+13 SET SDERR(SDERRCODE)=SDERRCODE_$SELECT($LENGTH(SDEMSG)>1:SDEMSG,1:" VVS Service Error.")
+14 QUIT SDERR(SDERRCODE)
+15 ;
+16 ;
STATUS(SDSTATUS) ;
+1 IF SDSTATUS="NO-SHOW"
SET SDSTATUS="NO_SHOW"
QUIT
+2 IF SDSTATUS="CANCELLED BY CLINIC"
SET SDSTATUS="CANCELLED_BY_CLINIC"
QUIT
+3 IF SDSTATUS="NO-SHOW & AUTO RE-BOOK"
SET SDSTATUS="NO_SHOW_AND_AUTO_RE_BOOK"
QUIT
+4 IF SDSTATUS="CANCELLED BY CLINIC & AUTO RE-BOOK"
SET SDSTATUS="CANCELLED_BY_CLINIC_AND_AUTO_RE_BOOK"
QUIT
+5 IF SDSTATUS="INPATIENT APPOINTMENT"
SET SDSTATUS="CANCELLED_BY_CLINIC"
QUIT
+6 IF SDSTATUS="CANCELLED BY PATIENT"
SET SDSTATUS="CANCELLED_BY_PATIENT"
QUIT
+7 IF SDSTATUS="CANCELLED BY PATIENT & AUTO-REBOOK"
SET SDSTATUS="CANCELLED_BY_PATIENT_AND_AUTO_REBOOK"
QUIT
+8 IF SDSTATUS="NO ACTION TAKEN"
SET SDSTATUS="CANCELLED_BY_CLINIC"
QUIT
+9 QUIT
+10 ;
+11 ;
REASON(SDCNREASON) ;
+1 IF SDCNREASON="APPOINTMENT NO LONGER REQUIRED"
SET SDCNREASON="APPOINTMENT_NO_LONGER_REQUIRED"
QUIT
+2 IF SDCNREASON="AUTOMATED CANCELLATION"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+3 IF SDCNREASON="BLOCK AND MOVE"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+4 IF SDCNREASON="CLINIC CANCELLED"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+5 IF SDCNREASON="CLINIC STAFFING"
SET SDCNREASON="CLINIC_STAFFING"
QUIT
+6 IF SDCNREASON="DEATH IN FAMILY"
SET SDCNREASON="DEATH_IN_FAMILY"
QUIT
+7 IF SDCNREASON="DO NOT RESCHEDULE"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+8 IF SDCNREASON="INPATIENT STATUS"
SET SDCNREASON="INPATIENT_STATUS"
QUIT
+9 IF SDCNREASON="OTHER"
QUIT
+10 IF SDCNREASON="PANDEMIC"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+11 IF SDCNREASON="PATIENT DEATH"
SET SDCNREASON="PATIENT_DEATH"
QUIT
+12 IF SDCNREASON="PATIENT NOT ELIGIBLE"
SET SDCNREASON="PATIENT_NOT_ELIGIBLE"
QUIT
+13 IF SDCNREASON="RESCHEDULE - CALL BACK"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+14 IF SDCNREASON="RESCHEDULE - VET WILL CALL"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+15 IF SDCNREASON="SCHEDULING CONFLICT/ERROR"
SET SDCNREASON="SCHEDULING_CONFLICT_OR_ERROR"
QUIT
+16 IF SDCNREASON="TRANSFER OPT CARE TO OTHER VA"
SET SDCNREASON="TRANSFER_OPT_CARE_TO_OTHER_VA"
QUIT
+17 IF SDCNREASON="TRAVEL DIFFICULTY"
SET SDCNREASON="TRAVEL_DIFFICULTY"
QUIT
+18 IF SDCNREASON="UNABLE TO KEEP APPOINTMENT"
SET SDCNREASON="UNABLE_TO_KEEP_APPOINTMENT"
QUIT
+19 IF SDCNREASON="WALKIN ENTERED IN ERROR"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+20 IF SDCNREASON="WALKIN NO LONGER NECESSARY"
SET SDCNREASON="CLINIC_CANCELLED"
QUIT
+21 IF SDCNREASON="WEATHER"
QUIT
+22 QUIT
