BGOEDTPR ; IHS/BAO/TMD - EDUCATION TOPIC PREFERENCES MANAGER ;03-Sep-2008 13:28;PLS
;;1.1;BGO COMPONENTS;**1,3,4,5**;Mar 20, 2007
; Patch 5 delivers logic to import education pick-lists.
; Validates an education topic
VALIDATE(RET,IEN,CODE) ;EP
I 'IEN,$G(CODE)'="" D
.N X
.S IEN=-1
.F X=0:0 S X=$O(^AUTTEDT("C",CODE,X)) Q:'X S IEN=X Q:'$P($G(^AUTTEDT(IEN,0)),U,3)
I 'IEN S RET=$$ERR^BGOUTL(1023)
E I '$D(^AUTTEDT(IEN,0)) S RET=$$ERR^BGOUTL(1024)
E I $P(^AUTTEDT(IEN,0),U,3) S RET=$$ERR^BGOUTL(1025)
E S RET=""
Q
; Return long name for an education topic
GETLNAME(RET,IEN) ;EP
I 'IEN S RET=$$ERR^BGOUTL(1023)
E S RET=$P($G(^AUTTEDT(+IEN,0)),U)
Q
; Return categories matching specified criteria
; INP = Category IEN [1] ^ Hospital Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5]
GETCATS(RET,INP) ;EP
D GETCATS^BGOPFUTL(.RET,INP,90362.36)
Q
; Returns list of education topics for specified category
; INP = Category IEN [1] ^ Group [2] ^ Visit IEN [3] ^ Display Freq Order [4]
; Returns a list of records in the format:
; Topic IEN [1] ^ Topic Text [2] ^ Freq [3] ^ VPED IEN [4] ^ Rank [5] ^ Item IEN [6] ^ Mnemonic [7]
GETITEMS(RET,INP) ;EP
N DX,J,TXT,FREQ,VIEN,GRP,CAT,CNT,VPX,FREQ,RANK,IEN
S RET=$$TMPGBL^BGOUTL
S CAT=+INP
I 'CAT S @RET@(1)=$$ERR^BGOUTL(1018) Q
I '$D(^BGOEDTPR(CAT,0)) S @RET@(1)=$$ERR^BGOUTL(1019) Q
S GRP=$P(INP,U,2)
S VIEN=$P(INP,U,3)
S FREQ=$P(INP,U,4)
S:$P(^BGOEDTPR(CAT,0),U,6) GRP=""
I VIEN D
.S VPX=0
.F S VPX=$O(^AUPNVPED("AD",VIEN,VPX)) Q:'VPX D
.S:$D(^AUPNVPED(VPX,0)) VPX(+^(0))=VPX
S (CNT,RANK)=0
I FREQ D
.S J=""
.F S J=$O(^BGOEDTPR(CAT,1,"AC",J),-1) Q:J="" D
..S IEN=0
..F S IEN=$O(^BGOEDTPR(CAT,1,"AC",J,IEN)) Q:'IEN D GE1
E D
.S IEN=0
.F S IEN=$O(^BGOEDTPR(CAT,1,IEN)) Q:'IEN D GE1
Q
GE1 N N0,EDT,TXT,CATP,FREQVAL,MNEM
S N0=$G(^BGOEDTPR(CAT,1,IEN,0))
S EDT=+N0
Q:'EDT
Q:'$D(^AUTTEDT(EDT,0))
S TXT=$P(^AUTTEDT(EDT,0),U),MNEM=$P(^(0),U,2),CATP=$P(^(0),U,6)
I $P(TXT,"-",2)'="",CATP'="" D
.S CATP=$O(^AUTTEDMT("B",CATP,0))
.Q:'CATP
.S TXT=$P($G(^AUTTEDMT(CATP,0)),U)_"-"_$P(TXT,"-",2)
S:$P(N0,U,2)'="" TXT=$P(N0,U,2)
I FREQ D
.S RANK=RANK+1
.S RANK=$S(RANK<10:"00",RANK<100:"0",1:"")_RANK
S FREQVAL=$P(N0,U,3)
S CNT=CNT+1
S @RET@(CNT)=EDT_U_TXT_U_FREQVAL_U_$G(VPX(EDT))_U_RANK_U_IEN_U_MNEM
Q
; Return list of managers associated with a specified category
GETMGRS(RET,CAT) ;EP
D GETMGRS^BGOPFUTL(.RET,CAT,90362.36)
Q
; Set category fields
; INP = Name [1] ^ Hosp Loc [2] ^ Clinic [3] ^ Provider [4] ^ User [5] ^ Category IEN [6] ^ Delete [7] ^ Discipline [8]
SETCAT(RET,INP) ;EP
D SETCAT^BGOPFUTL(.RET,INP,90362.36)
Q
; Set field values for an education topic preference entry
; INP = Category IEN [1] ^ Education Topic IEN [2] ^ Display Text [3] ^ Delete [4] ^ Mnemonic [5] ^ Frequency [6] ^
; Allow Dups [7] ^ Item IEN [8]
SETITEM(RET,INP) ;EP
;Patch 5 start
N NAME,ACTIVE,IEN,ACTIVE,DONE,NCAT,NMN,NAME1
S DONE=0,NCAT=""
S NAME=$P(INP,U,3)
I NAME'="" D
.S NAME1=$P(NAME,"-",1)
.S NCAT=$O(^AUTTEDMT("B",NAME1,NCAT)) Q:NCAT="" D
..S NMN=$P($G(^AUTTEDMT(NCAT,0)),U,2)
..I NAME1'=NMN S NAME=NMN_"-"_$P(NAME,"-",2)
.I NAME'="" D
..S IEN="" F S IEN=$O(^AUTTEDT("B",NAME,IEN)) Q:IEN=""!(DONE=1) D
...S ACTIVE=$P($G(^AUTTEDT(IEN,0)),U,3)
...I ACTIVE="" S DONE=1 S $P(INP,U,2)=IEN
;Patch 5 end
D SETITEM^BGOPFUTL(.RET,INP,90362.36)
Q
; Add or remove a manager from a category
; INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]
SETMGR(RET,INP) ;EP
D SETMGR^BGOPFUTL(.RET,INP,90362.362)
Q
; Set display name for a preference
; INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]
SETNAME(RET,INP) ;EP
D SETNAME^BGOPFUTL(.RET,INP,90362.361)
Q
; Set frequency for an education topic
; INP = Category IEN [1] ^ Item Value [2] ^ Increment [3] ^ Frequency [4]
SETFREQ(RET,INP) ;EP
D SETFREQ^BGOPFUTL(.RET,INP,90362.361)
Q
BGOEDTPR ; IHS/BAO/TMD - EDUCATION TOPIC PREFERENCES MANAGER ;03-Sep-2008 13:28;PLS
+1 ;;1.1;BGO COMPONENTS;**1,3,4,5**;Mar 20, 2007
+2 ; Patch 5 delivers logic to import education pick-lists.
+3 ; Validates an education topic
VALIDATE(RET,IEN,CODE) ;EP
+1 IF 'IEN
IF $GET(CODE)'=""
Begin DoDot:1
+2 NEW X
+3 SET IEN=-1
+4 FOR X=0:0
SET X=$ORDER(^AUTTEDT("C",CODE,X))
IF 'X
QUIT
SET IEN=X
IF '$PIECE($GET(^AUTTEDT(IEN,0)),U,3)
QUIT
End DoDot:1
+5 IF 'IEN
SET RET=$$ERR^BGOUTL(1023)
+6 IF '$TEST
IF '$DATA(^AUTTEDT(IEN,0))
SET RET=$$ERR^BGOUTL(1024)
+7 IF '$TEST
IF $PIECE(^AUTTEDT(IEN,0),U,3)
SET RET=$$ERR^BGOUTL(1025)
+8 IF '$TEST
SET RET=""
+9 QUIT
+10 ; Return long name for an education topic
GETLNAME(RET,IEN) ;EP
+1 IF 'IEN
SET RET=$$ERR^BGOUTL(1023)
+2 IF '$TEST
SET RET=$PIECE($GET(^AUTTEDT(+IEN,0)),U)
+3 QUIT
+4 ; Return categories matching specified criteria
+5 ; INP = Category IEN [1] ^ Hospital Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5]
GETCATS(RET,INP) ;EP
+1 DO GETCATS^BGOPFUTL(.RET,INP,90362.36)
+2 QUIT
+3 ; Returns list of education topics for specified category
+4 ; INP = Category IEN [1] ^ Group [2] ^ Visit IEN [3] ^ Display Freq Order [4]
+5 ; Returns a list of records in the format:
+6 ; Topic IEN [1] ^ Topic Text [2] ^ Freq [3] ^ VPED IEN [4] ^ Rank [5] ^ Item IEN [6] ^ Mnemonic [7]
GETITEMS(RET,INP) ;EP
+1 NEW DX,J,TXT,FREQ,VIEN,GRP,CAT,CNT,VPX,FREQ,RANK,IEN
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET CAT=+INP
+4 IF 'CAT
SET @RET@(1)=$$ERR^BGOUTL(1018)
QUIT
+5 IF '$DATA(^BGOEDTPR(CAT,0))
SET @RET@(1)=$$ERR^BGOUTL(1019)
QUIT
+6 SET GRP=$PIECE(INP,U,2)
+7 SET VIEN=$PIECE(INP,U,3)
+8 SET FREQ=$PIECE(INP,U,4)
+9 IF $PIECE(^BGOEDTPR(CAT,0),U,6)
SET GRP=""
+10 IF VIEN
Begin DoDot:1
+11 SET VPX=0
+12 FOR
SET VPX=$ORDER(^AUPNVPED("AD",VIEN,VPX))
IF 'VPX
QUIT
Begin DoDot:2
End DoDot:2
+13 IF $DATA(^AUPNVPED(VPX,0))
SET VPX(+^(0))=VPX
End DoDot:1
+14 SET (CNT,RANK)=0
+15 IF FREQ
Begin DoDot:1
+16 SET J=""
+17 FOR
SET J=$ORDER(^BGOEDTPR(CAT,1,"AC",J),-1)
IF J=""
QUIT
Begin DoDot:2
+18 SET IEN=0
+19 FOR
SET IEN=$ORDER(^BGOEDTPR(CAT,1,"AC",J,IEN))
IF 'IEN
QUIT
DO GE1
End DoDot:2
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET IEN=0
+22 FOR
SET IEN=$ORDER(^BGOEDTPR(CAT,1,IEN))
IF 'IEN
QUIT
DO GE1
End DoDot:1
+23 QUIT
GE1 NEW N0,EDT,TXT,CATP,FREQVAL,MNEM
+1 SET N0=$GET(^BGOEDTPR(CAT,1,IEN,0))
+2 SET EDT=+N0
+3 IF 'EDT
QUIT
+4 IF '$DATA(^AUTTEDT(EDT,0))
QUIT
+5 SET TXT=$PIECE(^AUTTEDT(EDT,0),U)
SET MNEM=$PIECE(^(0),U,2)
SET CATP=$PIECE(^(0),U,6)
+6 IF $PIECE(TXT,"-",2)'=""
IF CATP'=""
Begin DoDot:1
+7 SET CATP=$ORDER(^AUTTEDMT("B",CATP,0))
+8 IF 'CATP
QUIT
+9 SET TXT=$PIECE($GET(^AUTTEDMT(CATP,0)),U)_"-"_$PIECE(TXT,"-",2)
End DoDot:1
+10 IF $PIECE(N0,U,2)'=""
SET TXT=$PIECE(N0,U,2)
+11 IF FREQ
Begin DoDot:1
+12 SET RANK=RANK+1
+13 SET RANK=$SELECT(RANK<10:"00",RANK<100:"0",1:"")_RANK
End DoDot:1
+14 SET FREQVAL=$PIECE(N0,U,3)
+15 SET CNT=CNT+1
+16 SET @RET@(CNT)=EDT_U_TXT_U_FREQVAL_U_$GET(VPX(EDT))_U_RANK_U_IEN_U_MNEM
+17 QUIT
+18 ; Return list of managers associated with a specified category
GETMGRS(RET,CAT) ;EP
+1 DO GETMGRS^BGOPFUTL(.RET,CAT,90362.36)
+2 QUIT
+3 ; Set category fields
+4 ; INP = Name [1] ^ Hosp Loc [2] ^ Clinic [3] ^ Provider [4] ^ User [5] ^ Category IEN [6] ^ Delete [7] ^ Discipline [8]
SETCAT(RET,INP) ;EP
+1 DO SETCAT^BGOPFUTL(.RET,INP,90362.36)
+2 QUIT
+3 ; Set field values for an education topic preference entry
+4 ; INP = Category IEN [1] ^ Education Topic IEN [2] ^ Display Text [3] ^ Delete [4] ^ Mnemonic [5] ^ Frequency [6] ^
+5 ; Allow Dups [7] ^ Item IEN [8]
SETITEM(RET,INP) ;EP
+1 ;Patch 5 start
+2 NEW NAME,ACTIVE,IEN,ACTIVE,DONE,NCAT,NMN,NAME1
+3 SET DONE=0
SET NCAT=""
+4 SET NAME=$PIECE(INP,U,3)
+5 IF NAME'=""
Begin DoDot:1
+6 SET NAME1=$PIECE(NAME,"-",1)
+7 SET NCAT=$ORDER(^AUTTEDMT("B",NAME1,NCAT))
IF NCAT=""
QUIT
Begin DoDot:2
+8 SET NMN=$PIECE($GET(^AUTTEDMT(NCAT,0)),U,2)
+9 IF NAME1'=NMN
SET NAME=NMN_"-"_$PIECE(NAME,"-",2)
End DoDot:2
+10 IF NAME'=""
Begin DoDot:2
+11 SET IEN=""
FOR
SET IEN=$ORDER(^AUTTEDT("B",NAME,IEN))
IF IEN=""!(DONE=1)
QUIT
Begin DoDot:3
+12 SET ACTIVE=$PIECE($GET(^AUTTEDT(IEN,0)),U,3)
+13 IF ACTIVE=""
SET DONE=1
SET $PIECE(INP,U,2)=IEN
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;Patch 5 end
+15 DO SETITEM^BGOPFUTL(.RET,INP,90362.36)
+16 QUIT
+17 ; Add or remove a manager from a category
+18 ; INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]
SETMGR(RET,INP) ;EP
+1 DO SETMGR^BGOPFUTL(.RET,INP,90362.362)
+2 QUIT
+3 ; Set display name for a preference
+4 ; INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]
SETNAME(RET,INP) ;EP
+1 DO SETNAME^BGOPFUTL(.RET,INP,90362.361)
+2 QUIT
+3 ; Set frequency for an education topic
+4 ; INP = Category IEN [1] ^ Item Value [2] ^ Increment [3] ^ Frequency [4]
SETFREQ(RET,INP) ;EP
+1 DO SETFREQ^BGOPFUTL(.RET,INP,90362.361)
+2 QUIT
