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 ---[H[J[2J[HSDES2GETLINKS 1646 printed Dec 13, 2024@02:54:03 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
