- 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
