SDESVVC ;ALB/WTC,DJS,JAS - VISTA SCHEDULING RPCS ;DEC 23, 2022@11:25
;;5.3;Scheduling;**828,833**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
VVCAPPT(SDESJSON,SDESAPPT) ;
;
; SDES VVC APPT RPC
;
; Returns VVC Web app URL in JSON format if appointment is valid and for a VVC clinic.
;
; SDESAPPT = Appointment (pointer to #409.84)
;
N SDESARRAY
;
D ERRCHK
I '$D(SDESARRAY("Error",1)) D URLCHK
;
D BUILDJSON^SDESBUILDJSON(.SDESJSON,.SDESARRAY)
Q
;
ERRCHK ;
;
; ERROR CHECKING
;
I '$L($G(SDESAPPT)) D Q
. S SDESARRAY("Error",1)=$$ERRTXT(14) ; Missing Appt IEN
;
I '+$G(SDESAPPT) D Q
. S SDESARRAY("Error",1)=$$ERRTXT(15) ; Incorrectly formatted Appt IEN
;
I '$D(^SDEC(409.84,SDESAPPT)) D Q
. S SDESARRAY("Error",1)=$$ERRTXT(15) ; Appt IEN does not exist
Q
;
URLCHK ;
;
N SDESRES,SDES44,SDESSTOP,SDESREDT
;
; Appointment's resource
;
S SDESRES=$$GET1^DIQ(409.84,SDESAPPT,.07,"I")
I 'SDESRES S SDESARRAY("Error",1)=$$ERRTXT(383) Q ; Resource is missing from Appt
;
; Resource's clinic
;
S SDES44=$$GET1^DIQ(409.831,SDESRES,.04,"I")
I 'SDES44 S SDESARRAY("Error",1)=$$ERRTXT(283) Q ; Clinic is missing from Resource
;
; Clinic's stop code and credit stop code.
;
S SDESSTOP=$$GET1^DIQ(44,SDES44,8,"I"),SDESREDT=$$GET1^DIQ(44,SDES44,2503,"I")
I SDESSTOP S SDESSTOP=$$GET1^DIQ(40.7,SDESSTOP,1,"I")
I SDESREDT S SDESREDT=$$GET1^DIQ(40.7,SDESREDT,1,"I")
;
I 'SDESSTOP,'SDESREDT S SDESARRAY("Error",1)=$$ERRTXT(98) Q ; No stop codes so no URL.
;
; If clinic's stop code or credit stop code is for VVC, return URL for VVC Web app
;
I SDESSTOP'="",$O(^SDEC(409.98,1,3,"B",SDESSTOP,0))>0 D Q
. S SDESARRAY(0)="T01000URL",SDESARRAY(1)=$$GET1^DIQ(409.98,1,6)
I SDESREDT'="",$O(^SDEC(409.98,1,3,"B",SDESREDT,0))>0 D Q
. S SDESARRAY(0)="T01000URL",SDESARRAY(1)=$$GET1^DIQ(409.98,1,6)
;
; Not a VVC appointment.
;
S SDESARRAY("Error",1)=$$ERRTXT(403)
;
ERRTXT(ERRNM) ;
;
; ERRNM - The ERROR CODE/NUMBER field from the SDES ERROR CODES file (#409.93)
;
N SDESERR
D ERRLOG^SDESJSON(.SDESERR,ERRNM)
Q SDESERR("Error",1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESVVC 2210 printed Dec 13, 2024@02:57:53 Page 2
SDESVVC ;ALB/WTC,DJS,JAS - VISTA SCHEDULING RPCS ;DEC 23, 2022@11:25
+1 ;;5.3;Scheduling;**828,833**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
VVCAPPT(SDESJSON,SDESAPPT) ;
+1 ;
+2 ; SDES VVC APPT RPC
+3 ;
+4 ; Returns VVC Web app URL in JSON format if appointment is valid and for a VVC clinic.
+5 ;
+6 ; SDESAPPT = Appointment (pointer to #409.84)
+7 ;
+8 NEW SDESARRAY
+9 ;
+10 DO ERRCHK
+11 IF '$DATA(SDESARRAY("Error",1))
DO URLCHK
+12 ;
+13 DO BUILDJSON^SDESBUILDJSON(.SDESJSON,.SDESARRAY)
+14 QUIT
+15 ;
ERRCHK ;
+1 ;
+2 ; ERROR CHECKING
+3 ;
+4 IF '$LENGTH($GET(SDESAPPT))
Begin DoDot:1
+5 ; Missing Appt IEN
SET SDESARRAY("Error",1)=$$ERRTXT(14)
End DoDot:1
QUIT
+6 ;
+7 IF '+$GET(SDESAPPT)
Begin DoDot:1
+8 ; Incorrectly formatted Appt IEN
SET SDESARRAY("Error",1)=$$ERRTXT(15)
End DoDot:1
QUIT
+9 ;
+10 IF '$DATA(^SDEC(409.84,SDESAPPT))
Begin DoDot:1
+11 ; Appt IEN does not exist
SET SDESARRAY("Error",1)=$$ERRTXT(15)
End DoDot:1
QUIT
+12 QUIT
+13 ;
URLCHK ;
+1 ;
+2 NEW SDESRES,SDES44,SDESSTOP,SDESREDT
+3 ;
+4 ; Appointment's resource
+5 ;
+6 SET SDESRES=$$GET1^DIQ(409.84,SDESAPPT,.07,"I")
+7 ; Resource is missing from Appt
IF 'SDESRES
SET SDESARRAY("Error",1)=$$ERRTXT(383)
QUIT
+8 ;
+9 ; Resource's clinic
+10 ;
+11 SET SDES44=$$GET1^DIQ(409.831,SDESRES,.04,"I")
+12 ; Clinic is missing from Resource
IF 'SDES44
SET SDESARRAY("Error",1)=$$ERRTXT(283)
QUIT
+13 ;
+14 ; Clinic's stop code and credit stop code.
+15 ;
+16 SET SDESSTOP=$$GET1^DIQ(44,SDES44,8,"I")
SET SDESREDT=$$GET1^DIQ(44,SDES44,2503,"I")
+17 IF SDESSTOP
SET SDESSTOP=$$GET1^DIQ(40.7,SDESSTOP,1,"I")
+18 IF SDESREDT
SET SDESREDT=$$GET1^DIQ(40.7,SDESREDT,1,"I")
+19 ;
+20 ; No stop codes so no URL.
IF 'SDESSTOP
IF 'SDESREDT
SET SDESARRAY("Error",1)=$$ERRTXT(98)
QUIT
+21 ;
+22 ; If clinic's stop code or credit stop code is for VVC, return URL for VVC Web app
+23 ;
+24 IF SDESSTOP'=""
IF $ORDER(^SDEC(409.98,1,3,"B",SDESSTOP,0))>0
Begin DoDot:1
+25 SET SDESARRAY(0)="T01000URL"
SET SDESARRAY(1)=$$GET1^DIQ(409.98,1,6)
End DoDot:1
QUIT
+26 IF SDESREDT'=""
IF $ORDER(^SDEC(409.98,1,3,"B",SDESREDT,0))>0
Begin DoDot:1
+27 SET SDESARRAY(0)="T01000URL"
SET SDESARRAY(1)=$$GET1^DIQ(409.98,1,6)
End DoDot:1
QUIT
+28 ;
+29 ; Not a VVC appointment.
+30 ;
+31 SET SDESARRAY("Error",1)=$$ERRTXT(403)
+32 ;
ERRTXT(ERRNM) ;
+1 ;
+2 ; ERRNM - The ERROR CODE/NUMBER field from the SDES ERROR CODES file (#409.93)
+3 ;
+4 NEW SDESERR
+5 DO ERRLOG^SDESJSON(.SDESERR,ERRNM)
+6 QUIT SDESERR("Error",1)
