SDES2GETLINKS.m

SDES2GETLINKS ;ALB/TJB - VISTA SCHEDULING GET LINKS from file 409.98 ;August 24, 2023

 ;;5.3;Scheduling;**861**;Aug 13, 1993;Build 17

 ;;Per VHA Directive 6402, this routine should not be modified

 ;

 Q

 ;

 ; VSE-5546 - SDES2 GET HELP LINKS

GETLINKS(SDRETURN,SDCONTEXT) ;

 ;

 N COUNT,NAME,NAMET,HLIEN,ERRORS,HELPLNK

 ; validate context array, quit if errors

 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 I $D(ERRORS) S ERRORS("HelpLinks",1)="" D BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS) Q

 ;

 D BUILDLINKS(.HELPLNK)

 I '$D(HELPLNK) S HELPLNK("HelpLinks",1)=""

 ;

 D BUILDJSON^SDES2JSON(.SDRETURN,.HELPLNK)

 Q

BUILDLINKS(HELPLNK) ;

 N COUNT,NAME,NAMET,HLIEN

 S COUNT=0,NAME=""

 ; NAME = Item name from "B" cross reference 

 ; NAMET = Title format of NAME above with spaces stripped to be used in JSON output

 F  S NAME=$O(^SDEC(409.98,"B",NAME)) Q:NAME=""  S COUNT=COUNT+1,NAMET=$TR($$TITLE^XLFSTR(NAME)," ","") D

 . S HLIEN="" F  S HLIEN=$O(^SDEC(409.98,"B",NAME,HLIEN)) Q:HLIEN=""  D

 .. N ARRAY,NCOUNT,J,FLDNM,FLDNMT

 .. ; FLDNM = the field name returned from the GETS^DIQ call

 .. ; FLDNMT = Title format of the field name with spaces stripped to be used in JSON output

 .. S NCOUNT=0

 .. ; the "R" parameter returns the field names in the array returned by the GETS^DIQ

 .. D GETS^DIQ(409.98,HLIEN_",","1*","R","ARRAY")

 .. S J="" F  S J=$O(ARRAY(409.981,J)) Q:J=""  S NCOUNT=NCOUNT+1 D

 ... S FLDNM="" F  S FLDNM=$O(ARRAY(409.981,J,FLDNM)) Q:FLDNM=""  D

 .... S FLDNMT=$TR($$TITLE^XLFSTR(FLDNM)," ","")

 .... S HELPLNK("HelpLinks",COUNT,NAMET,NCOUNT,FLDNMT)=$G(ARRAY(409.981,J,FLDNM))

 .... Q

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDES2GETLINKS   1646     printed  Apr 09, 2024@21:54:40                                                                                                                                                                                               Page 2

SDES2GETLINKS ;ALB/TJB - VISTA SCHEDULING GET LINKS from file 409.98 ;August 24, 2023

 +1       ;;5.3;Scheduling;**861**;Aug 13, 1993;Build 17

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4        QUIT 

 +5       ;

 +6       ; VSE-5546 - SDES2 GET HELP LINKS

GETLINKS(SDRETURN,SDCONTEXT) ;

 +1       ;

 +2        NEW COUNT,NAME,NAMET,HLIEN,ERRORS,HELPLNK

 +3       ; validate context array, quit if errors

 +4        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +5        IF $DATA(ERRORS)

               SET ERRORS("HelpLinks",1)=""

               DO BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS)

               QUIT 

 +6       ;

 +7        DO BUILDLINKS(.HELPLNK)

 +8        IF '$DATA(HELPLNK)

               SET HELPLNK("HelpLinks",1)=""

 +9       ;

 +10       DO BUILDJSON^SDES2JSON(.SDRETURN,.HELPLNK)

 +11       QUIT 

BUILDLINKS(HELPLNK) ;

 +1        NEW COUNT,NAME,NAMET,HLIEN

 +2        SET COUNT=0

           SET NAME=""

 +3       ; NAME = Item name from "B" cross reference 

 +4       ; NAMET = Title format of NAME above with spaces stripped to be used in JSON output

 +5        FOR 

               SET NAME=$ORDER(^SDEC(409.98,"B",NAME))

               if NAME=""

                   QUIT 

               SET COUNT=COUNT+1

               SET NAMET=$TRANSLATE($$TITLE^XLFSTR(NAME)," ","")

               Begin DoDot:1

 +6                SET HLIEN=""

                   FOR 

                       SET HLIEN=$ORDER(^SDEC(409.98,"B",NAME,HLIEN))

                       if HLIEN=""

                           QUIT 

                       Begin DoDot:2

 +7                        NEW ARRAY,NCOUNT,J,FLDNM,FLDNMT

 +8       ; FLDNM = the field name returned from the GETS^DIQ call

 +9       ; FLDNMT = Title format of the field name with spaces stripped to be used in JSON output

 +10                       SET NCOUNT=0

 +11      ; the "R" parameter returns the field names in the array returned by the GETS^DIQ

 +12                       DO GETS^DIQ(409.98,HLIEN_",","1*","R","ARRAY")

 +13                       SET J=""

                           FOR 

                               SET J=$ORDER(ARRAY(409.981,J))

                               if J=""

                                   QUIT 

                               SET NCOUNT=NCOUNT+1

                               Begin DoDot:3

 +14                               SET FLDNM=""

                                   FOR 

                                       SET FLDNM=$ORDER(ARRAY(409.981,J,FLDNM))

                                       if FLDNM=""

                                           QUIT 

                                       Begin DoDot:4

 +15                                       SET FLDNMT=$TRANSLATE($$TITLE^XLFSTR(FLDNM)," ","")

 +16                                       SET HELPLNK("HelpLinks",COUNT,NAMET,NCOUNT,FLDNMT)=$GET(ARRAY(409.981,J,FLDNM))

 +17                                       QUIT 

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18      ;

 +19       QUIT