XPDTA3.m

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 ---XPDTA3   1064     printed  Mar 13, 2025@21:09:26                                                                                                                                                                                                      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