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

BQIVFTRE.m

Go to the documentation of this file.
  1. BQIVFTRE ;PRXM/HC/ALA-Trigger Exam Information ; 09 Aug 2007 12:19 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. Q
  1. ;
  1. EN(DATA,EXM) ;EP - BQI VFILE TRIGGER EXM
  1. ;
  1. ; Input
  1. ; EXM - Exam IEN
  1. ;
  1. NEW UID,II,PARMS,DA,IENS,NM,VALUE,C
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIVFTRE",UID))
  1. K @DATA
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFTRE D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. S SOURCE="APCDTRES",VALUE="N"_$C(29)_"NORMAL/NEGATIVE"
  1. S C=$P(^AUTTEXAM(EXM,0),U,2)
  1. I C=34 S VALUE=VALUE_$C(28)_"PA"_$C(29)_"PAST"_$C(28)_"PR"_$C(29)_"PRESENT"
  1. I C=35!(C=36) S VALUE=VALUE_$C(28)_"PO"_$C(29)_"POSITIVE"
  1. I C'=34,C'=35,C'=36 S VALUE=VALUE_$C(28)_"A"_$C(29)_"ABNORMAL"
  1. S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS"_$C(30)
  1. S II=II+1,@DATA@(II)=SOURCE_U_"C"_U_VALUE_$C(30)
  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