BQIVFTRT ;GDHD/HCS/ALA-V File trigger for CMET Event ; 06 Jan 2017 12:38 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;;
;
;
EN(DATA,EVIEN,EVTYPE,TAXIEN) ;EP - BQI VFILE TRIGGER EVENT
NEW UID,II,VALUE,IVIEN,EVVALUE,IVALIEN,TY
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIVFTRT",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFTRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
I $G(EVTYPE)'="" D TYP(EVIEN,EVTYPE) G DONE
I $G(TAXIEN)'="" D TAX G DONE
I $G(EVIEN)'="" D EVT(EVIEN) G DONE
Q
;
EVT(EVIEN) ;EP
NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
S EVTYPE="",EVVALUE="",IVALIEN=""
S TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
I TY'="" S EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
I TY'="" S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
I $G(IEN)'="" D
. S EVVALUE=$P(^BTPW(90621,EVIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6),TAXIEN=$P(^(0),U,2)
. S SOURCE="EVTYPE",TYPE="",ABLE="Y",TYPE="",VALUE=EVTYPE,HELP="",CLEAR="" D UP
. S SOURCE="EVVALUE",TYPE="",ABLE="Y",TYPE="",VALUE=EVVALUE,HELP="",CLEAR="" D UP
. S SOURCE="IVALIEN",TYPE="",ABLE="Y",TYPE="",VALUE=IVIEN,HELP="",CLEAR="" D UP
. S SOURCE="TAXIEN",TYPE="",ABLE="Y",TYPE="",VALUE=TAXIEN,HELP="",CLEAR="" D UP
. ;S IEN=0 F S IEN=$O(^BTPW(90621,EVIEN,1,IEN)) Q:'IEN D
. S TY=$P(^BTPW(90621,EVIEN,1,IEN,0),U,3),TAX=$P(^(0),U,1),DEF=$P(^(0),U,5),TAXP=$P(^(0),U,2),DEFN=$P(^(0),U,6)
. I TY=1!(TY=6) Q
. S LIEN=$P(^BTPW(90621,EVIEN,1,IEN,0),U,6) I TY=3,LIEN'="" S DEF=$P(^LAB(60,LIEN,0),"^",1)
. S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
. I $D(DVAL(TYPE)) Q
. S N="" F S N=$O(DVAL1(N)) Q:N="" S LN=N
. S DVAL(TYPE)=(LN+1)_U_DEF_U_TAXP_U_DEFN,DVAL1((LN+1))=TYPE
;
;S N="" F S N=$O(DVAL1(N)) Q:N="" D
;. S EVTYPE=$P(DVAL1(N),"^",1)
;. ;S EVTYPE=$P(DVAL1(N),"^",1),EVVALUE=$P(DVAL(EVTYPE),"^",2),TAXIEN=$P(DVAL(EVTYPE),"^",3),IVALIEN=$P(DVAL(EVTYPE),"^",4)
;. S II=II+1,@DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$C(30)
;. ;S II=II+1,@DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$C(30)
;. ;S II=II+1,@DATA@(II)="IVALIEN"_U_U_IVIEN_U_$C(30)
;. ;S II=II+1,@DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$C(30)
Q
;
EVTY(DATA,EVIEN) ;EP - Get event types
NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
S EVTYPE="",EVVALUE="",IVALIEN=""
S @DATA@(II)="I00010EVIEN^T00010EVTYPE"_$C(30)
S TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
I TY'="" S EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
I TY'="" S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
I IEN'="" S DVAL(EVTYPE)=1,DVAL1(1)=EVTYPE
S IEN=0 F S IEN=$O(^BTPW(90621,EVIEN,1,IEN)) Q:'IEN D
. S TY=$P(^BTPW(90621,EVIEN,1,IEN,0),U,3)
. I TY=1!(TY=6) Q
. S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
. I $D(DVAL(TYPE)) Q
. S N="" F S N=$O(DVAL1(N)) Q:N="" S LN=N
. S DVAL(TYPE)=(LN+1),DVAL1((LN+1))=TYPE
;
S N="" F S N=$O(DVAL1(N)) Q:N="" D
. S EVTYPE=$P(DVAL1(N),"^",1),II=II+1,@DATA@(II)=EVIEN_U_EVTYPE_$C(30)
Q
;
EVTAX(DATA,EVIEN,EVTYPE) ;EP - Get taxonomy for event type
Q
;
TAX ;EP
D ITM^BTPWTAX(.TDATA,TAXIEN)
S N=0 F S N=$O(@TDATA@(N)) Q:'N D
. I @TDATA@(N)=$C(31) Q
. S II=II+1,@DATA@(II)="IVALIEN"_U_U_$P(@TDATA@(N),"^",1)_U_$C(30)
. S II=II+1,@DATA@(II)="EVVALUE"_U_U_$P($P(@TDATA@(N),"^",2)," - ",1)_U_$C(30)
Q
;
TYP(EVIEN,EVTYPE) ;EP
NEW EVVALUE,IVALIEN,TAXIEN,IEN,TY
S EVVALUE="",IVALIEN="",TAXIEN=""
S TY=$O(^BTPW(90621.1,"D",EVTYPE,""))
S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
I $G(IEN)'="" D
. S EVVALUE=$P(^BTPW(90621,EVIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6),TAXIEN=$P(^(0),U,2)
. S II=II+1,@DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$C(30)
. S II=II+1,@DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$C(30)
. S II=II+1,@DATA@(II)="IVALIEN"_U_U_IVIEN_U_$C(30)
. S II=II+1,@DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$C(30)
Q
;
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
;
ETYP(ECODE) ;EP -
Q $G(^XTMP("BQIEVT",UID,ECODE))
;
HDR ; Header for BQI VFILE TRIGGER MEAS
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS^T00200HELP_TEXT^T01024CLEAR_FIELDS"_$C(30)
Q
;
UP ; Update
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_VALUE_U_HELP_U_CLEAR_$C(30)
Q
BQIVFTRT ;GDHD/HCS/ALA-V File trigger for CMET Event ; 06 Jan 2017 12:38 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;;
+3 ;
+4 ;
EN(DATA,EVIEN,EVTYPE,TAXIEN) ;EP - BQI VFILE TRIGGER EVENT
+1 NEW UID,II,VALUE,IVIEN,EVVALUE,IVALIEN,TY
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIVFTRT",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIVFTRT D UNWIND^%ZTER"
+7 DO HDR
+8 IF $GET(EVTYPE)'=""
DO TYP(EVIEN,EVTYPE)
GOTO DONE
+9 IF $GET(TAXIEN)'=""
DO TAX
GOTO DONE
+10 IF $GET(EVIEN)'=""
DO EVT(EVIEN)
GOTO DONE
+11 QUIT
+12 ;
EVT(EVIEN) ;EP
+1 NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
+2 SET EVTYPE=""
SET EVVALUE=""
SET IVALIEN=""
+3 SET TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
+4 IF TY'=""
SET EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+5 IF TY'=""
SET IEN=$ORDER(^BTPW(90621,EVIEN,1,"C",TY,""))
+6 IF $GET(IEN)'=""
Begin DoDot:1
+7 SET EVVALUE=$PIECE(^BTPW(90621,EVIEN,1,IEN,0),"^",5)
SET IVIEN=$PIECE(^(0),"^",6)
SET TAXIEN=$PIECE(^(0),U,2)
+8 SET SOURCE="EVTYPE"
SET TYPE=""
SET ABLE="Y"
SET TYPE=""
SET VALUE=EVTYPE
SET HELP=""
SET CLEAR=""
DO UP
+9 SET SOURCE="EVVALUE"
SET TYPE=""
SET ABLE="Y"
SET TYPE=""
SET VALUE=EVVALUE
SET HELP=""
SET CLEAR=""
DO UP
+10 SET SOURCE="IVALIEN"
SET TYPE=""
SET ABLE="Y"
SET TYPE=""
SET VALUE=IVIEN
SET HELP=""
SET CLEAR=""
DO UP
+11 SET SOURCE="TAXIEN"
SET TYPE=""
SET ABLE="Y"
SET TYPE=""
SET VALUE=TAXIEN
SET HELP=""
SET CLEAR=""
DO UP
+12 ;S IEN=0 F S IEN=$O(^BTPW(90621,EVIEN,1,IEN)) Q:'IEN D
+13 SET TY=$PIECE(^BTPW(90621,EVIEN,1,IEN,0),U,3)
SET TAX=$PIECE(^(0),U,1)
SET DEF=$PIECE(^(0),U,5)
SET TAXP=$PIECE(^(0),U,2)
SET DEFN=$PIECE(^(0),U,6)
+14 IF TY=1!(TY=6)
QUIT
+15 SET LIEN=$PIECE(^BTPW(90621,EVIEN,1,IEN,0),U,6)
IF TY=3
IF LIEN'=""
SET DEF=$PIECE(^LAB(60,LIEN,0),"^",1)
+16 SET TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+17 IF $DATA(DVAL(TYPE))
QUIT
+18 SET N=""
FOR
SET N=$ORDER(DVAL1(N))
IF N=""
QUIT
SET LN=N
+19 SET DVAL(TYPE)=(LN+1)_U_DEF_U_TAXP_U_DEFN
SET DVAL1((LN+1))=TYPE
End DoDot:1
+20 ;
+21 ;S N="" F S N=$O(DVAL1(N)) Q:N="" D
+22 ;. S EVTYPE=$P(DVAL1(N),"^",1)
+23 ;. ;S EVTYPE=$P(DVAL1(N),"^",1),EVVALUE=$P(DVAL(EVTYPE),"^",2),TAXIEN=$P(DVAL(EVTYPE),"^",3),IVALIEN=$P(DVAL(EVTYPE),"^",4)
+24 ;. S II=II+1,@DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$C(30)
+25 ;. ;S II=II+1,@DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$C(30)
+26 ;. ;S II=II+1,@DATA@(II)="IVALIEN"_U_U_IVIEN_U_$C(30)
+27 ;. ;S II=II+1,@DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$C(30)
+28 QUIT
+29 ;
EVTY(DATA,EVIEN) ;EP - Get event types
+1 NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
+2 SET EVTYPE=""
SET EVVALUE=""
SET IVALIEN=""
+3 SET @DATA@(II)="I00010EVIEN^T00010EVTYPE"_$CHAR(30)
+4 SET TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
+5 IF TY'=""
SET EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+6 IF TY'=""
SET IEN=$ORDER(^BTPW(90621,EVIEN,1,"C",TY,""))
+7 IF IEN'=""
SET DVAL(EVTYPE)=1
SET DVAL1(1)=EVTYPE
+8 SET IEN=0
FOR
SET IEN=$ORDER(^BTPW(90621,EVIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 SET TY=$PIECE(^BTPW(90621,EVIEN,1,IEN,0),U,3)
+10 IF TY=1!(TY=6)
QUIT
+11 SET TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+12 IF $DATA(DVAL(TYPE))
QUIT
+13 SET N=""
FOR
SET N=$ORDER(DVAL1(N))
IF N=""
QUIT
SET LN=N
+14 SET DVAL(TYPE)=(LN+1)
SET DVAL1((LN+1))=TYPE
End DoDot:1
+15 ;
+16 SET N=""
FOR
SET N=$ORDER(DVAL1(N))
IF N=""
QUIT
Begin DoDot:1
+17 SET EVTYPE=$PIECE(DVAL1(N),"^",1)
SET II=II+1
SET @DATA@(II)=EVIEN_U_EVTYPE_$CHAR(30)
End DoDot:1
+18 QUIT
+19 ;
EVTAX(DATA,EVIEN,EVTYPE) ;EP - Get taxonomy for event type
+1 QUIT
+2 ;
TAX ;EP
+1 DO ITM^BTPWTAX(.TDATA,TAXIEN)
+2 SET N=0
FOR
SET N=$ORDER(@TDATA@(N))
IF 'N
QUIT
Begin DoDot:1
+3 IF @TDATA@(N)=$CHAR(31)
QUIT
+4 SET II=II+1
SET @DATA@(II)="IVALIEN"_U_U_$PIECE(@TDATA@(N),"^",1)_U_$CHAR(30)
+5 SET II=II+1
SET @DATA@(II)="EVVALUE"_U_U_$PIECE($PIECE(@TDATA@(N),"^",2)," - ",1)_U_$CHAR(30)
End DoDot:1
+6 QUIT
+7 ;
TYP(EVIEN,EVTYPE) ;EP
+1 NEW EVVALUE,IVALIEN,TAXIEN,IEN,TY
+2 SET EVVALUE=""
SET IVALIEN=""
SET TAXIEN=""
+3 SET TY=$ORDER(^BTPW(90621.1,"D",EVTYPE,""))
+4 SET IEN=$ORDER(^BTPW(90621,EVIEN,1,"C",TY,""))
+5 IF $GET(IEN)'=""
Begin DoDot:1
+6 SET EVVALUE=$PIECE(^BTPW(90621,EVIEN,1,IEN,0),"^",5)
SET IVIEN=$PIECE(^(0),"^",6)
SET TAXIEN=$PIECE(^(0),U,2)
+7 SET II=II+1
SET @DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$CHAR(30)
+8 SET II=II+1
SET @DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$CHAR(30)
+9 SET II=II+1
SET @DATA@(II)="IVALIEN"_U_U_IVIEN_U_$CHAR(30)
+10 SET II=II+1
SET @DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$CHAR(30)
End DoDot:1
+11 QUIT
+12 ;
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 ;
ETYP(ECODE) ;EP -
+1 QUIT $GET(^XTMP("BQIEVT",UID,ECODE))
+2 ;
HDR ; Header for BQI VFILE TRIGGER MEAS
+1 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS^T00200HELP_TEXT^T01024CLEAR_FIELDS"_$CHAR(30)
+2 QUIT
+3 ;
UP ; Update
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_VALUE_U_HELP_U_CLEAR_$CHAR(30)
+2 QUIT
