BQIVFTRL ;PRXM/HC/ALA-V File Trigger RPC for Lab fields ; 24 May 2007 4:53 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
Q
;
EN(DATA,LAB,SITE,RSLT,BQDFN) ;EP - BQI VFILE TRIGGER LAB
;
; Input
; SITE - The site specimen IEN
; LAB - Lab test IEN
; RSLT - Lab test result
; BQDFN - Patient internal entry number
;
NEW UID,II,PARMS,DA,IENS,NM,VALUE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIVFTRL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFTRL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S SITE=$G(SITE,""),RSLT=$G(RSLT,""),BQDFN=$G(BQDFN,"")
I SITE="",RSLT="" D TBL G DONE
I SITE'="",RSLT="" D SITE G DONE
I RSLT'="" D RES G DONE
Q
;
SITE ; Get site specific defaults
NEW LOINC,LOW,HIGH,SEX,AGE
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$C(30)
S DA(1)=LAB,DA=SITE,IENS=$$IENS^DILF(.DA)
S LOW=$$GET1^DIQ(60.01,IENS,1,"E")
I LOW["$S(" D
. I $G(BQDFN)="" S LOW="" Q
. S AGE=$$AGE^BQIAGE(BQDFN)
. S SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
. S LOW="S LOW="_LOW
. X LOW
S HIGH=$$GET1^DIQ(60.01,IENS,2,"E")
I HIGH["$S" D
. I $G(BQDFN)="" S HIGH="" Q
. S AGE=$$AGE^BQIAGE(BQDFN)
. S SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
. S HIGH="S HIGH="_HIGH
. X HIGH
S PARMS("APCDTRFL")=LOW
S PARMS("APCDTRFH")=HIGH
S PARMS("APCDTUNI")=$$GET1^DIQ(60.01,IENS,6,"E")
;S PARMS("APCDTCPT")=$$GET1^DIQ(60.01,IENS,15,"E")
S LOINC=$$GET1^DIQ(60.01,IENS,95.3,"E")
I LOINC'="" S PARMS("APCDTLNC")=$$GET1^DIQ(60.01,IENS,95.3,"I")_$C(29)_$$GET1^DIQ(60.01,IENS,95.3,"E")
S NM="",VALUE=""
F S NM=$O(PARMS(NM)) Q:NM="" D
. S II=II+1,@DATA@(II)=NM_U_U_PARMS(NM)_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
;
TBL ; Get all possible lab results values
;
NEW LIST,HELP,LDATA,LTYPE,WHERE,BII,IEN,VALUE,PARMS
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$C(30)
S IEN=0,VALUE="",PARMS="",LTYPE=""
;
S WHERE=$P(^LAB(60,LAB,0),U,12)
I WHERE'="" D
. S LDATA=U_WHERE_"0)"
. S LTYPE=$P(@LDATA,U,2)
. S LTYPE=$S(LTYPE["N":"N",LTYPE["S":"S",1:"F")
. ;I LTYPE="S" S LIST=$P(@LDATA,U,3)
. S LIST=$P(@LDATA,U,3)
. S LDATA=U_WHERE_"3)",HELP=$G(@LDATA)
. I HELP="",LTYPE["S" D
.. S HELP="Select one of the following:"_$C(10)
.. F BII=1:1:$L(LIST,";") S HELP=HELP_$P($P(LIST,";",BII),":",2)_$C(10)
. I LTYPE="S" S LTYPE="C"
. S LIST=$TR(LIST,":",$C(29)),LIST=$TR(LIST,";",$C(28))
;
S II=II+1,@DATA@(II)="APCDTRES"_U_LTYPE_U_$G(LIST)_U_$G(HELP)_$C(30)
;
F S IEN=$O(^LAB(60,LAB,1,IEN)) Q:'IEN D
. S VALUE=VALUE_IEN_$C(29)_$$GET1^DIQ(61,IEN,.01,"E")_$C(28)
S VALUE=$$TKO^BQIUL1(VALUE,$C(28))
S II=II+1,@DATA@(II)="APCDTSTE"_U_"C"_U_VALUE_U_$C(30)
Q
;
RES ; Get trigger abnormal value from result
NEW LRTS,LRQ,LRSPEC,LRSB,HELP,NM,VALUE,LRFLG
S X=RSLT,LRTS=LAB,LRQ=1,LRSPEC=SITE,LRSB=LAB
I BQDFN'="" S AGE=$$AGE^BQIAGE(BQDFN),SEX=$P(^DPT(BQDFN,0),U,2)
D V25^LRVER5
D RANGE^LRVER5
S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$C(30)
S PARMS("APCDTABN")=$G(LRFLG)
S HELP="L*=Critical Low, L=Low, H=High, H*=Critical High, Blank for normal"
S NM="",VALUE=""
F S NM=$O(PARMS(NM)) Q:NM="" D
. S II=II+1,@DATA@(II)=NM_U_U_PARMS(NM)_U_HELP_$C(30)
Q
BQIVFTRL ;PRXM/HC/ALA-V File Trigger RPC for Lab fields ; 24 May 2007 4:53 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 QUIT
+3 ;
EN(DATA,LAB,SITE,RSLT,BQDFN) ;EP - BQI VFILE TRIGGER LAB
+1 ;
+2 ; Input
+3 ; SITE - The site specimen IEN
+4 ; LAB - Lab test IEN
+5 ; RSLT - Lab test result
+6 ; BQDFN - Patient internal entry number
+7 ;
+8 NEW UID,II,PARMS,DA,IENS,NM,VALUE
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQIVFTRL",UID))
+11 KILL @DATA
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIVFTRL D UNWIND^%ZTER"
+14 ;
+15 SET SITE=$GET(SITE,"")
SET RSLT=$GET(RSLT,"")
SET BQDFN=$GET(BQDFN,"")
+16 IF SITE=""
IF RSLT=""
DO TBL
GOTO DONE
+17 IF SITE'=""
IF RSLT=""
DO SITE
GOTO DONE
+18 IF RSLT'=""
DO RES
GOTO DONE
+19 QUIT
+20 ;
SITE ; Get site specific defaults
+1 NEW LOINC,LOW,HIGH,SEX,AGE
+2 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$CHAR(30)
+3 SET DA(1)=LAB
SET DA=SITE
SET IENS=$$IENS^DILF(.DA)
+4 SET LOW=$$GET1^DIQ(60.01,IENS,1,"E")
+5 IF LOW["$S("
Begin DoDot:1
+6 IF $GET(BQDFN)=""
SET LOW=""
QUIT
+7 SET AGE=$$AGE^BQIAGE(BQDFN)
+8 SET SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
+9 SET LOW="S LOW="_LOW
+10 XECUTE LOW
End DoDot:1
+11 SET HIGH=$$GET1^DIQ(60.01,IENS,2,"E")
+12 IF HIGH["$S"
Begin DoDot:1
+13 IF $GET(BQDFN)=""
SET HIGH=""
QUIT
+14 SET AGE=$$AGE^BQIAGE(BQDFN)
+15 SET SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
+16 SET HIGH="S HIGH="_HIGH
+17 XECUTE HIGH
End DoDot:1
+18 SET PARMS("APCDTRFL")=LOW
+19 SET PARMS("APCDTRFH")=HIGH
+20 SET PARMS("APCDTUNI")=$$GET1^DIQ(60.01,IENS,6,"E")
+21 ;S PARMS("APCDTCPT")=$$GET1^DIQ(60.01,IENS,15,"E")
+22 SET LOINC=$$GET1^DIQ(60.01,IENS,95.3,"E")
+23 IF LOINC'=""
SET PARMS("APCDTLNC")=$$GET1^DIQ(60.01,IENS,95.3,"I")_$CHAR(29)_$$GET1^DIQ(60.01,IENS,95.3,"E")
+24 SET NM=""
SET VALUE=""
+25 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
Begin DoDot:1
+26 SET II=II+1
SET @DATA@(II)=NM_U_U_PARMS(NM)_U_$CHAR(30)
End DoDot:1
+27 QUIT
+28 ;
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 ;
TBL ; Get all possible lab results values
+1 ;
+2 NEW LIST,HELP,LDATA,LTYPE,WHERE,BII,IEN,VALUE,PARMS
+3 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$CHAR(30)
+4 SET IEN=0
SET VALUE=""
SET PARMS=""
SET LTYPE=""
+5 ;
+6 SET WHERE=$PIECE(^LAB(60,LAB,0),U,12)
+7 IF WHERE'=""
Begin DoDot:1
+8 SET LDATA=U_WHERE_"0)"
+9 SET LTYPE=$PIECE(@LDATA,U,2)
+10 SET LTYPE=$SELECT(LTYPE["N":"N",LTYPE["S":"S",1:"F")
+11 ;I LTYPE="S" S LIST=$P(@LDATA,U,3)
+12 SET LIST=$PIECE(@LDATA,U,3)
+13 SET LDATA=U_WHERE_"3)"
SET HELP=$GET(@LDATA)
+14 IF HELP=""
IF LTYPE["S"
Begin DoDot:2
+15 SET HELP="Select one of the following:"_$CHAR(10)
+16 FOR BII=1:1:$LENGTH(LIST,";")
SET HELP=HELP_$PIECE($PIECE(LIST,";",BII),":",2)_$CHAR(10)
End DoDot:2
+17 IF LTYPE="S"
SET LTYPE="C"
+18 SET LIST=$TRANSLATE(LIST,":",$CHAR(29))
SET LIST=$TRANSLATE(LIST,";",$CHAR(28))
End DoDot:1
+19 ;
+20 SET II=II+1
SET @DATA@(II)="APCDTRES"_U_LTYPE_U_$GET(LIST)_U_$GET(HELP)_$CHAR(30)
+21 ;
+22 FOR
SET IEN=$ORDER(^LAB(60,LAB,1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+23 SET VALUE=VALUE_IEN_$CHAR(29)_$$GET1^DIQ(61,IEN,.01,"E")_$CHAR(28)
End DoDot:1
+24 SET VALUE=$$TKO^BQIUL1(VALUE,$CHAR(28))
+25 SET II=II+1
SET @DATA@(II)="APCDTSTE"_U_"C"_U_VALUE_U_$CHAR(30)
+26 QUIT
+27 ;
RES ; Get trigger abnormal value from result
+1 NEW LRTS,LRQ,LRSPEC,LRSB,HELP,NM,VALUE,LRFLG
+2 SET X=RSLT
SET LRTS=LAB
SET LRQ=1
SET LRSPEC=SITE
SET LRSB=LAB
+3 IF BQDFN'=""
SET AGE=$$AGE^BQIAGE(BQDFN)
SET SEX=$PIECE(^DPT(BQDFN,0),U,2)
+4 DO V25^LRVER5
+5 DO RANGE^LRVER5
+6 SET @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00200HELP_TEXT"_$CHAR(30)
+7 SET PARMS("APCDTABN")=$GET(LRFLG)
+8 SET HELP="L*=Critical Low, L=Low, H=High, H*=Critical High, Blank for normal"
+9 SET NM=""
SET VALUE=""
+10 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
Begin DoDot:1
+11 SET II=II+1
SET @DATA@(II)=NM_U_U_PARMS(NM)_U_HELP_$CHAR(30)
End DoDot:1
+12 QUIT
