BQIIPCUT.m

BQIIPCUT ;VNGT/HS/BEE-IPC Utilities ; 17 Jun 2011  12:38 PM

 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12

 ;

LIST(DATA,FAKE) ;EP -- BQI GET IPC CHOICE

 NEW UID,II,HDR,IX,LIST,PC

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

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

 K @DATA

 S II=0

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

 S HDR="T00003CHOICE_CODE^T00050CHOICE_TEXT"_$C(30)

 S @DATA@(II)=HDR

 ;

 D FIELD^DID(90505,.21,"","POINTER","LIST")

 ;

 F IX=1:1:$L($G(LIST("POINTER")),";") S PC=$P($G(LIST("POINTER")),";",IX) D

 . S CD=$P(PC,":") Q:CD=""

 . S CT=$P(PC,":",2) Q:CT=""

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

 ;

DONE ;

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

 Q

 ;

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)

 Q

 ;

CLIN(BQIPCDE) ;EP - Get Clinical for a measure

 NEW BQIH,CRIPC,CRN,DA,IENS

 S BQIH=$$SPM^BQIGPUTL()

 S CRIPC=$P($G(^BQI(90508,1,11)),U,1)

 S CRN=$O(^BQI(90508,1,22,"B",CRIPC,""))

 S DA(2)=BQIH,DA(1)=CRN

 S DA=$O(^BQI(90508,BQIH,22,CRN,1,"B",BQIPCDE,""))

 S IENS=$$IENS^DILF(.DA)

 Q $$GET1^DIQ(90508.221,IENS,.03,"E")

 ;

CIPC(BQIPCDE) ;EP - Current IPC measure?

 NEW BQIH,CRIPC,CRN,DA,IENS

 S BQIH=$$SPM^BQIGPUTL()

 S CRIPC=$P($G(^BQI(90508,1,11)),U,1)

 S CRN=$O(^BQI(90508,1,22,"B",CRIPC,""))

 S DA(2)=BQIH,DA(1)=CRN

 S DA=$O(^BQI(90508,BQIH,22,CRN,1,"B",BQIPCDE,""))

 I DA="" Q 0

 Q 1

BQIIPCUT  ;VNGT/HS/BEE-IPC Utilities ; 17 Jun 2011  12:38 PM

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

 +2       ;

LIST(DATA,FAKE) ;EP -- BQI GET IPC CHOICE

 +1        NEW UID,II,HDR,IX,LIST,PC

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

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

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +7        SET HDR="T00003CHOICE_CODE^T00050CHOICE_TEXT"_$CHAR(30)

 +8        SET @DATA@(II)=HDR

 +9       ;

 +10       DO FIELD^DID(90505,.21,"","POINTER","LIST")

 +11      ;

 +12       FOR IX=1:1:$LENGTH($GET(LIST("POINTER")),";")

               SET PC=$PIECE($GET(LIST("POINTER")),";",IX)

               Begin DoDot:1

 +13               SET CD=$PIECE(PC,":")

                   IF CD=""

                       QUIT 

 +14               SET CT=$PIECE(PC,":",2)

                   IF CT=""

                       QUIT 

 +15               SET II=II+1

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

               End DoDot:1

 +16      ;

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 

 +7       ;

CLIN(BQIPCDE) ;EP - Get Clinical for a measure

 +1        NEW BQIH,CRIPC,CRN,DA,IENS

 +2        SET BQIH=$$SPM^BQIGPUTL()

 +3        SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)

 +4        SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))

 +5        SET DA(2)=BQIH

           SET DA(1)=CRN

 +6        SET DA=$ORDER(^BQI(90508,BQIH,22,CRN,1,"B",BQIPCDE,""))

 +7        SET IENS=$$IENS^DILF(.DA)

 +8        QUIT $$GET1^DIQ(90508.221,IENS,.03,"E")

 +9       ;

CIPC(BQIPCDE) ;EP - Current IPC measure?

 +1        NEW BQIH,CRIPC,CRN,DA,IENS

 +2        SET BQIH=$$SPM^BQIGPUTL()

 +3        SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)

 +4        SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))

 +5        SET DA(2)=BQIH

           SET DA(1)=CRN

 +6        SET DA=$ORDER(^BQI(90508,BQIH,22,CRN,1,"B",BQIPCDE,""))

 +7        IF DA=""

               QUIT 0

 +8        QUIT 1