BGUPSRPC.m

BGUPSRPC ; IHS/OIT/MJL - GENERAL BGU UTILITY ;

 ;;1.5;BGU;;MAY 26, 2005

EN(BGUARRAY,BGUPSRPC,BGUP1,BGUP2,BGUP3,BGUP4,BGUP5,BGUP6,BGUP7,BGUP8,BGUP9,BGUP10,BGUP11) ;PEP FROM REMOTE PROCEDURE BGU PSRPC

ENT ;

 ;K X,Y,BGUDATA N DIQUIET

 ;S BGUSTR=^BGUPSRPC(BGUPSRPC,"ASTR")

 S BGUPSIEN=$O(^BGUPSRPC("B",BGUPSRPC,"")) Q:BGUPSRPC=""  S BGUIEN=$P(^BGUPSRPC(BGUPSIEN,0),U,2),BGUREF=^XWB(8994,BGUIEN,0)

 S BGUTRTN=$P(BGUREF,"^",2,3),BGUTYPE=$P(BGUREF,U,4),BGURTN1=BGUTRTN,BGUTRTN=BGUTRTN_"(.BGUDATA,"_$$GETSTR()_")"

 ;S BGUSTR=BGURTN1_"(.BGUDATA,"_BGUSTR_")"

 D @BGUTRTN

 ; Same line of code used in ^BGUTCPH :

 ;D:$S($P(BGUMSG,"TRACE=",2)'="":1,$D(BGUTRACE):1,$P(^BGUSP(1,0),"^",2)="Y":1,1:$D(^BGUSP(1,1,"B",$J))) ^BGUTRACE

 ;D KILL

 Q

 ;

GETSTR() ;

 S BGUEND=0

 S BGUN=0 F  S BGUN=$O(^BGUPSRPC(BGUPSIEN,1,BGUN)) Q:'BGUN  S BGUX=^BGUPSRPC(BGUPSIEN,1,BGUN,0),BGUVAL=$P(BGUX,U,2) I BGUVAL'="" S BGUPRM=$P(BGUX,U,1),BGUPV(BGUPRM)=BGUVAL S:BGUPRM>BGUEND BGUEND=BGUPRM

 F BGUEND1=1:1 S BGUP="BGUP"_BGUEND1 Q:'$D(@BGUP)  S BGUP=@BGUP S:BGUP'="" BGUPV(BGUEND1)=BGUP

 S:BGUEND1>BGUEND BGUEND=BGUEND1

 S BGUX="" F BGUPRM=1:1:BGUEND S:BGUPRM>1 BGUX=BGUX_"," S BGUX=BGUX_""""_$G(BGUPV(BGUPRM))_""""

 K BGUP,BGUPRM,BGUPV,BGUVAL

 Q BGUX

BGUPSRPC  ; IHS/OIT/MJL - GENERAL BGU UTILITY ;

 +1       ;;1.5;BGU;;MAY 26, 2005

EN(BGUARRAY,BGUPSRPC,BGUP1,BGUP2,BGUP3,BGUP4,BGUP5,BGUP6,BGUP7,BGUP8,BGUP9,BGUP10,BGUP11) ;PEP FROM REMOTE PROCEDURE BGU PSRPC

ENT       ;

 +1       ;K X,Y,BGUDATA N DIQUIET

 +2       ;S BGUSTR=^BGUPSRPC(BGUPSRPC,"ASTR")

 +3        SET BGUPSIEN=$ORDER(^BGUPSRPC("B",BGUPSRPC,""))

           IF BGUPSRPC=""

               QUIT 

           SET BGUIEN=$PIECE(^BGUPSRPC(BGUPSIEN,0),U,2)

           SET BGUREF=^XWB(8994,BGUIEN,0)

 +4        SET BGUTRTN=$PIECE(BGUREF,"^",2,3)

           SET BGUTYPE=$PIECE(BGUREF,U,4)

           SET BGURTN1=BGUTRTN

           SET BGUTRTN=BGUTRTN_"(.BGUDATA,"_$$GETSTR()_")"

 +5       ;S BGUSTR=BGURTN1_"(.BGUDATA,"_BGUSTR_")"

 +6        DO @BGUTRTN

 +7       ; Same line of code used in ^BGUTCPH :

 +8       ;D:$S($P(BGUMSG,"TRACE=",2)'="":1,$D(BGUTRACE):1,$P(^BGUSP(1,0),"^",2)="Y":1,1:$D(^BGUSP(1,1,"B",$J))) ^BGUTRACE

 +9       ;D KILL

 +10       QUIT 

 +11      ;

GETSTR()  ;

 +1        SET BGUEND=0

 +2        SET BGUN=0

           FOR 

               SET BGUN=$ORDER(^BGUPSRPC(BGUPSIEN,1,BGUN))

               IF 'BGUN

                   QUIT 

               SET BGUX=^BGUPSRPC(BGUPSIEN,1,BGUN,0)

               SET BGUVAL=$PIECE(BGUX,U,2)

               IF BGUVAL'=""

                   SET BGUPRM=$PIECE(BGUX,U,1)

                   SET BGUPV(BGUPRM)=BGUVAL

                   IF BGUPRM>BGUEND

                       SET BGUEND=BGUPRM

 +3        FOR BGUEND1=1:1

               SET BGUP="BGUP"_BGUEND1

               IF '$DATA(@BGUP)

                   QUIT 

               SET BGUP=@BGUP

               IF BGUP'=""

                   SET BGUPV(BGUEND1)=BGUP

 +4        IF BGUEND1>BGUEND

               SET BGUEND=BGUEND1

 +5        SET BGUX=""

           FOR BGUPRM=1:1:BGUEND

               IF BGUPRM>1

                   SET BGUX=BGUX_","

               SET BGUX=BGUX_""""_$GET(BGUPV(BGUPRM))_""""

 +6        KILL BGUP,BGUPRM,BGUPV,BGUVAL

 +7        QUIT BGUX