BGOWEB.m

BGOWEB ; IHS/BAO/TMD - Browser Util ;27-May-2008 11:02;PLS

 ;;1.1;BGO COMPONENTS;**1,3,5**;Mar 20, 2007

 ;---------------------------------------------

 ; Returns Web Reference Sites

 ;  RET as a list of records in the format:

 ;    Site [1] ^ File IEN [2] ^ URL [3]

GETSITES(RET,DUMMY) ;EP

 N X,Y,CNT,IEN,URL,SITE

 S (X,CNT)=0

 F  S X=$O(^BGOWEBS("AC",X)) Q:'X  D

 .S IEN=0

 .F  S IEN=$O(^BGOWEBS("AC",X,IEN)) Q:'IEN  D

 ..S Y=^BGOWEBS(IEN,0)

 ..Q:$P(Y,U,4)

 ..S SITE=$P(Y,U),URL=$P(Y,U,2)

 ..D ADD(SITE_U_IEN_U_URL)

 Q

 ; Returns Web Links

 ;  INP = User IEN ^ Category IEN

 ;  RET returned as a list of web links

GETREF(RET,INP) ;EP

 D GETLINKS(.RET,INP,"B")

 Q

 ; Returns Web Link categories

 ;  USR = User IEN

 ;  RET returned as a list of categories

GETCATS(RET,USR) ;EP

 D GETLINKS(.RET,+USR,"C")

 Q

 ; Return list of entries from WEB LINKS file

GETLINKS(RET,INP,XRF) ;EP

 N X,Y,CNT,IEN,CAT,USR

 S USR=+INP

 S CAT=$P(INP,U,2)

 S X="",CNT=0

 F  S X=$O(^BGOLINKS(XRF,X)) Q:X=""  D

 .S IEN=$O(^BGOLINKS(XRF,X,0))

 .Q:'IEN

 .S Y=^BGOLINKS(IEN,0)

 .I $P(Y,U,3),$P(Y,U,3)'=USR Q

 .I CAT'="",$P(Y,U,2)'="",$P(Y,U,2)'=CAT Q

 .D ADD(X)

 Q

 ; Returns web ref links

 ;  INP = Type [1] ^ Value [2] ^ Category [3] ^ URL [4]

 ;  Returns list of records in the format

 ;   Name [1]^ URL [2] ^ Link IEN [3] ^ Value [4] ^ Type [5]

GET(RET,INP) ;EP

 N TYP,VAL,XREF,URL,NAM,CNT,X,Y

 S TYP=+INP

 S VAL=$P(INP,U,2)

 S CAT=$P(INP,U,3)

 S URL=$P(INP,U,4)

 S CNT=0

 I TYP D

 .S TYP=$$TYP2GBL(TYP),X=0

 .Q:TYP=""

 .F  S X=$O(^BGOLINKS("AA",TYP,VAL,X)) Q:'X  D G1

 E  I CAT'="" D

 .S X=0

 .F  S X=$O(^BGOLINKS("C",CAT,X)) Q:'X  D G1

 E  I URL'="" D

 .S X=0

 .F  S X=$O(^BGOLINKS("AU",URL,X)) Q:'X  D G1

 Q

G1 N Y,NAM,CAT,URL

 S Y=$G(^BGOLINKS(X,0))

 I $P(Y,U,3),$P(Y,U,3)'=DUZ Q

 S NAM=$P(Y,U)

 Q:NAM=""

 S CAT=$P(Y,U,2)

 S URL=$P($G(^BGOLINKS(X,1)),U)

 Q:URL=""

 D ADD(NAM_U_URL_U_X_U_VAL_U_TYP)

 Q

 ; Delete a web link

 ;  INP = IEN to delete [1] ^ Reference to delete [2] ^ Link Type [3]

DEL(RET,INP) ;EP

 N REF,DA,DIK,Y,CAC,TYP

 S DA=$P(INP,U),REF=+$P(INP,U,2),TYP=+$P(INP,U,3)

 Q:'DA

 I '$$HASKEY^BEHOUSCX("BGOZ CAC"),$P(^BGOLINKS(DA,0),U,3),DUZ='$P(^(0),U,3) S RET=$$ERR^BGOUTL(1107) Q

 I 'REF S DIK="^BGOLINKS("

 E  D

 .S DA(1)=DA

 .S REF=REF_";"_$$TYP2GBL(TYP)

 .S DA=$O(^BGOLINKS(DA,11,"B",REF,0))

 .S DIK="^BGOLINKS(DA(1),11,"

 S:DA RET=$$DELETE^BGOUTL(DIK,.DA)

 Q

 ; Set web reference

 ; INP = Type [1] ^ Value [2] ^ Name [3] ^ URL [4] ^ User IEN [5] ^ Value 2 [6] ^ Category [7]

SET(RET,INP) ;EP

 N TYP,VAL,X,URL,NAM,I,LNKIEN,XREF,SUB,USR,VAL2,CAT,FDA,IEN,GBL

 S TYP=$$TYP2GBL(+INP),RET=""

 I TYP="" S RET=$$ERR^BGOUTL(1108) Q

 S VAL=+$P(INP,U,2)

 I 'VAL S RET=$$ERR^BGOUTL(1109) Q

 S NAM=$P(INP,U,3)

 S URL=$P(INP,U,4)

 S USR=$P(INP,U,5)

 S VAL2=+$P(INP,U,6)

 S CAT=$P(INP,U,7)

 S LNKIEN=$O(^BGOLINKS("AU",URL,0))

 S FDA=$NA(FDA(90362.21,$S(LNKIEN:LNKIEN,1:"+1")_","))

 S @FDA@(.01)=NAM

 S:CAT @FDA@(.02)="`"_CAT

 S:USR @FDA@(.03)="`"_USR

 S @FDA@(.11)=URL

 S RET=$$UPDATE^BGOUTL(.FDA,"E@",.IEN)

 Q:RET

 S:'LNKIEN LNKIEN=IEN(1)

 I 'VAL2 D S1(VAL) Q

 S GBL=$$CREF^DILF(U_TYP)

 S VAL=$P($G(@GBL@(VAL,0)),U)

 Q:VAL=""

 S VAL2=$P($G(@GBL@(VAL2,0)),U)

 Q:VAL2=""

 F  D  S VAL=$O(@GBL@("BA",VAL)) Q:VAL>VAL2!(VAL="")!RET

 .S X=$O(@GBL@("BA",VAL,0))

 .D:X S1(X)

 Q

 ; Add a pointer to web link

S1(VAL) N FDA

 Q:$O(^BGOLINKS("AA",TYP,VAL,LNKIEN,0))

 S FDA=$NA(FDA(90362.2111,"+1,"_LNKIEN_","))

 S @FDA@(.01)=VAL_";"_TYP

 S RET=$$UPDATE^BGOUTL(.FDA)

 S:-RET=305 RET=""  ; No data error is normal

 Q

 ; Convert type index to global reference

TYP2GBL(X) ;

 Q $P("ICPT(^ICPT(^ICD9(^ICD9(^AUTTEDT(^AUTTEXAM(^AUTTIMM(^AUTTSK(",U,X+1)

 ; Add to output array

ADD(X) S CNT=$G(CNT)+1,RET(CNT)=X

 Q

 ; Returns Default Search URL

DEFSURL(RET,DUMMY) ;

 N UIEN

 S UIEN=$$GET^XPAR("ALL","BGO DEFAULT WEB SEARCH SITE")

 S RET=$S(UIEN:$P($G(^BGOWEBS(UIEN,0)),U,2),1:"")

 Q

BGOWEB    ; IHS/BAO/TMD - Browser Util ;27-May-2008 11:02;PLS

 +1       ;;1.1;BGO COMPONENTS;**1,3,5**;Mar 20, 2007

 +2       ;---------------------------------------------

 +3       ; Returns Web Reference Sites

 +4       ;  RET as a list of records in the format:

 +5       ;    Site [1] ^ File IEN [2] ^ URL [3]

GETSITES(RET,DUMMY) ;EP

 +1        NEW X,Y,CNT,IEN,URL,SITE

 +2        SET (X,CNT)=0

 +3        FOR 

               SET X=$ORDER(^BGOWEBS("AC",X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET IEN=0

 +5                FOR 

                       SET IEN=$ORDER(^BGOWEBS("AC",X,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +6                        SET Y=^BGOWEBS(IEN,0)

 +7                        IF $PIECE(Y,U,4)

                               QUIT 

 +8                        SET SITE=$PIECE(Y,U)

                           SET URL=$PIECE(Y,U,2)

 +9                        DO ADD(SITE_U_IEN_U_URL)

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ; Returns Web Links

 +12      ;  INP = User IEN ^ Category IEN

 +13      ;  RET returned as a list of web links

GETREF(RET,INP) ;EP

 +1        DO GETLINKS(.RET,INP,"B")

 +2        QUIT 

 +3       ; Returns Web Link categories

 +4       ;  USR = User IEN

 +5       ;  RET returned as a list of categories

GETCATS(RET,USR) ;EP

 +1        DO GETLINKS(.RET,+USR,"C")

 +2        QUIT 

 +3       ; Return list of entries from WEB LINKS file

GETLINKS(RET,INP,XRF) ;EP

 +1        NEW X,Y,CNT,IEN,CAT,USR

 +2        SET USR=+INP

 +3        SET CAT=$PIECE(INP,U,2)

 +4        SET X=""

           SET CNT=0

 +5        FOR 

               SET X=$ORDER(^BGOLINKS(XRF,X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +6                SET IEN=$ORDER(^BGOLINKS(XRF,X,0))

 +7                IF 'IEN

                       QUIT 

 +8                SET Y=^BGOLINKS(IEN,0)

 +9                IF $PIECE(Y,U,3)

                       IF $PIECE(Y,U,3)'=USR

                           QUIT 

 +10               IF CAT'=""

                       IF $PIECE(Y,U,2)'=""

                           IF $PIECE(Y,U,2)'=CAT

                               QUIT 

 +11               DO ADD(X)

               End DoDot:1

 +12       QUIT 

 +13      ; Returns web ref links

 +14      ;  INP = Type [1] ^ Value [2] ^ Category [3] ^ URL [4]

 +15      ;  Returns list of records in the format

 +16      ;   Name [1]^ URL [2] ^ Link IEN [3] ^ Value [4] ^ Type [5]

GET(RET,INP) ;EP

 +1        NEW TYP,VAL,XREF,URL,NAM,CNT,X,Y

 +2        SET TYP=+INP

 +3        SET VAL=$PIECE(INP,U,2)

 +4        SET CAT=$PIECE(INP,U,3)

 +5        SET URL=$PIECE(INP,U,4)

 +6        SET CNT=0

 +7        IF TYP

               Begin DoDot:1

 +8                SET TYP=$$TYP2GBL(TYP)

                   SET X=0

 +9                IF TYP=""

                       QUIT 

 +10               FOR 

                       SET X=$ORDER(^BGOLINKS("AA",TYP,VAL,X))

                       IF 'X

                           QUIT 

                       DO G1

               End DoDot:1

 +11      IF '$TEST

               IF CAT'=""

                   Begin DoDot:1

 +12                   SET X=0

 +13                   FOR 

                           SET X=$ORDER(^BGOLINKS("C",CAT,X))

                           IF 'X

                               QUIT 

                           DO G1

                   End DoDot:1

 +14      IF '$TEST

               IF URL'=""

                   Begin DoDot:1

 +15                   SET X=0

 +16                   FOR 

                           SET X=$ORDER(^BGOLINKS("AU",URL,X))

                           IF 'X

                               QUIT 

                           DO G1

                   End DoDot:1

 +17       QUIT 

G1         NEW Y,NAM,CAT,URL

 +1        SET Y=$GET(^BGOLINKS(X,0))

 +2        IF $PIECE(Y,U,3)

               IF $PIECE(Y,U,3)'=DUZ

                   QUIT 

 +3        SET NAM=$PIECE(Y,U)

 +4        IF NAM=""

               QUIT 

 +5        SET CAT=$PIECE(Y,U,2)

 +6        SET URL=$PIECE($GET(^BGOLINKS(X,1)),U)

 +7        IF URL=""

               QUIT 

 +8        DO ADD(NAM_U_URL_U_X_U_VAL_U_TYP)

 +9        QUIT 

 +10      ; Delete a web link

 +11      ;  INP = IEN to delete [1] ^ Reference to delete [2] ^ Link Type [3]

DEL(RET,INP) ;EP

 +1        NEW REF,DA,DIK,Y,CAC,TYP

 +2        SET DA=$PIECE(INP,U)

           SET REF=+$PIECE(INP,U,2)

           SET TYP=+$PIECE(INP,U,3)

 +3        IF 'DA

               QUIT 

 +4        IF '$$HASKEY^BEHOUSCX("BGOZ CAC")

               IF $PIECE(^BGOLINKS(DA,0),U,3)

                   IF DUZ='$PIECE(^(0),U,3)

                       SET RET=$$ERR^BGOUTL(1107)

                       QUIT 

 +5        IF 'REF

               SET DIK="^BGOLINKS("

 +6       IF '$TEST

               Begin DoDot:1

 +7                SET DA(1)=DA

 +8                SET REF=REF_";"_$$TYP2GBL(TYP)

 +9                SET DA=$ORDER(^BGOLINKS(DA,11,"B",REF,0))

 +10               SET DIK="^BGOLINKS(DA(1),11,"

               End DoDot:1

 +11       IF DA

               SET RET=$$DELETE^BGOUTL(DIK,.DA)

 +12       QUIT 

 +13      ; Set web reference

 +14      ; INP = Type [1] ^ Value [2] ^ Name [3] ^ URL [4] ^ User IEN [5] ^ Value 2 [6] ^ Category [7]

SET(RET,INP) ;EP

 +1        NEW TYP,VAL,X,URL,NAM,I,LNKIEN,XREF,SUB,USR,VAL2,CAT,FDA,IEN,GBL

 +2        SET TYP=$$TYP2GBL(+INP)

           SET RET=""

 +3        IF TYP=""

               SET RET=$$ERR^BGOUTL(1108)

               QUIT 

 +4        SET VAL=+$PIECE(INP,U,2)

 +5        IF 'VAL

               SET RET=$$ERR^BGOUTL(1109)

               QUIT 

 +6        SET NAM=$PIECE(INP,U,3)

 +7        SET URL=$PIECE(INP,U,4)

 +8        SET USR=$PIECE(INP,U,5)

 +9        SET VAL2=+$PIECE(INP,U,6)

 +10       SET CAT=$PIECE(INP,U,7)

 +11       SET LNKIEN=$ORDER(^BGOLINKS("AU",URL,0))

 +12       SET FDA=$NAME(FDA(90362.21,$SELECT(LNKIEN:LNKIEN,1:"+1")_","))

 +13       SET @FDA@(.01)=NAM

 +14       IF CAT

               SET @FDA@(.02)="`"_CAT

 +15       IF USR

               SET @FDA@(.03)="`"_USR

 +16       SET @FDA@(.11)=URL

 +17       SET RET=$$UPDATE^BGOUTL(.FDA,"E@",.IEN)

 +18       IF RET

               QUIT 

 +19       IF 'LNKIEN

               SET LNKIEN=IEN(1)

 +20       IF 'VAL2

               DO S1(VAL)

               QUIT 

 +21       SET GBL=$$CREF^DILF(U_TYP)

 +22       SET VAL=$PIECE($GET(@GBL@(VAL,0)),U)

 +23       IF VAL=""

               QUIT 

 +24       SET VAL2=$PIECE($GET(@GBL@(VAL2,0)),U)

 +25       IF VAL2=""

               QUIT 

 +26       FOR 

               Begin DoDot:1

 +27               SET X=$ORDER(@GBL@("BA",VAL,0))

 +28               IF X

                       DO S1(X)

               End DoDot:1

               SET VAL=$ORDER(@GBL@("BA",VAL))

               IF VAL>VAL2!(VAL="")!RET

                   QUIT 

 +29       QUIT 

 +30      ; Add a pointer to web link

S1(VAL)    NEW FDA

 +1        IF $ORDER(^BGOLINKS("AA",TYP,VAL,LNKIEN,0))

               QUIT 

 +2        SET FDA=$NAME(FDA(90362.2111,"+1,"_LNKIEN_","))

 +3        SET @FDA@(.01)=VAL_";"_TYP

 +4        SET RET=$$UPDATE^BGOUTL(.FDA)

 +5       ; No data error is normal

           IF -RET=305

               SET RET=""

 +6        QUIT 

 +7       ; Convert type index to global reference

TYP2GBL(X) ;

 +1        QUIT $PIECE("ICPT(^ICPT(^ICD9(^ICD9(^AUTTEDT(^AUTTEXAM(^AUTTIMM(^AUTTSK(",U,X+1)

 +2       ; Add to output array

ADD(X)     SET CNT=$GET(CNT)+1

           SET RET(CNT)=X

 +1        QUIT 

 +2       ; Returns Default Search URL

DEFSURL(RET,DUMMY) ;

 +1        NEW UIEN

 +2        SET UIEN=$$GET^XPAR("ALL","BGO DEFAULT WEB SEARCH SITE")

 +3        SET RET=$SELECT(UIEN:$PIECE($GET(^BGOWEBS(UIEN,0)),U,2),1:"")

 +4        QUIT