BQIPTTR ;VNGT/HS/ALA-Patient Triggers ; 15 Jan 2009 1:08 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
;
EDIN(DATA,DFN) ; EP -- BQI PATIENT TRIGGER EDIT
; Description - Initial Patient Edit trigger
NEW UID,II,ETHN,VALUE,PGIEN,LGIEN,OIEN,VAL,BQIL,LGN,IEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTTR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT^T00030PROP_VALUE^T00001ABLE_FLAG"_$C(30)
;
S ETHN=$$ETHN^BQIPTDMG(DFN,.01)
S $P(VALUE,U,1)="AGMETH",$P(VALUE,U,4)="Method used to collect patient's ethnicity"
S $P(VALUE,U,6)=$S(ETHN="":"N",1:"Y")
;
S II=II+1,@DATA@(II)=VALUE_$C(30)
;
D PAT9
;
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
;
EN(DATA,AGETH) ; EP - BQI TRIGGER PAT ETHNICITY
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTTR1",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$C(30)
S AGETH=$G(AGETH,"")
I AGETH'="" S II=II+1,@DATA@(II)="AGMETH^Y^"_$C(30)
I AGETH="" S II=II+1,@DATA@(II)="AGMETH^N^AGMETH"_$C(30)
;
G DONE
;
PAT9 ;EP - Patch 9
K BQIL
; Languages
S IEN="B",VAL="",LGIEN=""
S IEN=$O(^AUPNPAT(DFN,86,IEN),-1)
I +IEN'=0 D
. S LGIEN=$P($G(^AUPNPAT(DFN,86,IEN,0)),U,4)
. S PGIEN=$P($G(^AUPNPAT(DFN,86,IEN,0)),U,2)
. I LGIEN'="" S BQIL(LGIEN)=""
. I PGIEN'="" S BQIL(PGIEN)=""
. S OIEN=0
. F S OIEN=$O(^AUPNPAT(DFN,86,IEN,5,OIEN)) Q:'OIEN D
.. I $G(^AUTTLANG(OIEN,0))="" Q
.. S BQIL(OIEN)=""
;
S LGN=""
F S LGN=$O(BQIL(LGN)) Q:LGN="" S VAL=VAL_LGN_$C(29)_$P(^AUTTLANG(LGN,0),U,1)_$C(28)
S VAL=$$TKO^BQIUL1(VAL,$C(28))
S $P(VALUE,U,1)="PFLANG",$P(VALUE,U,6)="Y",$P(VALUE,U,4)="Select one of the user's languages",$P(VALUE,U,2)="T"
S $P(VALUE,U,3)=VAL,II=II+1,@DATA@(II)=VALUE_$C(30)
;
S VAL=""
I LGIEN'="" S VAL=LGIEN_$C(28)_$P(^AUTTLANG(LGIEN,0),U,1)
S $P(VALUE,U,1)="PFLANG",$P(VALUE,U,6)="Y",$P(VALUE,U,4)="",$P(VALUE,U,2)="T"
S $P(VALUE,U,3)=VAL,II=II+1,@DATA@(II)=VALUE_$C(30)
Q
BQIPTTR ;VNGT/HS/ALA-Patient Triggers ; 15 Jan 2009 1:08 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 ;
EDIN(DATA,DFN) ; EP -- BQI PATIENT TRIGGER EDIT
+1 ; Description - Initial Patient Edit trigger
+2 NEW UID,II,ETHN,VALUE,PGIEN,LGIEN,OIEN,VAL,BQIL,LGN,IEN
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIPTTR",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER"
+8 ;
+9 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT^T00030PROP_VALUE^T00001ABLE_FLAG"_$CHAR(30)
+10 ;
+11 SET ETHN=$$ETHN^BQIPTDMG(DFN,.01)
+12 SET $PIECE(VALUE,U,1)="AGMETH"
SET $PIECE(VALUE,U,4)="Method used to collect patient's ethnicity"
+13 SET $PIECE(VALUE,U,6)=$SELECT(ETHN="":"N",1:"Y")
+14 ;
+15 SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+16 ;
+17 DO PAT9
+18 ;
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 ;
EN(DATA,AGETH) ; EP - BQI TRIGGER PAT ETHNICITY
+1 NEW UID,II
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIPTTR1",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTTR D UNWIND^%ZTER"
+7 ;
+8 SET @DATA@(II)="T00008SOURCE^T00001ABLE_FLAG^T01024CLEAR_FIELDS"_$CHAR(30)
+9 SET AGETH=$GET(AGETH,"")
+10 IF AGETH'=""
SET II=II+1
SET @DATA@(II)="AGMETH^Y^"_$CHAR(30)
+11 IF AGETH=""
SET II=II+1
SET @DATA@(II)="AGMETH^N^AGMETH"_$CHAR(30)
+12 ;
+13 GOTO DONE
+14 ;
PAT9 ;EP - Patch 9
+1 KILL BQIL
+2 ; Languages
+3 SET IEN="B"
SET VAL=""
SET LGIEN=""
+4 SET IEN=$ORDER(^AUPNPAT(DFN,86,IEN),-1)
+5 IF +IEN'=0
Begin DoDot:1
+6 SET LGIEN=$PIECE($GET(^AUPNPAT(DFN,86,IEN,0)),U,4)
+7 SET PGIEN=$PIECE($GET(^AUPNPAT(DFN,86,IEN,0)),U,2)
+8 IF LGIEN'=""
SET BQIL(LGIEN)=""
+9 IF PGIEN'=""
SET BQIL(PGIEN)=""
+10 SET OIEN=0
+11 FOR
SET OIEN=$ORDER(^AUPNPAT(DFN,86,IEN,5,OIEN))
IF 'OIEN
QUIT
Begin DoDot:2
+12 IF $GET(^AUTTLANG(OIEN,0))=""
QUIT
+13 SET BQIL(OIEN)=""
End DoDot:2
End DoDot:1
+14 ;
+15 SET LGN=""
+16 FOR
SET LGN=$ORDER(BQIL(LGN))
IF LGN=""
QUIT
SET VAL=VAL_LGN_$CHAR(29)_$PIECE(^AUTTLANG(LGN,0),U,1)_$CHAR(28)
+17 SET VAL=$$TKO^BQIUL1(VAL,$CHAR(28))
+18 SET $PIECE(VALUE,U,1)="PFLANG"
SET $PIECE(VALUE,U,6)="Y"
SET $PIECE(VALUE,U,4)="Select one of the user's languages"
SET $PIECE(VALUE,U,2)="T"
+19 SET $PIECE(VALUE,U,3)=VAL
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+20 ;
+21 SET VAL=""
+22 IF LGIEN'=""
SET VAL=LGIEN_$CHAR(28)_$PIECE(^AUTTLANG(LGIEN,0),U,1)
+23 SET $PIECE(VALUE,U,1)="PFLANG"
SET $PIECE(VALUE,U,6)="Y"
SET $PIECE(VALUE,U,4)=""
SET $PIECE(VALUE,U,2)="T"
+24 SET $PIECE(VALUE,U,3)=VAL
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+25 QUIT
