XPDTA3 ;OAK/BT - Build Component ; Sep 23, 2024@09:58:21
;;8.0;KERNEL;**802**;Jul 10, 1995;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
WEBAPP ;Web Server Application #18.12
N %,%1,%2
;Loop thru WEB SERVICEs
S %1=0 F S %1=$O(^XTMP("XPDT",XPDA,"KRN",18.12,DA,100,%1)) Q:'%1 D
. S %=$G(^(%1,0)),%2=$P(%,U)
. I $G(%2)'="" S $P(%,U)=$P($G(^XOB(18.02,%2,0)),U),^XTMP("XPDT",XPDA,"KRN",18.12,DA,100,%1,0)=%
Q
;
WEBE ;
S ^TMP($J,"XPDI",DA)=$G(XPDFL)
Q
;
WEBE0 ;
N %,%1,%2,%I
S (%1,%I)=0
K ^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,"B")
K ^XOB(18.12,DA,100)
F S %1=$O(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1)) Q:%1'>0 D
. S %=$G(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1,0)),%2=$P(%,U)
. I $G(%2)="" Q
. S %2=$O(^XOB(18.02,"B",%2,0))
. I +%2'>0 Q
. S $P(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1,0),U)=+%2
. S ^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,"B",+%2,%1)=""
. Q
Q
;
WEBE1 ;
Q
;
WEBE2 ;
Q
;
WEBDEL(%XOB) ;del Web Server
D DELIEN^XPDUTL1(18.12,$G(%XOB))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDTA3 1064 printed Sep 23, 2025@19:40:37 Page 2
XPDTA3 ;OAK/BT - Build Component ; Sep 23, 2024@09:58:21
+1 ;;8.0;KERNEL;**802**;Jul 10, 1995;Build 3
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
WEBAPP ;Web Server Application #18.12
+1 NEW %,%1,%2
+2 ;Loop thru WEB SERVICEs
+3 SET %1=0
FOR
SET %1=$ORDER(^XTMP("XPDT",XPDA,"KRN",18.12,DA,100,%1))
if '%1
QUIT
Begin DoDot:1
+4 SET %=$GET(^(%1,0))
SET %2=$PIECE(%,U)
+5 IF $GET(%2)'=""
SET $PIECE(%,U)=$PIECE($GET(^XOB(18.02,%2,0)),U)
SET ^XTMP("XPDT",XPDA,"KRN",18.12,DA,100,%1,0)=%
End DoDot:1
+6 QUIT
+7 ;
WEBE ;
+1 SET ^TMP($JOB,"XPDI",DA)=$GET(XPDFL)
+2 QUIT
+3 ;
WEBE0 ;
+1 NEW %,%1,%2,%I
+2 SET (%1,%I)=0
+3 KILL ^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,"B")
+4 KILL ^XOB(18.12,DA,100)
+5 FOR
SET %1=$ORDER(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1))
if %1'>0
QUIT
Begin DoDot:1
+6 SET %=$GET(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1,0))
SET %2=$PIECE(%,U)
+7 IF $GET(%2)=""
QUIT
+8 SET %2=$ORDER(^XOB(18.02,"B",%2,0))
+9 IF +%2'>0
QUIT
+10 SET $PIECE(^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,%1,0),U)=+%2
+11 SET ^XTMP("XPDI",XPDA,"KRN",18.12,OLDA,100,"B",+%2,%1)=""
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
WEBE1 ;
+1 QUIT
+2 ;
WEBE2 ;
+1 QUIT
+2 ;
WEBDEL(%XOB) ;del Web Server
+1 DO DELIEN^XPDUTL1(18.12,$GET(%XOB))
+2 QUIT
