ORWEB ;SLC/JM - HTML DIALOG WEB CONTENT ;Jan 21, 2025@11:23:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
Q
GETWEBCONTENT(RESULTS,INPUTJSON) ;
N INPUT,NAME,IEN,INDEX,IDX,SIDX,SIEN,JSON,ERROR,ROOT,X0,SYSTEM
S JSON("success")="false",(INDEX,SYSTEM,IEN)=0
D DECODE^XLFJSON("INPUTJSON","INPUT","ERROR")
I $D(ERROR) D G GETWEBCONTENTX
. S JSON("error","\",1)="Invalid Input JSON"_$C(13)_$C(10)
. S IDX=0 F S IDX=$O(ERROR(IDX)) Q:'IDX D
.. S JSON("error","\",IDX+1)=ERROR(IDX)_$C(13)_$C(10)
S NAME=$G(INPUT("contentName"))
I $D(INPUT("system")) S SYSTEM=1
I NAME="",'SYSTEM S JSON("error")="No content name entered" G GETWEBCONTENTX
I NAME'="" D
. S IEN=$O(^ORW(101.76,"B",NAME,0)) I 'IEN D G GETWEBCONTENTX
. . S JSON("error")="Web content '"_NAME_"' not found."
S ROOT="JSON(""contents"","
I SYSTEM D
. S SIEN=0 F S SIEN=$O(^ORW(101.76,SIEN)) Q:'SIEN D
. . I '+$P($G(^ORW(101.76,SIEN,0)),U,3) Q
. . D GETCONTENT(ROOT,SIEN)
I IEN D
. S X0=$G(^ORW(101.76,IEN,0))
. I $O(^ORW(101.76,IEN,1,0)) D GETCONTENT(ROOT,IEN)
. S IDX=0 F S IDX=$O(^ORW(101.76,IEN,2,"B",IDX)) Q:'IDX D
. . S SIDX=$O(^ORW(101.76,IEN,2,"B",IDX,0))
. . S SIEN=$P($G(^ORW(101.76,IEN,2,SIDX,0)),U,2)
. . D GETCONTENT(ROOT,SIEN)
S JSON("success")="true"
GETWEBCONTENTX ;
D ENCODE^XLFJSON("JSON","RESULTS","ERROR")
Q
;
GETWEBCONTENTID(RESULTS,INPUT) ;
N IEN,INDEX,IDX,SIDX,SIEN,JSON,ERROR,ROOT,X0,SYSTEM
S (INDEX,SYSTEM,IEN)=0
S IEN=$G(INPUT("id")) I IEN=0 Q
I $D(INPUT("system")) S SYSTEM=1
S ROOT="JSON(""contents"","
I SYSTEM D
. S SIEN=0 F S SIEN=$O(^ORW(101.76,SIEN)) Q:'SIEN D
. . I '+$P($G(^ORW(101.76,SIEN,0)),U,3) Q
. . D GETCONTENT(ROOT,SIEN)
I IEN D
. S X0=$G(^ORW(101.76,IEN,0))
. I $O(^ORW(101.76,IEN,1,0)) D GETCONTENT(ROOT,IEN)
. S IDX=0 F S IDX=$O(^ORW(101.76,IEN,2,"B",IDX)) Q:'IDX D
. . S SIDX=$O(^ORW(101.76,IEN,2,"B",IDX,0))
. . S SIEN=$P($G(^ORW(101.76,IEN,2,SIDX,0)),U,2)
. . D GETCONTENT(ROOT,SIEN)
S JSON("success")="true"
GETWEBCONTENTIDX ;
M RESULTS=JSON
Q
;
GETCONTENT(ROOT,IEN) ;
N X0,IDX,TYPEIEN,TYPE,LINE
S X0=$G(^ORW(101.76,IEN,0))
S TYPEIEN=$P(X0,U,2) I '+TYPEIEN Q
S TYPE=$P($G(^ORW(101.77,TYPEIEN,0)),U,2) I TYPE="" Q
S INDEX=INDEX+1,ROOT=ROOT_INDEX_")"
S @ROOT@("name")=$P(X0,U)
S @ROOT@("contentType")=TYPE
I +$P(X0,U,3) S @ROOT@("reservedForSystem")="true"
S IDX=0 F S IDX=$O(^ORW(101.76,IEN,1,IDX)) Q:'IDX D
. S LINE=$G(^ORW(101.76,IEN,1,IDX,0))
. S @ROOT@("data","\",IDX)=$$REMOVECOMMENTS(LINE)
Q
;
N LINE,POS,DONE
S LINE=TEXT
S POS=1,DONE=0 F D Q:DONE
. S DONE=1,POS=$F(LINE,"//",POS) I POS>0 D
.. I $E(LINE,POS-3)=":" S DONE=0
.. E S LINE=$E(LINE,1,POS-3)
Q LINE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWEB 2811 printed May 25, 2026@12:40:26 Page 2
ORWEB ;SLC/JM - HTML DIALOG WEB CONTENT ;Jan 21, 2025@11:23:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 QUIT
GETWEBCONTENT(RESULTS,INPUTJSON) ;
+1 NEW INPUT,NAME,IEN,INDEX,IDX,SIDX,SIEN,JSON,ERROR,ROOT,X0,SYSTEM
+2 SET JSON("success")="false"
SET (INDEX,SYSTEM,IEN)=0
+3 DO DECODE^XLFJSON("INPUTJSON","INPUT","ERROR")
+4 IF $DATA(ERROR)
Begin DoDot:1
+5 SET JSON("error","\",1)="Invalid Input JSON"_$CHAR(13)_$CHAR(10)
+6 SET IDX=0
FOR
SET IDX=$ORDER(ERROR(IDX))
if 'IDX
QUIT
Begin DoDot:2
+7 SET JSON("error","\",IDX+1)=ERROR(IDX)_$CHAR(13)_$CHAR(10)
End DoDot:2
End DoDot:1
GOTO GETWEBCONTENTX
+8 SET NAME=$GET(INPUT("contentName"))
+9 IF $DATA(INPUT("system"))
SET SYSTEM=1
+10 IF NAME=""
IF 'SYSTEM
SET JSON("error")="No content name entered"
GOTO GETWEBCONTENTX
+11 IF NAME'=""
Begin DoDot:1
+12 SET IEN=$ORDER(^ORW(101.76,"B",NAME,0))
IF 'IEN
Begin DoDot:2
+13 SET JSON("error")="Web content '"_NAME_"' not found."
End DoDot:2
GOTO GETWEBCONTENTX
End DoDot:1
+14 SET ROOT="JSON(""contents"","
+15 IF SYSTEM
Begin DoDot:1
+16 SET SIEN=0
FOR
SET SIEN=$ORDER(^ORW(101.76,SIEN))
if 'SIEN
QUIT
Begin DoDot:2
+17 IF '+$PIECE($GET(^ORW(101.76,SIEN,0)),U,3)
QUIT
+18 DO GETCONTENT(ROOT,SIEN)
End DoDot:2
End DoDot:1
+19 IF IEN
Begin DoDot:1
+20 SET X0=$GET(^ORW(101.76,IEN,0))
+21 IF $ORDER(^ORW(101.76,IEN,1,0))
DO GETCONTENT(ROOT,IEN)
+22 SET IDX=0
FOR
SET IDX=$ORDER(^ORW(101.76,IEN,2,"B",IDX))
if 'IDX
QUIT
Begin DoDot:2
+23 SET SIDX=$ORDER(^ORW(101.76,IEN,2,"B",IDX,0))
+24 SET SIEN=$PIECE($GET(^ORW(101.76,IEN,2,SIDX,0)),U,2)
+25 DO GETCONTENT(ROOT,SIEN)
End DoDot:2
End DoDot:1
+26 SET JSON("success")="true"
GETWEBCONTENTX ;
+1 DO ENCODE^XLFJSON("JSON","RESULTS","ERROR")
+2 QUIT
+3 ;
GETWEBCONTENTID(RESULTS,INPUT) ;
+1 NEW IEN,INDEX,IDX,SIDX,SIEN,JSON,ERROR,ROOT,X0,SYSTEM
+2 SET (INDEX,SYSTEM,IEN)=0
+3 SET IEN=$GET(INPUT("id"))
IF IEN=0
QUIT
+4 IF $DATA(INPUT("system"))
SET SYSTEM=1
+5 SET ROOT="JSON(""contents"","
+6 IF SYSTEM
Begin DoDot:1
+7 SET SIEN=0
FOR
SET SIEN=$ORDER(^ORW(101.76,SIEN))
if 'SIEN
QUIT
Begin DoDot:2
+8 IF '+$PIECE($GET(^ORW(101.76,SIEN,0)),U,3)
QUIT
+9 DO GETCONTENT(ROOT,SIEN)
End DoDot:2
End DoDot:1
+10 IF IEN
Begin DoDot:1
+11 SET X0=$GET(^ORW(101.76,IEN,0))
+12 IF $ORDER(^ORW(101.76,IEN,1,0))
DO GETCONTENT(ROOT,IEN)
+13 SET IDX=0
FOR
SET IDX=$ORDER(^ORW(101.76,IEN,2,"B",IDX))
if 'IDX
QUIT
Begin DoDot:2
+14 SET SIDX=$ORDER(^ORW(101.76,IEN,2,"B",IDX,0))
+15 SET SIEN=$PIECE($GET(^ORW(101.76,IEN,2,SIDX,0)),U,2)
+16 DO GETCONTENT(ROOT,SIEN)
End DoDot:2
End DoDot:1
+17 SET JSON("success")="true"
GETWEBCONTENTIDX ;
+1 MERGE RESULTS=JSON
+2 QUIT
+3 ;
GETCONTENT(ROOT,IEN) ;
+1 NEW X0,IDX,TYPEIEN,TYPE,LINE
+2 SET X0=$GET(^ORW(101.76,IEN,0))
+3 SET TYPEIEN=$PIECE(X0,U,2)
IF '+TYPEIEN
QUIT
+4 SET TYPE=$PIECE($GET(^ORW(101.77,TYPEIEN,0)),U,2)
IF TYPE=""
QUIT
+5 SET INDEX=INDEX+1
SET ROOT=ROOT_INDEX_")"
+6 SET @ROOT@("name")=$PIECE(X0,U)
+7 SET @ROOT@("contentType")=TYPE
+8 IF +$PIECE(X0,U,3)
SET @ROOT@("reservedForSystem")="true"
+9 SET IDX=0
FOR
SET IDX=$ORDER(^ORW(101.76,IEN,1,IDX))
if 'IDX
QUIT
Begin DoDot:1
+10 SET LINE=$GET(^ORW(101.76,IEN,1,IDX,0))
+11 SET @ROOT@("data","\",IDX)=$$REMOVECOMMENTS(LINE)
End DoDot:1
+12 QUIT
+13 ;
+1 NEW LINE,POS,DONE
+2 SET LINE=TEXT
+3 SET POS=1
SET DONE=0
FOR
Begin DoDot:1
+4 SET DONE=1
SET POS=$FIND(LINE,"//",POS)
IF POS>0
Begin DoDot:2
+5 IF $EXTRACT(LINE,POS-3)=":"
SET DONE=0
+6 IF '$TEST
SET LINE=$EXTRACT(LINE,1,POS-3)
End DoDot:2
End DoDot:1
if DONE
QUIT
+7 QUIT LINE
+8 ;
