Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIVFTRT

BQIVFTRT.m

Go to the documentation of this file. 
  1. 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
  1.  ;;
  1.  ;
  1.  ;
  1. EN(DATA,EVIEN,EVTYPE,TAXIEN) ;EP - BQI VFILE TRIGGER EVENT
  1.  NEW UID,II,VALUE,IVIEN,EVVALUE,IVALIEN,TY
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIVFTRT",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFTRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  D HDR
  1.  I $G(EVTYPE)'="" D TYP(EVIEN,EVTYPE) G DONE
  1.  I $G(TAXIEN)'="" D TAX G DONE
  1.  I $G(EVIEN)'="" D EVT(EVIEN) G DONE
  1.  Q
  1.  ;
  1. EVT(EVIEN) ;EP
  1.  NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
  1.  S EVTYPE="",EVVALUE="",IVALIEN=""
  1.  S TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
  1.  I TY'="" S EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  I TY'="" S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
  1.  I $G(IEN)'="" D
  1.  . S EVVALUE=$P(^BTPW(90621,EVIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6),TAXIEN=$P(^(0),U,2)
  1.  . S SOURCE="EVTYPE",TYPE="",ABLE="Y",TYPE="",VALUE=EVTYPE,HELP="",CLEAR="" D UP
  1.  . S SOURCE="EVVALUE",TYPE="",ABLE="Y",TYPE="",VALUE=EVVALUE,HELP="",CLEAR="" D UP
  1.  . S SOURCE="IVALIEN",TYPE="",ABLE="Y",TYPE="",VALUE=IVIEN,HELP="",CLEAR="" D UP
  1.  . S SOURCE="TAXIEN",TYPE="",ABLE="Y",TYPE="",VALUE=TAXIEN,HELP="",CLEAR="" D UP
  1.  . ;S IEN=0 F  S IEN=$O(^BTPW(90621,EVIEN,1,IEN)) Q:'IEN  D
  1.  . 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)
  1.  . I TY=1!(TY=6) Q
  1.  . S LIEN=$P(^BTPW(90621,EVIEN,1,IEN,0),U,6) I TY=3,LIEN'="" S DEF=$P(^LAB(60,LIEN,0),"^",1)
  1.  . S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  . I $D(DVAL(TYPE)) Q
  1.  . S N="" F  S N=$O(DVAL1(N)) Q:N=""  S LN=N
  1.  . S DVAL(TYPE)=(LN+1)_U_DEF_U_TAXP_U_DEFN,DVAL1((LN+1))=TYPE
  1.  ;
  1.  ;S N="" F  S N=$O(DVAL1(N)) Q:N=""  D
  1.  ;. S EVTYPE=$P(DVAL1(N),"^",1)
  1.  ;. ;S EVTYPE=$P(DVAL1(N),"^",1),EVVALUE=$P(DVAL(EVTYPE),"^",2),TAXIEN=$P(DVAL(EVTYPE),"^",3),IVALIEN=$P(DVAL(EVTYPE),"^",4)
  1.  ;. S II=II+1,@DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$C(30)
  1.  ;. ;S II=II+1,@DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$C(30)
  1.  ;. ;S II=II+1,@DATA@(II)="IVALIEN"_U_U_IVIEN_U_$C(30)
  1.  ;. ;S II=II+1,@DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$C(30)
  1.  Q
  1.  ;
  1. EVTY(DATA,EVIEN) ;EP - Get event types
  1.  NEW EVTYPE,EVVALUE,IVALIEN,TY,IEN,DVAL,DVAL1,LIEN,TYPE,DEF,TAX,TAXP,TAXIEN,DEFN
  1.  S EVTYPE="",EVVALUE="",IVALIEN=""
  1.  S @DATA@(II)="I00010EVIEN^T00010EVTYPE"_$C(30)
  1.  S TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
  1.  I TY'="" S EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  I TY'="" S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
  1.  I IEN'="" S DVAL(EVTYPE)=1,DVAL1(1)=EVTYPE
  1.  S IEN=0 F  S IEN=$O(^BTPW(90621,EVIEN,1,IEN)) Q:'IEN  D
  1.  . S TY=$P(^BTPW(90621,EVIEN,1,IEN,0),U,3)
  1.  . I TY=1!(TY=6) Q
  1.  . S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  . I $D(DVAL(TYPE)) Q
  1.  . S N="" F  S N=$O(DVAL1(N)) Q:N=""  S LN=N
  1.  . S DVAL(TYPE)=(LN+1),DVAL1((LN+1))=TYPE
  1.  ;
  1.  S N="" F  S N=$O(DVAL1(N)) Q:N=""  D
  1.  . S EVTYPE=$P(DVAL1(N),"^",1),II=II+1,@DATA@(II)=EVIEN_U_EVTYPE_$C(30)
  1.  Q
  1.  ;
  1. EVTAX(DATA,EVIEN,EVTYPE) ;EP - Get taxonomy for event type
  1.  Q
  1.  ;
  1. TAX ;EP
  1.  D ITM^BTPWTAX(.TDATA,TAXIEN)
  1.  S N=0 F  S N=$O(@TDATA@(N)) Q:'N  D
  1.  . I @TDATA@(N)=$C(31) Q
  1.  . S II=II+1,@DATA@(II)="IVALIEN"_U_U_$P(@TDATA@(N),"^",1)_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="EVVALUE"_U_U_$P($P(@TDATA@(N),"^",2),"  -  ",1)_U_$C(30)
  1.  Q
  1.  ;
  1. TYP(EVIEN,EVTYPE) ;EP
  1.  NEW EVVALUE,IVALIEN,TAXIEN,IEN,TY
  1.  S EVVALUE="",IVALIEN="",TAXIEN=""
  1.  S TY=$O(^BTPW(90621.1,"D",EVTYPE,""))
  1.  S IEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
  1.  I $G(IEN)'="" D
  1.  . S EVVALUE=$P(^BTPW(90621,EVIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6),TAXIEN=$P(^(0),U,2)
  1.  . S II=II+1,@DATA@(II)="EVTYPE"_U_U_EVTYPE_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="EVVALUE"_U_U_EVVALUE_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="IVALIEN"_U_U_IVIEN_U_$C(30)
  1.  . S II=II+1,@DATA@(II)="TAXIEN"_U_U_TAXIEN_U_$C(30)
  1.  Q
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ETYP(ECODE) ;EP -
  1.  Q $G(^XTMP("BQIEVT",UID,ECODE))
  1.  ;
  1. HDR ; Header for BQI VFILE TRIGGER MEAS
  1.  S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T01024PARMS^T00200HELP_TEXT^T01024CLEAR_FIELDS"_$C(30)
  1.  Q
  1.  ;
  1. UP ; Update
  1.  S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_VALUE_U_HELP_U_CLEAR_$C(30)
  1.  Q