SDESVVC.m

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 ---SDESVVC   2210     printed  Feb 19, 2025@00:24:24                                                                                                                                                                                                     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)