BGOSNOPR.m

BGOSNOPR ; IHS/BAO/TMD - SNOMED PREFERENCES MANAGER ;19-Apr-2016 11:50;du

 ;;1.1;BGO COMPONENTS;**13,14,19,20**;Mar 20, 2007;Build 1

 ; 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

 N ARRAY,X,I,DEFAULT

 S RET=$$TMPGBL

 D GETCATS^BGOPFUTL(.ARRAY,INP,90362.34)

 ;Get the default

 S DEFAULT=$$GET^XPAR("ALL","BGO DEFAULT PICKLIST")

 S I=1

 S X=0 F  S X=$O(@ARRAY@(X)) Q:X=""  D

 .I $P($G(@ARRAY@(X)),U,2)=DEFAULT S @RET@(1)=$G(@ARRAY@(X))_U_1 Q

 .E  S I=I+1

 .S @RET@(I)=$G(@ARRAY@(X))

 K ARRAY

 Q

 ; Returns list of SNOMEDS for specified category

 ;  INP = Category IEN [1] ^ Descriptor [2] ^ Display Freq Order [3]

 ;  Returns list of records in the format

 ;  IEN[1] ^ Narrative [2] ^ DESCT CT [3] ^ CONCEPT CT [4] ^ Status [5] ^ Freq [6]

 ;  ^ Rank [7] ^ Pref IEN [8] ^ Qualifier string [9] ^ group [10] ^ Laterality flag [11]

GETITEMS(RET,INP) ;EP

 N PX,I,J,FREQ,VIEN,GRP,CAT,LONG,VPX,FREQ,CNT,RANK,IEN

 S RET=$$TMPGBL^BGOUTL

 S CAT=+INP

 I 'CAT S @RET@(1)=$$ERR^BGOUTL(1018) Q

 I '$D(^BGOSNOPR(CAT,0)) S @RET@(1)=$$ERR^BGOUTL(1019) Q

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

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

 S:$P(^BGOSNOPR(CAT,0),U,6) GRP=""

 S (CNT,RANK)=0

 I FREQ D

 .S J=""

 .F  S J=$O(^BGOSNOPR(CAT,1,"AC",J),-1) Q:J=""  D

 ..S IEN=0

 ..F  S IEN=$O(^BGOSNOPR(CAT,1,"AC",J,IEN)) Q:'IEN  D GD1

 E  D

 .S IEN=0

 .F  S IEN=$O(^BGOSNOPR(CAT,1,IEN)) Q:'IEN  D GD1

 Q

GD1 ;Get fields

 N N0,SNOCT,DESCT,NARR,TXT,DX,FREQVAL,CODE,OPEN,QUAL,QUALCT,QUALT,QSTR

 N STATUS,GROUP,PREF,PREFNAR,ICD,LAT,IN,ICDFLD,I1,CODE,Z1,X

 S QSTR=""

 S N0=$G(^BGOSNOPR(CAT,1,IEN,0))

 S SNOCT=+N0

 Q:'SNOCT

 ;IHS/MSC/MGH Changed to use new API

 ;Patch 20

 K VAR

 ;Patch 20 changes to only do 1 lookup

 S DESCT=$P(N0,U,2)

 S X=$$DSCLKP^BSTSAPI("VAR",DESCT_"^^1")

 S NARR=$G(VAR(1,"PRB","TRM"))

 S PREFNAR=$G(VAR(1,"PRE","TRM"))

 S ICD="",I1=0

 F  S I1=$O(VAR(1,"ICD",I1)) Q:'+I1  D

 .S ICD=ICD_$S(ICD]"":"|",1:"")_$G(VAR(1,"ICD",I1,"COD"))

 S STATUS=$P(N0,U,6)

 S TXT=$P($G(^BGOSNOPR(CAT,1,IEN,1)),U,1)

 S FREQVAL=$P(N0,U,3)

 S GROUP=$P($G(^BGOSNOPR(CAT,1,IEN,1)),U,2)

 ;IHS/MSC/MGH add laterality flag to list

 S IN=DESCT_U_"EHR IPL PROMPT FOR LATERALITY"_U_U_1

 ;S LAT=$$VSBTRMF^BSTSAPI(IN)

 S LAT=$G(VAR(1,"LAT"))

 I FREQ D

 .S RANK=RANK+1

 .S RANK=$S(RANK<10:"00",RANK<100:"0",1:"")_RANK

 S QUAL=0 F  S QUAL=$O(^BGOSNOPR(CAT,1,IEN,2,QUAL)) Q:QUAL=""  D

 .S QUALCT=$P($G(^BGOSNOPR(CAT,1,IEN,2,QUAL,0)),U,1),QUALT=$P($G(^BGOSNOPR(CAT,1,IEN,2,QUAL,0)),U,2)

 .S QSTR=$S(QSTR="":QUALCT_"|"_QUALT,1:QSTR_"~"_QUALCT_"|"_QUALT)

 S CNT=CNT+1

 S @RET@(CNT)=IEN_U_NARR_U_DESCT_U_SNOCT_U_STATUS_U_FREQVAL_U_TXT_U_RANK_U_QSTR_U_GROUP_U_PREFNAR_U_ICD_U_LAT

 Q

 ; Return list of managers associated with a specified category

GETMGRS(RET,CAT) ;EP

 D GETMGRS^BGOPFUTL(.RET,CAT,90362.34)

 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.34)

 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.343)

 Q

 ; Set Provider Text for a preference

 ;  INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]

 ;  SFN = Item subfile #

SETNAME(RET,INP,FIELD) ;EP

 N ITM,CAT,NAME,FDA

 S SFN=90362.342

 S CAT=+INP

 I 'CAT S RET=$$ERR^BGOUTL(1018) Q

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

 I 'ITM S RET=$$ERR^BGOUTL(1033) Q

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

 I NAME="" S RET=$$ERR^BGOUTL(1034) Q

 S FDA(SFN,ITM_","_CAT_",",FIELD)=NAME

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

 Q

 ; Set frequency for an item

 ;  INP = Category IEN [1] ^ SNOMED CT [2] ^ Increment [3] ^ Frequency [4]

SETFREQ(RET,INP) ;EP

 D SETFREQ^BGOPFUTL(.RET,INP,90362.342) ;EP

 Q

 ; Set field values for a SNOMED preference entry

 ;  INP = Category IEN [1] ^ SNOMED CT [2] ^ DESC CT [3] ^ Status [4] ^ Frequency [5] ^

 ;        Group [6] ^ Item IEN [7] ^ Delete [8]

SETITEM(RET,INP) ;EP

 N CAT,SNO,DESCT,DEL,NEW,IEN,FREQ,DUP,ITEM,FDA,GBL,FNUM,X,Y,GRP,PREF

 S RET=""

 S CAT=+INP

 S FNUM=90362.34

 S NEW=""

 I 'CAT S RET=$$ERR^BGOUTL(1018) Q

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

 I SNO="" S RET="-1^No Concept CT sent in call"

 ;IHS/MSC/MGH changed to use new API

 ;S X=$$CONC^BSTSAPI(SNO_"^^^1")

 S X=$$CONC^AUPNSICD(SNO_"^^^1")

 S PREF=$P(X,U,3)

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

 I DESCT="" S DESCT=PREF

 S Y=$$DESC^BSTSAPI(DESCT_"^^1")

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

 I DESCT="" S RET="-1^Snomed not valid"

 I TXT="" S RET="-1^Snomed not valid"

 Q:RET=-1

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

 ;MSC/MGH Patch 20

 I STAT="" S STAT=$P(X,U,9)

 S STAT=$S(STAT="Chronic":"A",STAT="Inactive":"I",STAT="Sub-acute":"S",STAT="Episodic":"E",STAT="Social/Environmental":"O",STAT="Routine/Admin":"R",STAT="Admin":"R",STAT="Personal History":"P",1:STAT)

 S FREQ=+$P(INP,U,5)

 S GRP=$P(INP,U,6)

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

 I '+ITEM S NEW=1           ;P19

 S DEL=$P(INP,U,8)

 I DEL D

 .N DA,SFN

 .S RET=$$GBLROOT^BGOPFUTL(FNUM,,.SFN)

 .S:'RET RET=$$ITEMROOT^BGOPFUTL(SFN,CAT,.GBL,1)

 .Q:RET

 .S DA(1)=CAT,DA=ITEM

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

 E  D

 .S RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL)

 .;D:RET'<0 @("VALIDATE"_GBL_"(.RET,.PTR,CODE)")

 .S:RET'<0 RET=$$UPDITEM(FNUM,CAT,SNO,DESCT,STAT,FREQ,TXT,NEW,GRP,.IEN,ITEM,PREF)

 .S:RET'<0 RET=IEN

 Q

 ; Update a category's item entry

 ;  FNUM = Preference file #

 ;  CAT  = Category IEN

 ;  SNO  = Snomed CT

 ;  DESCT= Desc CT

 ;  STAT = Status

 ;  CNT  = Item count (or "+n" to increment existing count) (optional)

 ;  TXT  = Text of DESC CT (optional)

 ;  NEW  = If true, force creation of new entry (optional, default=false)

 ;  GRP  = Group for this item

 ; .ITM  = Returned value of item IEN

 ;  Return value is 0 if success, or -1^error text

UPDITEM(FNUM,CAT,SNO,DESCT,STAT,CNT,TXT,NEW,GRP,ITM,ITEM,PREF) ;EP

 N FDA,IEN,GBL,SFN,RET

 S RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)

 Q:RET RET

 ;S ITM=$S($G(NEW):0,1:$O(@GBL@(CAT,1,"B",SNO,0)))

 S ITM=$S($G(NEW):0,$G(ITEM):ITEM,1:$O(@GBL@(CAT,1,"B",SNO,0)))

 S:$E($G(CNT))="+" CNT=$S(ITM:$P(@GBL@(CAT,1,ITM,0),U,3),1:0)+CNT

 S FDA=$NA(FDA(SFN,$S(ITM:ITM,1:"+1")_","_CAT_","))

 S @FDA@(.01)=SNO

 S @FDA@(.02)=DESCT

 S:$D(CNT) @FDA@(.03)=CNT

 S @FDA@(.06)=STAT

 S @FDA@(.04)=$$NOW^XLFDT

 S @FDA@(.07)=PREF

 S:$D(TXT) @FDA@(6)=$TR(TXT,";",",")

 S:$D(GRP) @FDA@(7)=GRP

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

 I 'RET,'ITM S ITM=IEN(1)

 Q RET

TMPGBL(X) ;EP

 K ^TMP("BGOPICK",$J) Q $NA(^($J))

BGOSNOPR  ; IHS/BAO/TMD - SNOMED PREFERENCES MANAGER ;19-Apr-2016 11:50;du

 +1       ;;1.1;BGO COMPONENTS;**13,14,19,20**;Mar 20, 2007;Build 1

 +2       ; Return categories matching specified criteria

 +3       ;  INP = Category IEN [1] ^ Hospital Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5]

GETCATS(RET,INP) ;EP

 +1        NEW ARRAY,X,I,DEFAULT

 +2        SET RET=$$TMPGBL

 +3        DO GETCATS^BGOPFUTL(.ARRAY,INP,90362.34)

 +4       ;Get the default

 +5        SET DEFAULT=$$GET^XPAR("ALL","BGO DEFAULT PICKLIST")

 +6        SET I=1

 +7        SET X=0

           FOR 

               SET X=$ORDER(@ARRAY@(X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +8                IF $PIECE($GET(@ARRAY@(X)),U,2)=DEFAULT

                       SET @RET@(1)=$GET(@ARRAY@(X))_U_1

                       QUIT 

 +9               IF '$TEST

                       SET I=I+1

 +10               SET @RET@(I)=$GET(@ARRAY@(X))

               End DoDot:1

 +11       KILL ARRAY

 +12       QUIT 

 +13      ; Returns list of SNOMEDS for specified category

 +14      ;  INP = Category IEN [1] ^ Descriptor [2] ^ Display Freq Order [3]

 +15      ;  Returns list of records in the format

 +16      ;  IEN[1] ^ Narrative [2] ^ DESCT CT [3] ^ CONCEPT CT [4] ^ Status [5] ^ Freq [6]

 +17      ;  ^ Rank [7] ^ Pref IEN [8] ^ Qualifier string [9] ^ group [10] ^ Laterality flag [11]

GETITEMS(RET,INP) ;EP

 +1        NEW PX,I,J,FREQ,VIEN,GRP,CAT,LONG,VPX,FREQ,CNT,RANK,IEN

 +2        SET RET=$$TMPGBL^BGOUTL

 +3        SET CAT=+INP

 +4        IF 'CAT

               SET @RET@(1)=$$ERR^BGOUTL(1018)

               QUIT 

 +5        IF '$DATA(^BGOSNOPR(CAT,0))

               SET @RET@(1)=$$ERR^BGOUTL(1019)

               QUIT 

 +6        SET GRP=$PIECE(INP,U,2)

 +7        SET FREQ=$PIECE(INP,U,3)

 +8        IF $PIECE(^BGOSNOPR(CAT,0),U,6)

               SET GRP=""

 +9        SET (CNT,RANK)=0

 +10       IF FREQ

               Begin DoDot:1

 +11               SET J=""

 +12               FOR 

                       SET J=$ORDER(^BGOSNOPR(CAT,1,"AC",J),-1)

                       IF J=""

                           QUIT 

                       Begin DoDot:2

 +13                       SET IEN=0

 +14                       FOR 

                               SET IEN=$ORDER(^BGOSNOPR(CAT,1,"AC",J,IEN))

                               IF 'IEN

                                   QUIT 

                               DO GD1

                       End DoDot:2

               End DoDot:1

 +15      IF '$TEST

               Begin DoDot:1

 +16               SET IEN=0

 +17               FOR 

                       SET IEN=$ORDER(^BGOSNOPR(CAT,1,IEN))

                       IF 'IEN

                           QUIT 

                       DO GD1

               End DoDot:1

 +18       QUIT 

GD1       ;Get fields

 +1        NEW N0,SNOCT,DESCT,NARR,TXT,DX,FREQVAL,CODE,OPEN,QUAL,QUALCT,QUALT,QSTR

 +2        NEW STATUS,GROUP,PREF,PREFNAR,ICD,LAT,IN,ICDFLD,I1,CODE,Z1,X

 +3        SET QSTR=""

 +4        SET N0=$GET(^BGOSNOPR(CAT,1,IEN,0))

 +5        SET SNOCT=+N0

 +6        IF 'SNOCT

               QUIT 

 +7       ;IHS/MSC/MGH Changed to use new API

 +8       ;Patch 20

 +9        KILL VAR

 +10      ;Patch 20 changes to only do 1 lookup

 +11       SET DESCT=$PIECE(N0,U,2)

 +12       SET X=$$DSCLKP^BSTSAPI("VAR",DESCT_"^^1")

 +13       SET NARR=$GET(VAR(1,"PRB","TRM"))

 +14       SET PREFNAR=$GET(VAR(1,"PRE","TRM"))

 +15       SET ICD=""

           SET I1=0

 +16       FOR 

               SET I1=$ORDER(VAR(1,"ICD",I1))

               IF '+I1

                   QUIT 

               Begin DoDot:1

 +17               SET ICD=ICD_$SELECT(ICD]"":"|",1:"")_$GET(VAR(1,"ICD",I1,"COD"))

               End DoDot:1

 +18       SET STATUS=$PIECE(N0,U,6)

 +19       SET TXT=$PIECE($GET(^BGOSNOPR(CAT,1,IEN,1)),U,1)

 +20       SET FREQVAL=$PIECE(N0,U,3)

 +21       SET GROUP=$PIECE($GET(^BGOSNOPR(CAT,1,IEN,1)),U,2)

 +22      ;IHS/MSC/MGH add laterality flag to list

 +23       SET IN=DESCT_U_"EHR IPL PROMPT FOR LATERALITY"_U_U_1

 +24      ;S LAT=$$VSBTRMF^BSTSAPI(IN)

 +25       SET LAT=$GET(VAR(1,"LAT"))

 +26       IF FREQ

               Begin DoDot:1

 +27               SET RANK=RANK+1

 +28               SET RANK=$SELECT(RANK<10:"00",RANK<100:"0",1:"")_RANK

               End DoDot:1

 +29       SET QUAL=0

           FOR 

               SET QUAL=$ORDER(^BGOSNOPR(CAT,1,IEN,2,QUAL))

               IF QUAL=""

                   QUIT 

               Begin DoDot:1

 +30               SET QUALCT=$PIECE($GET(^BGOSNOPR(CAT,1,IEN,2,QUAL,0)),U,1)

                   SET QUALT=$PIECE($GET(^BGOSNOPR(CAT,1,IEN,2,QUAL,0)),U,2)

 +31               SET QSTR=$SELECT(QSTR="":QUALCT_"|"_QUALT,1:QSTR_"~"_QUALCT_"|"_QUALT)

               End DoDot:1

 +32       SET CNT=CNT+1

 +33       SET @RET@(CNT)=IEN_U_NARR_U_DESCT_U_SNOCT_U_STATUS_U_FREQVAL_U_TXT_U_RANK_U_QSTR_U_GROUP_U_PREFNAR_U_ICD_U_LAT

 +34       QUIT 

 +35      ; Return list of managers associated with a specified category

GETMGRS(RET,CAT) ;EP

 +1        DO GETMGRS^BGOPFUTL(.RET,CAT,90362.34)

 +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.34)

 +2        QUIT 

 +3       ; Add or remove a manager from a category

 +4       ;  INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]

SETMGR(RET,INP) ;EP

 +1        DO SETMGR^BGOPFUTL(.RET,INP,90362.343)

 +2        QUIT 

 +3       ; Set Provider Text for a preference

 +4       ;  INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]

 +5       ;  SFN = Item subfile #

SETNAME(RET,INP,FIELD) ;EP

 +1        NEW ITM,CAT,NAME,FDA

 +2        SET SFN=90362.342

 +3        SET CAT=+INP

 +4        IF 'CAT

               SET RET=$$ERR^BGOUTL(1018)

               QUIT 

 +5        SET ITM=$PIECE(INP,U,2)

 +6        IF 'ITM

               SET RET=$$ERR^BGOUTL(1033)

               QUIT 

 +7        SET NAME=$PIECE(INP,U,3)

 +8        IF NAME=""

               SET RET=$$ERR^BGOUTL(1034)

               QUIT 

 +9        SET FDA(SFN,ITM_","_CAT_",",FIELD)=NAME

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

 +11       QUIT 

 +12      ; Set frequency for an item

 +13      ;  INP = Category IEN [1] ^ SNOMED CT [2] ^ Increment [3] ^ Frequency [4]

SETFREQ(RET,INP) ;EP

 +1       ;EP

           DO SETFREQ^BGOPFUTL(.RET,INP,90362.342)

 +2        QUIT 

 +3       ; Set field values for a SNOMED preference entry

 +4       ;  INP = Category IEN [1] ^ SNOMED CT [2] ^ DESC CT [3] ^ Status [4] ^ Frequency [5] ^

 +5       ;        Group [6] ^ Item IEN [7] ^ Delete [8]

SETITEM(RET,INP) ;EP

 +1        NEW CAT,SNO,DESCT,DEL,NEW,IEN,FREQ,DUP,ITEM,FDA,GBL,FNUM,X,Y,GRP,PREF

 +2        SET RET=""

 +3        SET CAT=+INP

 +4        SET FNUM=90362.34

 +5        SET NEW=""

 +6        IF 'CAT

               SET RET=$$ERR^BGOUTL(1018)

               QUIT 

 +7        SET SNO=$PIECE(INP,U,2)

 +8        IF SNO=""

               SET RET="-1^No Concept CT sent in call"

 +9       ;IHS/MSC/MGH changed to use new API

 +10      ;S X=$$CONC^BSTSAPI(SNO_"^^^1")

 +11       SET X=$$CONC^AUPNSICD(SNO_"^^^1")

 +12       SET PREF=$PIECE(X,U,3)

 +13       SET DESCT=$PIECE(INP,U,3)

 +14       IF DESCT=""

               SET DESCT=PREF

 +15       SET Y=$$DESC^BSTSAPI(DESCT_"^^1")

 +16       SET TXT=$PIECE(Y,U,2)

 +17       IF DESCT=""

               SET RET="-1^Snomed not valid"

 +18       IF TXT=""

               SET RET="-1^Snomed not valid"

 +19       IF RET=-1

               QUIT 

 +20       SET STAT=$PIECE(INP,U,4)

 +21      ;MSC/MGH Patch 20

 +22       IF STAT=""

               SET STAT=$PIECE(X,U,9)

 +23       SET STAT=$SELECT(STAT="Chronic":"A",STAT="Inactive":"I",STAT="Sub-acute":"S",STAT="Episodic":"E",STAT="Social/Environmental":"O",STAT="Routine/Admin":"R",STAT="Admin":"R",STAT="Personal History":"P",1:STAT)

 +24       SET FREQ=+$PIECE(INP,U,5)

 +25       SET GRP=$PIECE(INP,U,6)

 +26       SET ITEM=$PIECE(INP,U,7)

 +27      ;P19

           IF '+ITEM

               SET NEW=1

 +28       SET DEL=$PIECE(INP,U,8)

 +29       IF DEL

               Begin DoDot:1

 +30               NEW DA,SFN

 +31               SET RET=$$GBLROOT^BGOPFUTL(FNUM,,.SFN)

 +32               IF 'RET

                       SET RET=$$ITEMROOT^BGOPFUTL(SFN,CAT,.GBL,1)

 +33               IF RET

                       QUIT 

 +34               SET DA(1)=CAT

                   SET DA=ITEM

 +35               SET RET=$$DELETE^BGOUTL(GBL,.DA)

               End DoDot:1

 +36      IF '$TEST

               Begin DoDot:1

 +37               SET RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL)

 +38      ;D:RET'<0 @("VALIDATE"_GBL_"(.RET,.PTR,CODE)")

 +39               IF RET'<0

                       SET RET=$$UPDITEM(FNUM,CAT,SNO,DESCT,STAT,FREQ,TXT,NEW,GRP,.IEN,ITEM,PREF)

 +40               IF RET'<0

                       SET RET=IEN

               End DoDot:1

 +41       QUIT 

 +42      ; Update a category's item entry

 +43      ;  FNUM = Preference file #

 +44      ;  CAT  = Category IEN

 +45      ;  SNO  = Snomed CT

 +46      ;  DESCT= Desc CT

 +47      ;  STAT = Status

 +48      ;  CNT  = Item count (or "+n" to increment existing count) (optional)

 +49      ;  TXT  = Text of DESC CT (optional)

 +50      ;  NEW  = If true, force creation of new entry (optional, default=false)

 +51      ;  GRP  = Group for this item

 +52      ; .ITM  = Returned value of item IEN

 +53      ;  Return value is 0 if success, or -1^error text

UPDITEM(FNUM,CAT,SNO,DESCT,STAT,CNT,TXT,NEW,GRP,ITM,ITEM,PREF) ;EP

 +1        NEW FDA,IEN,GBL,SFN,RET

 +2        SET RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)

 +3        IF RET

               QUIT RET

 +4       ;S ITM=$S($G(NEW):0,1:$O(@GBL@(CAT,1,"B",SNO,0)))

 +5        SET ITM=$SELECT($GET(NEW):0,$GET(ITEM):ITEM,1:$ORDER(@GBL@(CAT,1,"B",SNO,0)))

 +6        IF $EXTRACT($GET(CNT))="+"

               SET CNT=$SELECT(ITM:$PIECE(@GBL@(CAT,1,ITM,0),U,3),1:0)+CNT

 +7        SET FDA=$NAME(FDA(SFN,$SELECT(ITM:ITM,1:"+1")_","_CAT_","))

 +8        SET @FDA@(.01)=SNO

 +9        SET @FDA@(.02)=DESCT

 +10       IF $DATA(CNT)

               SET @FDA@(.03)=CNT

 +11       SET @FDA@(.06)=STAT

 +12       SET @FDA@(.04)=$$NOW^XLFDT

 +13       SET @FDA@(.07)=PREF

 +14       IF $DATA(TXT)

               SET @FDA@(6)=$TRANSLATE(TXT,";",",")

 +15       IF $DATA(GRP)

               SET @FDA@(7)=GRP

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

 +17       IF 'RET

               IF 'ITM

                   SET ITM=IEN(1)

 +18       QUIT RET

TMPGBL(X) ;EP

 +1        KILL ^TMP("BGOPICK",$JOB)

           QUIT $NAME(^($JOB))