- 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
