Routine: BQITAXX1

BQITAXX1 ;PRXM/HC/ALA - Delete Taxonomy Item ; 26 May 2006  1:32 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

DEL(DATA,IVALUE,TVIEN) ; EP -- BQI DELETE TAXONOMY ITEM

 ; Input

 ;   IVALUE - Internal entry number of taxonomy in structure, IEN;FILE REF

 ;            because this is a variable pointer value

 ;   TVIEN  - Internal entry number of the LOW/HIGH VALUE

 NEW UID,II,DA,DIK,CHK,X,RESULT,BQIDA,FILE

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQITXDEL",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 I '$$KEYCHK^BQIULSC("BQIZTXED",DUZ) S BMXSEC="You do not have the security access to edit a taxonomy."_$C(10)_"Please see your supervisor or program manager." Q

 ;I '$$KEYCHK^BQIULSC("BGPZ TAXONOMY EDIT",DUZ) S BMXSEC="You do not have the security access to edit a taxonomy."_$C(10)_"Please see your supervisor or program manager." Q

 S IVALUE=$G(IVALUE,""),TVIEN=$G(TVIEN,""),REG=$G(REG,"")

 I IVALUE="" S BMXSEC="No taxonomy selected" Q

 I TVIEN="" S BMXSEC="No value selected" Q

 S FILE=$$GREF^BQITAXX(IVALUE)

 S BQIDA=$$SPM^BQIGPUTL()

 ;I REG'="" S RGIEN=$O(^BQI(90507,"B",REG,""))

 ;I $G(RGIEN)="" D  I $G(BMXSEC)'="" Q

 ;. S IEN=$O(^BQI(90508,BQIDA,10,"AC",IVALUE,""))

 ;. I IEN="" S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 ;. I $P(^BQI(90508,BQIDA,10,IEN,0),U,4)'=1 S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 ;I $G(RGIEN)'="" D  I $G(BMXSEC)'="" Q

 ;. S IEN=$O(^BQI(90507,RGIEN,10,"AC",IVALUE,""))

 ;. I IEN="" S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 ;. I $P(^BQI(90507,RGIEN,10,IEN,0),U,4)'=1 S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 S @DATA@(II)="I00010RESULT"_$C(30)

 S DA(1)=$P(IVALUE,";",1),DA=TVIEN

 S DIK="^"_$P(IVALUE,";",2)_DA(1)_",21,"

 D ^DIK

 S CHK="^"_$P(IVALUE,";",2)_DA(1)_",21,"_DA_",0)"

 I '$D(@CHK) D

 . S RESULT=1

 . I FILE=9002228 D  ; Updated by/date are unique to ^ATXLAB

 .. S BQIUPD(FILE,DA(1)_",",.05)=DUZ

 .. S BQIUPD(FILE,DA(1)_",",.06)=DT

 .. D FILE^DIE("","BQIUPD","ERROR")

 .. K BQIUPD

 I $D(@CHK) S RESULT=0

 S II=II+1,@DATA@(II)=RESULT_$C(30)

DONE ;

 S II=II+1,@DATA@(II)=$C(31)

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

BQITAXX1  ;PRXM/HC/ALA - Delete Taxonomy Item ; 26 May 2006  1:32 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3        QUIT

 +4       ;

DEL(DATA,IVALUE,TVIEN) ; EP -- BQI DELETE TAXONOMY ITEM

 +1       ; Input

 +2       ;   IVALUE - Internal entry number of taxonomy in structure, IEN;FILE REF

 +3       ;            because this is a variable pointer value

 +4       ;   TVIEN  - Internal entry number of the LOW/HIGH VALUE

 +5        NEW UID,II,DA,DIK,CHK,X,RESULT,BQIDA,FILE

 +6        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +7        SET DATA=$NAME(^TMP("BQITXDEL",UID))

 +8        KILL @DATA

 +9       ;

 +10       SET II=0

 +11      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQITAXX1 D UNWIND^%ZTER"

 +12      ;

 +13       IF '$$KEYCHK^BQIULSC("BQIZTXED",DUZ)

               SET BMXSEC="You do not have the security access to edit a taxonomy."_$CHAR(10)_"Please see your supervisor or program manager."

               QUIT

 +14      ;I '$$KEYCHK^BQIULSC("BGPZ TAXONOMY EDIT",DUZ) S BMXSEC="You do not have the security access to edit a taxonomy."_$C(10)_"Please see your supervisor or program manager." Q

 +15      ;

 +16       SET IVALUE=$GET(IVALUE,"")

           SET TVIEN=$GET(TVIEN,"")

           SET REG=$GET(REG,"")

 +17       IF IVALUE=""

               SET BMXSEC="No taxonomy selected"

               QUIT

 +18       IF TVIEN=""

               SET BMXSEC="No value selected"

               QUIT

 +19      ;

 +20       SET FILE=$$GREF^BQITAXX(IVALUE)

 +21       SET BQIDA=$$SPM^BQIGPUTL()

 +22      ;I REG'="" S RGIEN=$O(^BQI(90507,"B",REG,""))

 +23      ;I $G(RGIEN)="" D  I $G(BMXSEC)'="" Q

 +24      ;. S IEN=$O(^BQI(90508,BQIDA,10,"AC",IVALUE,""))

 +25      ;. I IEN="" S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 +26      ;. I $P(^BQI(90508,BQIDA,10,IEN,0),U,4)'=1 S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 +27      ;I $G(RGIEN)'="" D  I $G(BMXSEC)'="" Q

 +28      ;. S IEN=$O(^BQI(90507,RGIEN,10,"AC",IVALUE,""))

 +29      ;. I IEN="" S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 +30      ;. I $P(^BQI(90507,RGIEN,10,IEN,0),U,4)'=1 S BMXSEC="Cannot delete entry in a non-site populated taxonomy" Q

 +31      ;

 +32       SET @DATA@(II)="I00010RESULT"_$CHAR(30)

 +33      ;

 +34       SET DA(1)=$PIECE(IVALUE,";",1)

           SET DA=TVIEN

 +35       SET DIK="^"_$PIECE(IVALUE,";",2)_DA(1)_",21,"

 +36       DO ^DIK

 +37       SET CHK="^"_$PIECE(IVALUE,";",2)_DA(1)_",21,"_DA_",0)"

 +38       IF '$DATA(@CHK)

               Begin DoDot:1

 +39               SET RESULT=1

 +40      ; Updated by/date are unique to ^ATXLAB

                   IF FILE=9002228

                       Begin DoDot:2

 +41                       SET BQIUPD(FILE,DA(1)_",",.05)=DUZ

 +42                       SET BQIUPD(FILE,DA(1)_",",.06)=DT

 +43                       DO FILE^DIE("","BQIUPD","ERROR")

 +44                       KILL BQIUPD

                       End DoDot:2

               End DoDot:1

 +45       IF $DATA(@CHK)

               SET RESULT=0

 +46       SET II=II+1

           SET @DATA@(II)=RESULT_$CHAR(30)

 +47      ;

DONE      ;

 +1        SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +2        QUIT

 +3       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT

BQITAXX1.m