BQIIPCAT.m

BQIIPCAT ;GDIT/HCSD/ALA-IPC Measure Categories ; 05 Oct 2017  12:30 PM

 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23

 ;

CAT(DATA,VERSION) ;EP - BQI GET IPC CATEGORIES

 NEW IEN,TEXT,CAT2,CAT1,SBN,SBN

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

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

 K @DATA

 S II=0

 S @DATA@(II)="T00010IEN^T00030CAT1^T00030CAT2"_$C(30)

 ;

 S IEN=0

 F  S IEN=$O(^BQI(90506.8,IEN)) Q:'IEN  D

 . I $P(^BQI(90506.8,IEN,0),U,3)'="C" Q

 . I $P(^BQI(90506.8,IEN,0),U,6)=1 Q

 . S CAT1=$P(^BQI(90506.8,IEN,0),"^",1)

 . S CAT2=$$GET1^DIQ(90506.8,IEN_",",.04,"E")

 . I CAT2'="" S TEXT=CAT2,CAT2=CAT1

 . I CAT2="" S TEXT=CAT1

 . ; If inactive

 . I '$D(^BQI(90506.8,"AC",IEN)) S II=II+1,@DATA@(II)=IEN_"^"_TEXT_"^"_CAT2_$C(30) Q

 . S SBN=""

 . F  S SBN=$O(^BQI(90506.8,"AC",IEN,SBN)) Q:SBN=""  D

 .. I $P(^BQI(90506.8,SBN,0),"^",2)=1 Q

 .. I $P(^BQI(90506.8,SBN,0),U,6)=1 Q

 .. I $P(^BQI(90506.8,SBN,0),U,5)'=VERSION Q

 .. S CAT1=$P(^BQI(90506.8,SBN,0),"^",1)

 .. S CAT2=$$GET1^DIQ(90506.8,SBN_",",.04,"E")

 .. I CAT2'="" S TEXT=CAT2,CAT2=CAT1

 .. I CAT2="" S TEXT=CAT1

 .. S II=II+1,@DATA@(II)=SBN_"^"_TEXT_"^"_CAT2_$C(30)

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

 Q

BQIIPCAT  ;GDIT/HCSD/ALA-IPC Measure Categories ; 05 Oct 2017  12:30 PM

 +1       ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23

 +2       ;

CAT(DATA,VERSION) ;EP - BQI GET IPC CATEGORIES

 +1        NEW IEN,TEXT,CAT2,CAT1,SBN,SBN

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

 +3        SET DATA=$NAME(^TMP("BQIPCAT",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6        SET @DATA@(II)="T00010IEN^T00030CAT1^T00030CAT2"_$CHAR(30)

 +7       ;

 +8        SET IEN=0

 +9        FOR 

               SET IEN=$ORDER(^BQI(90506.8,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +10               IF $PIECE(^BQI(90506.8,IEN,0),U,3)'="C"

                       QUIT 

 +11               IF $PIECE(^BQI(90506.8,IEN,0),U,6)=1

                       QUIT 

 +12               SET CAT1=$PIECE(^BQI(90506.8,IEN,0),"^",1)

 +13               SET CAT2=$$GET1^DIQ(90506.8,IEN_",",.04,"E")

 +14               IF CAT2'=""

                       SET TEXT=CAT2

                       SET CAT2=CAT1

 +15               IF CAT2=""

                       SET TEXT=CAT1

 +16      ; If inactive

 +17               IF '$DATA(^BQI(90506.8,"AC",IEN))

                       SET II=II+1

                       SET @DATA@(II)=IEN_"^"_TEXT_"^"_CAT2_$CHAR(30)

                       QUIT 

 +18               SET SBN=""

 +19               FOR 

                       SET SBN=$ORDER(^BQI(90506.8,"AC",IEN,SBN))

                       IF SBN=""

                           QUIT 

                       Begin DoDot:2

 +20                       IF $PIECE(^BQI(90506.8,SBN,0),"^",2)=1

                               QUIT 

 +21                       IF $PIECE(^BQI(90506.8,SBN,0),U,6)=1

                               QUIT 

 +22                       IF $PIECE(^BQI(90506.8,SBN,0),U,5)'=VERSION

                               QUIT 

 +23                       SET CAT1=$PIECE(^BQI(90506.8,SBN,0),"^",1)

 +24                       SET CAT2=$$GET1^DIQ(90506.8,SBN_",",.04,"E")

 +25                       IF CAT2'=""

                               SET TEXT=CAT2

                               SET CAT2=CAT1

 +26                       IF CAT2=""

                               SET TEXT=CAT1

 +27                       SET II=II+1

                           SET @DATA@(II)=SBN_"^"_TEXT_"^"_CAT2_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +28       SET II=II+1

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

 +29       QUIT