BQIPTBTL.m

BQIPTBTL ;PRXM/HC/ALA-Patient Barriers to Learning ; 07 Nov 2005  2:27 PM

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

 ;

 Q

 ;

GET(DATA,DFN) ; EP -- BQI PAT BARRIERS TO LEARNING

 ;

 ;Description

 ;  Returns all of the Barriers to Learning for a patient

 ;Input

 ;   DFN - Patient internal entry number

 ;

 NEW UID,II,TEXT,XTEXT,IEN,BQIHF,RVDT,VDTM,X,BDATA

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

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

 S BDATA=$NA(^TMP("BQIBARR",UID))

 K @DATA,@BDATA

 ;

 S II=0

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

 ;

 S @DATA@(II)="T00040TITLE^D00018EVENT_DT"_$C(30)

 ;

 S (XTEXT,TEXT)="BARRIERS"

 F  S XTEXT=$O(^AUTTHF("B",XTEXT)) Q:XTEXT=""!($E(XTEXT,1,$L(TEXT))'=TEXT)  D

 . S IEN=""

 . F  S IEN=$O(^AUTTHF("B",XTEXT,IEN)) Q:IEN=""  D

 .. I $$GET1^DIQ(9999999.64,IEN_",",.1,"I")="C" Q

 .. S @BDATA@(IEN)=$P(XTEXT,"-",2)

 ;

 S BQIHF=""

 F  S BQIHF=$O(^AUPNVHF("AA",DFN,BQIHF)) Q:BQIHF=""  D

 . I $D(@BDATA@(BQIHF)) D

 .. S RVDT=""

 .. F  S RVDT=$O(^AUPNVHF("AA",DFN,BQIHF,RVDT)) Q:RVDT=""  D

 ... S IEN=""

 ... F  S IEN=$O(^AUPNVHF("AA",DFN,BQIHF,RVDT,IEN)) Q:IEN=""  D

 .... S VDTM=$$GET1^DIQ(9000010.23,IEN_",",.03,"E")

 .... S II=II+1,@DATA@(II)=@BDATA@(BQIHF)_"^"_$P(VDTM,"@",1)_$C(30)

 ;

 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

BQIPTBTL  ;PRXM/HC/ALA-Patient Barriers to Learning ; 07 Nov 2005  2:27 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

GET(DATA,DFN) ; EP -- BQI PAT BARRIERS TO LEARNING

 +1       ;

 +2       ;Description

 +3       ;  Returns all of the Barriers to Learning for a patient

 +4       ;Input

 +5       ;   DFN - Patient internal entry number

 +6       ;

 +7        NEW UID,II,TEXT,XTEXT,IEN,BQIHF,RVDT,VDTM,X,BDATA

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

 +9        SET DATA=$NAME(^TMP("BQIPTBTL",UID))

 +10       SET BDATA=$NAME(^TMP("BQIBARR",UID))

 +11       KILL @DATA,@BDATA

 +12      ;

 +13       SET II=0

 +14      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +15      ;

 +16       SET @DATA@(II)="T00040TITLE^D00018EVENT_DT"_$CHAR(30)

 +17      ;

 +18       SET (XTEXT,TEXT)="BARRIERS"

 +19       FOR 

               SET XTEXT=$ORDER(^AUTTHF("B",XTEXT))

               IF XTEXT=""!($EXTRACT(XTEXT,1,$LENGTH(TEXT))'=TEXT)

                   QUIT 

               Begin DoDot:1

 +20               SET IEN=""

 +21               FOR 

                       SET IEN=$ORDER(^AUTTHF("B",XTEXT,IEN))

                       IF IEN=""

                           QUIT 

                       Begin DoDot:2

 +22                       IF $$GET1^DIQ(9999999.64,IEN_",",.1,"I")="C"

                               QUIT 

 +23                       SET @BDATA@(IEN)=$PIECE(XTEXT,"-",2)

                       End DoDot:2

               End DoDot:1

 +24      ;

 +25       SET BQIHF=""

 +26       FOR 

               SET BQIHF=$ORDER(^AUPNVHF("AA",DFN,BQIHF))

               IF BQIHF=""

                   QUIT 

               Begin DoDot:1

 +27               IF $DATA(@BDATA@(BQIHF))

                       Begin DoDot:2

 +28                       SET RVDT=""

 +29                       FOR 

                               SET RVDT=$ORDER(^AUPNVHF("AA",DFN,BQIHF,RVDT))

                               IF RVDT=""

                                   QUIT 

                               Begin DoDot:3

 +30                               SET IEN=""

 +31                               FOR 

                                       SET IEN=$ORDER(^AUPNVHF("AA",DFN,BQIHF,RVDT,IEN))

                                       IF IEN=""

                                           QUIT 

                                       Begin DoDot:4

 +32                                       SET VDTM=$$GET1^DIQ(9000010.23,IEN_",",.03,"E")

 +33                                       SET II=II+1

                                           SET @DATA@(II)=@BDATA@(BQIHF)_"^"_$PIECE(VDTM,"@",1)_$CHAR(30)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34      ;

 +35       SET II=II+1

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

 +36       QUIT 

 +37      ;

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