BGOEDTPR.m

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