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
